From: Cameron Ball <cameron@moodle.com>
Date: Wed, 31 Jul 2019 08:11:09 +0000 (+0800)
Subject: More refactoring
X-Git-Url: http://cameron1729.xyz/?p=xyz.git;a=commitdiff_plain;h=362a386ba468642f8656e3ee02b20fa15d68f2d8

More refactoring
---

diff --git a/app/Main.hs b/app/Main.hs
index 43b6039..43ce0ba 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -29,6 +29,7 @@ import Data.Bool (bool)
 import Data.Tuple.Curry (uncurryN)
 import qualified Data.ByteString.Lazy as BL
 import Config
+import Control.Exception (catch, IOException)
 
 main :: IO ()
 main = getArgs >>= parse
@@ -45,6 +46,15 @@ getGlobalProjectConfig =  getGlobalProjectConfigPath >>= (\path -> doesFileExist
 getLocalProjectConfig :: IO (Maybe LocalConfig)
 getLocalProjectConfig = doesFileExist "xyz.json" >>= bool (return Nothing) (BL.readFile "xyz.json" >>= return . decode)
 
+safeReadFile :: FilePath -> IO (Maybe Text)
+safeReadFile p = (Just . pack <$> readFile p) `catch` handler
+  where
+    handler :: IOException -> IO (Maybe Text)
+    handler = const $ pure Nothing
+
+getEntryTemplate :: Text -> IO (Maybe Template)
+getEntryTemplate t = (pure $ fmap template) <*> (safeReadFile =<< ((++ "/entry-" ++ (unpack t) ++ ".txt")) <$> getGlobalProjectDir)
+
 resolveProjectConfig :: IO (Either Text ProjectConfig)
 resolveProjectConfig = do
   l <- getLocalProjectConfig
@@ -79,7 +89,7 @@ init :: IO ()
 init = do
   home <- getHomeDirectory
   themes <- allFilesIn $ home ++ "/.xyz/themes"
-  projectSpec <- (initPrompt (map pack themes)) >>= return . fmap snd >>= (\[x,y,z] -> return (x, y, z, Nothing, Nothing, Nothing))
+  projectSpec <- (\[x,y,z] -> (x, y, z, Nothing, Nothing, Nothing)) <$> fmap snd <$> initPrompt (map pack themes)
   let localConfig = uncurryN LocalConfig projectSpec
   writeFile "xyz.json" (toStrict . encodeToLazyText $ localConfig)
   config <- resolveProjectConfig
@@ -90,12 +100,13 @@ init = do
 
       case (commitCommand (projectConfig :: ProjectConfig), gitRemote (projectConfig :: ProjectConfig)) of
         (Just cmd, Just remote) -> do
-          mapM_ (callCommand . unpack . ((+++) " > /dev/unll")) ["git init", "git remote add origin " +++ remote, "git add . && git commit -m \"Initial commit\""]
+          putStrLn "Initialising project with git"
+          mapM_ (callCommand . unpack . (+++ " > /dev/null 2>&1")) ["git init", "git remote add origin " +++ remote, "git add .", "git commit -m \"Initial commit\""]
         (_, _) -> return()
 
-      putStrLn "\nInitialised empty project"
+      putStrLn "Initialised empty project"
     Left error -> do
-      putStrLn $ "\n" +++ error
+      putStrLn error
 
 build :: ProjectConfig -> IO ()
 build config = allFilesIn "entries" >>= (writeOutProject config) >> putStrLn "Build successful"
@@ -106,24 +117,27 @@ entry config = do
   entrySpec <- entryPrompt
   entryNum <- fmap (show . (+1) . length) $ allFilesIn "entries"
   stamp <- fmap (pack . show . round) getPOSIXTime
-  videoTemplate <- readFile (homeDir ++ "/.xyz/entry-video.txt") >>= return . template . fromString
-  normalTemplate <- readFile (homeDir ++ "/.xyz/entry.txt") >>= return . template . fromString
+  videoTemplate <- getEntryTemplate "video"
+  normalTemplate <- getEntryTemplate "normal"
 
   let rawEntry = case entrySpec of
         Just (title, videoSpec) -> do
           let baseContext = [("timestamp", stamp), ("title", title)]
           case videoSpec of
-            Just (videoId, videoFilename) -> (title, toStrict . render videoTemplate $ context $ baseContext ++ [("videoid", videoId), ("videofilename", videoFilename)])
-            Nothing -> (title, toStrict . render normalTemplate $ context baseContext)
+            -- TODO: Properly handle the Maybes for video and normal templates
+            Just (videoId, videoFilename) -> (title, toStrict . render  (fromJust videoTemplate) $ context $ baseContext ++ [("videoid", videoId), ("videofilename", videoFilename)])
+            Nothing -> (title, toStrict . render (fromJust normalTemplate) $ context baseContext)
 
   let fileName = "entries/" ++ entryNum ++ "-" ++ (unpack . slugify $ fst rawEntry) ++ ".txt"
   writeFile fileName $ snd rawEntry
 
-  callCommand $ "nano " ++ fileName
+  callCommand $ (unpack (editor (config :: ProjectConfig))) ++ " " ++ fileName
+  build config
 
   push <- pushPrompt
   case push of
-    True -> do callCommand . unpack $ "git add . && git commit -m \"" +++ (fst rawEntry) +++ "\" && git push"
+    True -> do
+      callCommand . unpack $ "git add . && git commit -m \"" +++ (fst rawEntry) +++ "\" && git push"
     False -> return ()
 
   putStrLn "\nThanks for using xyz!"
@@ -149,15 +163,15 @@ usage =  putStr . ununlines $ [
                        ]
   ]
 
