More prompts
authorCameron Ball <cameron@moodle.com>
Thu, 27 Jun 2019 09:08:34 +0000 (17:08 +0800)
committerCameron Ball <cameron@moodle.com>
Thu, 27 Jun 2019 09:08:34 +0000 (17:08 +0800)
app/Main.hs
src/Prompts.hs

index 07f31d8..597bb89 100644 (file)
@@ -19,16 +19,30 @@ import System.Process
 import Text.JSON
 import Text.JSON.Generic
 import Util
 import Text.JSON
 import Text.JSON.Generic
 import Util
+import Data.Bool (bool)
 
 main :: IO ()
 main = getArgs >>= parse
 
 
 main :: IO ()
 main = getArgs >>= parse
 
+getGlobalProjectDir :: IO FilePath
+getGlobalProjectDir = getHomeDirectory >>= return . (++ "/.xyz")
+
+getGlobalProjectConfig :: IO FilePath
+getGlobalProjectConfig = getGlobalProjectDir >>= return . (++ "/xyz.json")
+
 continueIfValidProject :: IO () -> IO ()
 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
 
 init :: IO ()
 init = do
@@ -40,7 +54,7 @@ init = do
             projectSpec <- initPrompt (map pack themes)
             createDirectory "entries"
             writeFile "xyz.json" . pack . encode . toJSObject $ projectSpec
             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
 
 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
 parse ["build"] = continueIfValidProject build >> exitSuccess
 parse ["entry"] = continueIfValidProject entry >> exitSuccess
 parse [_] = usage >> exit
index aa54876..846d019 100644 (file)
@@ -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 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 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
 
 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"
                    "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 :: 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
     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
     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)]
   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: ",
   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?"
 pushPrompt = yornPrompt "Do you want to push this entry?"