app/Main.hs

   1 module Main where
   2
   3 import Data.List (intercalate)
   4 import Data.String hiding (unlines)
   5 import Data.Text hiding (map, init, length, splitAt)
   6 import Data.Text.IO (putStrLn, putStr, writeFile)
   7 import Data.Text.Lazy (toStrict)
   8 import Data.Text.Template
   9 import Data.Time.Clock.POSIX
  10 import Lib
  11 import Prelude hiding (putStrLn, putStr, init, unlines, writeFile)
  12 import Prompts
  13 import System.Directory
  14 import System.Directory (doesFileExist)
  15 import System.Environment
  16 import System.Exit
  17 import System.File.Tree hiding (map, mapM, mapM_)
  18 import System.Process
  19 import Text.JSON
  20 import Text.JSON.Generic
  21 import Util
  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 home <- getHomeDirectory
  39             themes <- allFilesIn $ home ++ "/.xyz/themes"
  40             projectSpec <- initPrompt (map pack themes)
  41             createDirectory "entries"
  42             writeFile "xyz.json" . pack . encode . toJSObject $ projectSpec
  43             putStrLn "\n\nInitialised empty project"
  44
  45 build :: IO ()
  46 build = do
  47   fileExists <- doesFileExist "xyz.json"
  48   if fileExists
  49     then do
  50         files <- allFilesIn "entries"
  51         home <- getHomeDirectory
  52         config <- readFile "xyz.json"
  53         writeOutProject (decodeJSON config :: ProjectConfig) files >> putStrLn "Build successful"
  54     else putStrLn "This does not appear to be a valid project directory"
  55
  56 entry :: IO ()
  57 entry = do
  58   homeDir <- getHomeDirectory
  59   entrySpec <- entryPrompt
  60   entryNum <- fmap (show . (+1) . length) $ allFilesIn "entries"
  61   stamp <- fmap (pack . show . round) getPOSIXTime
  62   videoTemplate <- readFile (homeDir ++ "/.xyz/entry-video.txt") >>= return . template . fromString
  63   normalTemplate <- readFile (homeDir ++ "/.xyz/entry.txt") >>= return . template . fromString
  64
  65   let rawEntry = case entrySpec of
  66         Just (title, videoSpec) -> do
  67           let baseContext = [("timestamp", stamp), ("title", title)]
  68           case videoSpec of
  69             Just (videoId, videoFilename) -> (title, toStrict . render videoTemplate $ context $ baseContext ++ [("videoid", videoId), ("videofilename", videoFilename)])
  70             Nothing -> (title, toStrict . render normalTemplate $ context baseContext)
  71
  72   let fileName = "entries/" ++ entryNum ++ "-" ++ (unpack . slugify $ fst rawEntry) ++ ".txt"
  73   writeFile fileName $ snd rawEntry
  74
  75   callCommand $ "nano " ++ fileName
  76
  77   push <- pushPrompt
  78   case push of
  79     True -> do callCommand . unpack $ "git add . && git commit -m \"" +++ (fst rawEntry) +++ "\" && git push"
  80     False -> return ()
  81
  82   putStrLn "Thanks for using xyz!"
  83
  84 usage :: IO ()
  85 usage =  putStr . ununlines $ [
  86   "usage: xyz <command>",
  87   "Commands:", unlines [
  88       "\tinit\t\tInitialise a new site",
  89       "\tbuild\t\tBuild the site",
  90       "\tentry\t\tInitialise an entry"
  91                        ]
  92   ]
  93
  94 parse ["init"] = init >> exitSuccess
  95 parse ["build"] = continueIfValidProject build >> exitSuccess
  96 parse ["entry"] = continueIfValidProject entry >> exitSuccess
  97 parse [_] = usage >> exit
  98 parse [] = usage >> exit
  99
 100 exit = exitWith ExitSuccess