module Main where
import Lib
+import Prompts
import System.Environment
import System.Exit
import System.Directory
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
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 $ [
--- /dev/null
+{-# 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