-gogogo :: (ProjectConfig -> IO ()) -> Either Text ProjectConfig -> IO ()
-gogogo next projectConfig = case projectConfig of
+continueIfValidProject :: (ProjectConfig -> IO ()) -> Either Text ProjectConfig -> IO ()
+continueIfValidProject next projectConfig = case projectConfig of
   Right config -> next config
-  Left error -> putStrLn $ "This does not appear to be a vailid project directory: " +++ error -- Never executes, the cases in resolveProjectConfig will fail first.
+  Left error -> putStrLn $ "This does not appear to be a vailid project directory: " +++ error
 
 parse ["init"] =  initGlobalIfNeeded (continueIfInvalidProject init) >> exitSuccess
-parse ["build"] = resolveProjectConfig >>= (gogogo build) >> exitSuccess
-parse ["entry"] = resolveProjectConfig >>= (gogogo entry) >> exitSuccess
-parse ["config"] = resolveProjectConfig >>= (gogogo config) >> exitSuccess
+parse ["build"] = resolveProjectConfig >>= (continueIfValidProject build) >> exitSuccess
+parse ["entry"] = resolveProjectConfig >>= (continueIfValidProject entry) >> exitSuccess
+parse ["config"] = resolveProjectConfig >>= (continueIfValidProject config) >> exitSuccess
 parse [_] = usage >> exit
 parse [] = usage >> exit
 
diff --git a/src/Prompts.hs b/src/Prompts.hs
index e2fccf1..9a2ac5f 100644
--- a/src/Prompts.hs
+++ b/src/Prompts.hs
@@ -49,7 +49,7 @@ yornPrompt xs = do
   finally (prompt (xs +++ " (y/n): ") getOneText v) $ putStr "\n"
 
 listPrompt :: Text -> [Text] -> IO Text
-listPrompt xs options = finally (putCue >> choicePrompt) $ putStr "\n"
+listPrompt xs options = finally (putCue >> choicePrompt) $ putStr "\n\n"
   where
     cue = unlines $ map (\x -> (pack . show $ fst x) +++ ") " +++ snd x) themeList
     putCue = putStrLn $ xs +++ "\n\n" +++ cue