From b706643cfd4db90a7d7f3e460ecf4dbb98663ff4 Mon Sep 17 00:00:00 2001
From: Cameron Ball <cameron@moodle.com>
Date: Thu, 25 Jul 2019 15:11:50 +0800
Subject: [PATCH] Improve error handling around busted configs

---
 app/Main.hs | 68 +++++++++++++++++++++++++++----------------------------------
 1 file changed, 30 insertions(+), 38 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index 9469690..6e38fcb 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -40,22 +40,21 @@ getGlobalProjectConfigPath :: IO FilePath
 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")
@@ -68,7 +67,7 @@ globalInit = do
   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 -> []
@@ -98,18 +97,11 @@ init = do
     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"
@@ -136,21 +128,16 @@ entry = do
 
   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 $ [
@@ -162,10 +149,15 @@ 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
 
-- 
2.11.0