app/Main.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2
   3 module Main where
   4
   5 import Lib
   6 import Prompts
   7 import System.Environment
   8 import System.Exit
   9 import System.Directory
  10 import Prelude hiding (init)
  11 import Data.List (intercalate)
  12 import Text.JSON
  13 import Text.JSON.Generic
  14 import Data.Text hiding (intercalate, unlines, init, length, splitAt)
  15 import Data.Time.Clock.POSIX
  16 import System.File.Tree hiding (mapM, mapM_)
  17 import System.Directory (doesFileExist)
  18 import System.Process
  19 import Data.Text.Template
  20 import Data.String
  21 import Data.Text.Lazy (toStrict)
  22
  23 main :: IO ()
  24 main = getArgs >>= parse
  25
  26 continueIfValidProject :: IO() -> IO ()
  27 continueIfValidProject nextfn = do
  28   jsonExists <- doesFileExist "xyz.json"
  29   if jsonExists
  30     then nextfn
  31     else putStrLn "This does not appear to be a valid project directory"
  32
  33 init :: IO ()
  34 init = do
  35   dirExists <- doesFileExist "xyz.json"
  36   if dirExists
  37     then putStrLn "Project already initialised"
  38     else do createDirectory "entries"
  39             home <- getHomeDirectory
  40             templates <- allFilesIn $ home ++ "/.xyz/themes"
  41             putStrLn "Enter a name for your project:"
  42             projectName <- getLine
  43             putStrLn "Enter short description for your project:"
  44             projectDescription <- getLine
  45             putStrLn $ "Which theme would you like to use?\n\n" ++ (ununlines templates)
  46             theme <- getLine
  47             writeFile "xyz.json" . encode . toJSObject $ [("name", projectName), ("description", projectDescription), ("theme", theme)]
  48             putStrLn "Initialised empty project"
  49
  50 build :: IO ()
  51 build = do
  52   fileExists <- doesFileExist "xyz.json"
  53   if fileExists
  54     then do
  55         files <- allFilesIn "entries"
  56         home <- getHomeDirectory
  57         config <- readFile "xyz.json"
  58         someFunc (decodeJSON config :: ProjectConfig) files >> putStrLn "Build successful"
  59     else putStrLn "This does not appear to be a valid project directory"
  60
  61 ununlines :: [String] -> String
  62 ununlines = intercalate "\n\n"
  63
  64 entry :: IO ()
  65 entry = do
  66   homeDir <- getHomeDirectory
  67   entryName <- textPrompt "Name for this entry:"
  68   video <- (fmap . fmap) (\(a,b) -> (a, b ++ ".webm"::String)) $ dependantPrompt "Video ID (leave blank to skip):" "Local video filename:"
  69   entryNum <- fmap ((+1) . length) $ allFilesIn "entries"
  70   stamp <- fmap round getPOSIXTime
  71   videoTemplate <- readFile (homeDir ++ "/.xyz/entry-video.txt") >>= return . template . fromString
  72   normalTemplate <- readFile (homeDir ++ "/.xyz/entry.txt") >>= return . template . fromString
  73   let filename = "entries/" ++ (show entryNum) ++ "-" ++ (unpack . (toLower. replace " " "-") $ pack entryName) ++ ".txt"
  74
  75   case video of
  76      Just (videoId, videoFilename) -> do
  77        let tmplContext = context $ [("timestamp", fromString . show $ (stamp::Integer)), ("title", pack entryName), ("videofilename", pack $ videoFilename), ("videoid", pack videoId)]
  78        let rawEntry = unpack . toStrict $ render videoTemplate tmplContext
  79        writeFile filename rawEntry
  80        callCommand $ "youtube-dl -f 'webm[height<1080]+bestaudio' \"https://www.youtube.com/watch?v=" ++ videoId ++ "\" -o 'build/videos/" ++ videoFilename ++ "'"
  81      Nothing -> do
  82        let tmplContext = context $ [("timestamp", fromString . show $ (stamp::Integer)), ("title", pack entryName)]
  83        let rawEntry = unpack . toStrict $ render normalTemplate tmplContext
  84        writeFile filename rawEntry
  85
  86   (putStrLn $ ("Created " ++ filename)) >> build
  87
  88   push <- yornPrompt "Do you want to push this entry?"
  89
  90   case push of
  91     True -> do callCommand $ "git add . && git commit -m \"" ++ entryName ++ "\" && git push"
  92     False -> return ()
  93
  94   putStrLn "Thanks for using xyz!"
  95
  96 usage :: IO ()
  97 usage =  putStr . ununlines $ [
  98   "usage: xyz <command>",
  99   "Commands:", unlines [
 100       "\tinit\t\tInitialise a new site",
 101       "\tbuild\t\tBuild the site",
 102       "\tentry\t\tInitialise an entry"
 103                        ]
 104   ]
 105
 106 parse ["init"] = init >> exitSuccess
 107 parse ["build"] = continueIfValidProject build >> exitSuccess
 108 parse ["entry"] = continueIfValidProject entry >> exitSuccess
 109 parse [_] = usage >> exit
 110 parse [] = usage >> exit
 111
 112 exit = exitWith ExitSuccess