From 320e5e85f6c0aeeeda2ea3de2ed8a8ceef62f4b1 Mon Sep 17 00:00:00 2001
From: Cameron Ball <cameron@moodle.com>
Date: Thu, 27 Jun 2019 17:08:34 +0800
Subject: [PATCH] More prompts

---
 app/Main.hs    | 28 +++++++++++++++++++++-------
 src/Prompts.hs | 28 ++++++++++++++++++++--------
 2 files changed, 41 insertions(+), 15 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index 07f31d8..597bb89 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -19,16 +19,30 @@ import System.Process
 import Text.JSON
 import Text.JSON.Generic
 import Util
+import Data.Bool (bool)
 
 main :: IO ()
 main = getArgs >>= parse
 
+getGlobalProjectDir :: IO FilePath
+getGlobalProjectDir = getHomeDirectory >>= return . (++ "/.xyz")
+
+getGlobalProjectConfig :: IO FilePath
+getGlobalProjectConfig = getGlobalProjectDir >>= return . (++ "/xyz.json")
+
 continueIfValidProject :: IO () -> IO ()
-continueIfValidProject nextfn = do
-  jsonExists <- doesFileExist "xyz.json"
-  if jsonExists
-    then nextfn
-    else putStrLn "This does not appear to be a valid project directory"
+continueIfValidProject next = doesFileExist "xyz.json" >>=  bool (putStrLn "This does not appear to be a valid project directory") next
+
+initGlobalIfNeeded :: IO () -> IO ()
+initGlobalIfNeeded next = getGlobalProjectConfig >>= doesFileExist >>= bool globalInit (return ()) >> next
+
+globalInit :: IO ()
+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
+  writeFile (home ++ "/.xyz/xyz.json") (pack . encode . toJSObject $ [("editor", editor)])
+  putStrLn "\nThanks! Now let's continue with initialising your project...\n"
 
 init :: IO ()
 init = do
@@ -40,7 +54,7 @@ init = do
             projectSpec <- initPrompt (map pack themes)
             createDirectory "entries"
             writeFile "xyz.json" . pack . encode . toJSObject $ projectSpec
-            putStrLn "\n\nInitialised empty project"
+            putStrLn "\nInitialised empty project"
 
 build :: IO ()
 build = do
@@ -91,7 +105,7 @@ usage =  putStr . ununlines $ [
                        ]
   ]
 
-parse ["init"] = init >> exitSuccess
+parse ["init"] = initGlobalIfNeeded init >> exitSuccess
 parse ["build"] = continueIfValidProject build >> exitSuccess
 parse ["entry"] = continueIfValidProject entry >> exitSuccess
 parse [_] = usage >> exit
diff --git a/src/Prompts.hs b/src/Prompts.hs
index aa54876..846d019 100644
--- a/src/Prompts.hs
+++ b/src/Prompts.hs
@@ -1,12 +1,15 @@
-module Prompts (entryPrompt, initPrompt, pushPrompt) where
+module Prompts (entryPrompt, initPrompt, pushPrompt, editorPrompt) where
 
 import Util
 import Prelude hiding (getLine, null, putStrLn, putStr, unlines)
 import System.IO hiding (putStr, putStrLn, getLine)
-import Control.Monad (join)
+import Control.Monad (join, filterM)
+import Control.Exception (finally)
 import Data.Text (Text, unlines, append, toLower, null, pack, unpack)
 import Data.Text.IO (getLine, putStrLn, putStr, getLine)
 import Data.Maybe
+import System.Process
+import System.Exit
 
 getOneText :: IO Text
 getOneText = getChar >>= return . pack . return
@@ -43,13 +46,14 @@ yornPrompt xs = do
                    "y" -> Right True
                    "n" -> Right False
                    _ -> Left "Please answer with y or n"
-  prompt (xs +++ " (y/n): ") getOneText v
+  finally (prompt (xs +++ " (y/n): ") getOneText v) $ putStr "\n"
 
 listPrompt :: Text -> [Text] -> IO Text
-listPrompt xs options = do
-  putStrLn $ xs +++ "\n\n" +++ cue
-  prompt ("Make your selection " +++ validRange +++ ": ") getOneText validator where
+listPrompt xs options = finally (putCue >> choicePrompt) $ putStr "\n"
+  where
     cue = unlines $ map (\x -> (pack . show $ fst x) +++ ") " +++ snd x) themeList
+    putCue = putStrLn $ xs +++ "\n\n" +++ cue
+    choicePrompt = prompt ("Make your selection " +++ validRange +++ ": ") getOneText validator
     validator x = if choice > 0 && choice <= upper
       then Right (fromJust (lookup choice themeList))
       else Left $ "\nPick a valid number " +++ validRange where
@@ -69,11 +73,19 @@ entryPrompt = subPrompt entryNamePrompt videoPrompt (not . null) where
   videoPrompt = dependantTextPrompt "Video ID (leave blank to skip): " "Local video filename: "
 
 initPrompt :: [Text] -> IO [(String, Text)]
-initPrompt themes = fmap (zip ["projectName", "description", "theme"]) $ sequence prompts where
+initPrompt themes = fmap (zip ["name", "description", "theme"]) $ sequence prompts where
   prompts = [
     nonEmptyTextPrompt "Enter a name for your project: ",
     nonEmptyTextPrompt "Enter a short description for your project: ",
-    listPrompt "Which theme would you like to use?" themes
+    listPrompt "\nWhich theme would you like to use?" themes
             ]
 
+editorPrompt :: IO Text
+editorPrompt = filterM (system . unpack . (+++ " > /dev/null") . ("which " +++)  >>=  return . fmap codeToBool) commonEditors
+  >>= listPrompt "Which editor would you like to use? Here are some common ones I found on your system:" where
+    codeToBool x = case x of
+      ExitFailure _ -> False
+      ExitSuccess -> True
+    commonEditors =   ["vi", "vim", "nano", "emacs"]
+
 pushPrompt = yornPrompt "Do you want to push this entry?"
-- 
2.11.0