getGlobalProjectConfigPath = getGlobalProjectDir >>= return . (++ "/xyz.json")
getGlobalProjectConfig :: IO (Maybe GlobalConfig)
-getGlobalProjectConfig = getGlobalProjectConfigPath >>= BL.readFile >>= return . decode
+getGlobalProjectConfig = getGlobalProjectConfigPath >>= (\path -> doesFileExist path >>= bool (return Nothing) (BL.readFile path >>= return . decode))
getLocalProjectConfig :: IO (Maybe LocalConfig)
-getLocalProjectConfig = BL.readFile "xyz.json" >>= return . decode
+getLocalProjectConfig = doesFileExist "xyz.json" >>= bool (return Nothing) (BL.readFile "xyz.json" >>= return . decode)
resolveProjectConfig :: IO (Maybe ProjectConfig)
resolveProjectConfig = do
l <- getLocalProjectConfig
g <- getGlobalProjectConfig
- return $ case (l, g) of
- (Just l, Just g) -> Just $ getProjectConfig g l
- (_, _) -> Nothing
-
-continueIfValidProject :: IO () -> IO ()
-continueIfValidProject next = doesFileExist "xyz.json" >>= bool (putStrLn "This does not appear to be a valid project directory") next
+ case (l, g) of
+ (Just l, Just g) -> return . Just $ getProjectConfig g l
+ (Just _, Nothing) -> fail "Busted global config"
+ (Nothing, Just _) -> fail "Busted local config"
+ _ -> fail "All configs are busted"
continueIfInvalidProject :: IO () -> IO ()
continueIfInvalidProject next = doesFileExist "xyz.json" >>= bool next (putStrLn "Project already initialised")
home <- getHomeDirectory
putStrLn "\nWelcome to xyz! Looks like this is your first time here. Let's configure a few things...\n"
editor <- editorPrompt
- vcs <- vcsPrompt -- >>= (\x -> return $ if x then Just "git add . && git commit -m \"$title\"" else Nothing)
+ vcs <- vcsPrompt
let pushCmdAndRemote = case vcs of
Just (True, x) -> [("pushCommand", "git add . && git commit -m \"$title\""), ("remote", x)]
Nothing -> []
Nothing -> do
putStrLn "\nSomething went real wrong"
-build :: IO ()
-build = do
- files <- allFilesIn "entries"
- config <- resolveProjectConfig
-
- case config of
- Just c -> writeOutProject c files >> putStrLn "Build successful"
- _ -> putStrLn "Busted"
+build :: ProjectConfig -> IO ()
+build config = allFilesIn "entries" >>= (writeOutProject config) >> putStrLn "Build successful"
-entry :: IO ()
-entry = do
- config <- resolveProjectConfig
+entry :: ProjectConfig -> IO ()
+entry config = do
homeDir <- getHomeDirectory
entrySpec <- entryPrompt
entryNum <- fmap (show . (+1) . length) $ allFilesIn "entries"
putStrLn "\nThanks for using xyz!"
-config :: IO ()
-config = do
- config <- resolveProjectConfig
- case config of
- Just (ProjectConfig {
- name=n,
- description=d,
- theme=t,
- editor=e,
- commitCommand=cc
- }) -> (putStrLn "\nProject details:\n") >> (putStr . unlines $ zipWith (+++) ["Name:\t\t", "Description:\t", "Theme:\t\t", "Editor:\t\t", "Commit command:\t"] [n, d, t, e, ccc]) where
- ccc = case cc of
- Just g -> g
- Nothing -> "Not set"
- Nothing -> putStrLn "broken"
+config :: ProjectConfig -> IO ()
+config config = (putStrLn "\nProject details:\n") >> (putStr . unlines $ zipWith (+++) ["Name:\t\t", "Description:\t", "Theme:\t\t", "Editor:\t\t", "Commit command:\t"] [n, d, t, e, ccc]) where
+ n = name (config :: ProjectConfig)
+ d = description (config :: ProjectConfig)
+ t = theme (config :: ProjectConfig)
+ e = editor (config :: ProjectConfig)
+ cc = commitCommand (config :: ProjectConfig)
+ ccc = case cc of
+ Just g -> g
+ Nothing -> "Not set"
usage :: IO ()
usage = putStr . ununlines $ [
]
]
+gogogo :: (ProjectConfig -> IO ()) -> Maybe ProjectConfig -> IO ()
+gogogo next projectConfig = case projectConfig of
+ Just config -> next config
+ _ -> fail "This does not appear to be a vailid project directory" -- Never executes, the cases in resolveProjectConfig will fail first.
+
parse ["init"] = initGlobalIfNeeded (continueIfInvalidProject init) >> exitSuccess
-parse ["build"] = continueIfValidProject build >> exitSuccess
-parse ["entry"] = continueIfValidProject entry >> exitSuccess
-parse ["config"] = continueIfValidProject config >> exitSuccess
+parse ["build"] = resolveProjectConfig >>= (gogogo build) >> exitSuccess
+parse ["entry"] = resolveProjectConfig >>= (gogogo entry) >> exitSuccess
+parse ["config"] = resolveProjectConfig >>= (gogogo config) >> exitSuccess
parse [_] = usage >> exit
parse [] = usage >> exit