From d7d602ced25cf0091656c7040fecf55591ad4a3a Mon Sep 17 00:00:00 2001
From: Cameron Ball <cameron@moodle.com>
Date: Tue, 18 Jun 2019 17:02:47 +0800
Subject: [PATCH] Prompts refactor

---
 app/Main.hs    | 56 ++++++++++++++++++++++++++++++--------------------------
 src/Lib.hs     |  2 +-
 src/Prompts.hs | 47 +++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 78 insertions(+), 27 deletions(-)
 create mode 100644 src/Prompts.hs

diff --git a/app/Main.hs b/app/Main.hs
index 267ca5f..3838536 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -3,6 +3,7 @@
 module Main where
 
 import Lib
+import Prompts
 import System.Environment
 import System.Exit
 import System.Directory
@@ -15,6 +16,9 @@ import Data.Time.Clock.POSIX
 import System.File.Tree hiding (mapM, mapM_)
 import System.Directory (doesFileExist)
 import System.Process
+import Data.Text.Template
+import Data.String
+import Data.Text.Lazy (toStrict)
 
 main :: IO ()
 main = getArgs >>= parse
@@ -59,35 +63,35 @@ ununlines = intercalate "\n\n"
 
 entry :: IO ()
 entry = do
-  putStrLn "Enter a name for this entry:"
-  entryName <- getLine
-  putStrLn "YouTube video ID?"
-  ytUrl <- getLine
-  ytFilename <- if (ytUrl /= "")
-    then putStrLn "Video filename?" >> getLine >>= return . ("::" ++) . (++ ".webm")
-    else return ""
-
-  ytLink <- if (ytUrl /= "")
-    then return $ "\n<a href=\"https://www.youtube.com/watch?v=" ++ ytUrl ++ "\">https://www.youtube.com/watch?v=" ++ ytUrl ++ "</a>"
-    else return ""
-
+  homeDir <- getHomeDirectory
+  entryName <- textPrompt "Name for this entry:"
+  video <- (fmap . fmap) (\(a,b) -> (a, b ++ ".webm"::String)) $ dependantPrompt "Video ID (leave blank to skip):" "Local video filename:"
   entryNum <- fmap ((+1) . length) $ allFilesIn "entries"
   stamp <- fmap round getPOSIXTime
+  videoTemplate <- readFile (homeDir ++ "/.xyz/entry-video.txt") >>= return . template . fromString
+  normalTemplate <- readFile (homeDir ++ "/.xyz/entry.txt") >>= return . template . fromString
   let filename = "entries/" ++ (show entryNum) ++ "-" ++ (unpack . (toLower. replace " " "-") $ pack entryName) ++ ".txt"
-  writeFile filename (show stamp ++ "::" ++ entryName ++ ytFilename ++ "\nEntry goes here!\nᚳᚱᛒ" ++ ytLink)
-  putStrLn $ "Created " ++ filename
-  callCommand $ "nano " ++ filename
-  if (ytUrl /= "")
-    then callCommand $ "youtube-dl -f 'webm[height<1080]+bestaudio' \"https://www.youtube.com/watch?v=" ++ ytUrl ++ "\" -o 'build/videos/" ++ (snd . splitAt 2 $ ytFilename)   ++ "'"
-    else return ()
-  build
-
-  putStrLn "Do you want to push this entry?"
-  push <- getLine
-
-  if (push == "y")
-    then (callCommand $ "git add . && git commit -m \"" ++ entryName ++ "\" && git push") >> putStrLn "Thank for using xyz"
-    else return ()
+
+  case video of
+     Just (videoId, videoFilename) -> do
+       let tmplContext = context $ [("timestamp", fromString . show $ (stamp::Integer)), ("title", pack entryName), ("videofilename", pack $ videoFilename), ("videoid", pack videoId)]
+       let rawEntry = unpack . toStrict $ render videoTemplate tmplContext
+       writeFile filename rawEntry
+       callCommand $ "youtube-dl -f 'webm[height<1080]+bestaudio' \"https://www.youtube.com/watch?v=" ++ videoId ++ "\" -o 'build/videos/" ++ videoFilename ++ "'"
+     Nothing -> do
+       let tmplContext = context $ [("timestamp", fromString . show $ (stamp::Integer)), ("title", pack entryName)]
+       let rawEntry = unpack . toStrict $ render normalTemplate tmplContext
+       writeFile filename rawEntry
+
+  (putStrLn $ ("Created " ++ filename)) >> build
+
+  push <- yornPrompt "Do you want to push this entry?"
+
+  case push of
+    True -> do callCommand $ "git add . && git commit -m \"" ++ entryName ++ "\" && git push"
+    False -> return ()
+
+  putStrLn "Thanks for using xyz!"
 
 usage :: IO ()
 usage =  putStr . ununlines $ [
diff --git a/src/Lib.hs b/src/Lib.hs
index 1ba6286..9cad63d 100644
--- a/src/Lib.hs
+++ b/src/Lib.hs
@@ -3,7 +3,7 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 
 module Lib
-    ( someFunc, EntryList, allFilesIn, ProjectConfig
+    ( someFunc, EntryList, allFilesIn, ProjectConfig, context
     ) where
 
 import Data.Function (on)
diff --git a/src/Prompts.hs b/src/Prompts.hs
new file mode 100644
index 0000000..ae8df00
--- /dev/null
+++ b/src/Prompts.hs
@@ -0,0 +1,47 @@
+{-# LANGUAGE TupleSections #-}
+
+module Prompts
+    ( textPrompt, yornPrompt, dependantPrompt
+    ) where
+
+import System.IO
+import Data.Char (toLower)
+import Control.Monad (join)
+
+isEmpty :: String -> Bool
+isEmpty = (== "")
+
+cannotBeEmpty :: String -> Either String String
+cannotBeEmpty xs = case isEmpty xs of
+  True -> Left "Value cannot be empty"
+  False -> Right xs
+
+prompt :: String -> (String -> Either String a) -> IO a
+prompt xs validate = do
+  putStrLn xs
+  response <- getLine
+  case validate response of
+    Left error -> putStrLn error >> prompt xs validate
+    Right result -> return result
+
+subPrompt :: String -> (String -> Bool) -> IO a -> IO (Maybe (String, a))
+subPrompt xs showNext p = do
+  let v x = case showNext x of
+        True -> Right $ p >>= return . Just . (x ,)
+        False -> Right $ return Nothing
+
+  join $ prompt xs v
+
+textPrompt :: String -> IO String
+textPrompt xs = prompt xs cannotBeEmpty
+
+dependantPrompt :: String -> String -> IO (Maybe (String,String))
+dependantPrompt xs1 xs2 = subPrompt xs1 (not . isEmpty) $ prompt xs2 cannotBeEmpty
+
+yornPrompt :: String -> IO Bool
+yornPrompt xs = do
+  let v x = case (map toLower x) of
+                   "y" -> Right True
+                   "n" -> Right False
+                   _ -> Left "Please answer with y or n"
+  prompt (xs ++ " (y/n):") v
-- 
2.11.0