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 import Data.Bool (bool)
  23
  24 main :: IO ()
  25 main = getArgs >>= parse
  26
  27 getGlobalProjectDir :: IO FilePath
  28 getGlobalProjectDir = getHomeDirectory >>= return . (++ "/.xyz")
  29
  30 getGlobalProjectConfig :: IO FilePath
  31 getGlobalProjectConfig = getGlobalProjectDir >>= return . (++ "/xyz.json")
  32
  33 continueIfValidProject :: IO () -> IO ()
  34 continueIfValidProject next = doesFileExist "xyz.json" >>=  bool (putStrLn "This does not appear to be a valid project directory") next
  35
  36 initGlobalIfNeeded :: IO () -> IO ()
  37 initGlobalIfNeeded next = getGlobalProjectConfig >>= doesFileExist >>= bool globalInit (return ()) >> next
  38
  39 globalInit :: IO ()
  40 globalInit = do
  41   home <- getHomeDirectory
  42   putStrLn "\nWelcome to xyz! Looks like this is your first time here. Let's configure a few things...\n"
  43   editor <- editorPrompt
  44   writeFile (home ++ "/.xyz/xyz.json") (pack . encode . toJSObject $ [("editor", editor)])
  45   putStrLn "\nThanks! Now let's continue with initialising your project...\n"
  46
  47 init :: IO ()
  48 init = do
  49   dirExists <- doesFileExist "xyz.json"
  50   if dirExists
  51     then putStrLn "Project already initialised"
  52     else do home <- getHomeDirectory
  53             themes <- allFilesIn $ home ++ "/.xyz/themes"
  54             projectSpec <- initPrompt (map pack themes)
  55             createDirectory "entries"
  56             writeFile "xyz.json" . pack . encode . toJSObject $ projectSpec
  57             putStrLn "\nInitialised empty project"
  58
  59 build :: IO ()
  60 build = do
  61   fileExists <- doesFileExist "xyz.json"
  62   if fileExists
  63     then do
  64         files <- allFilesIn "entries"
  65         home <- getHomeDirectory
  66         config <- readFile "xyz.json"
  67         writeOutProject (decodeJSON config :: ProjectConfig) files >> putStrLn "Build successful"
  68     else putStrLn "This does not appear to be a valid project directory"
  69
  70 entry :: IO ()
  71 entry = do
  72   homeDir <- getHomeDirectory
  73   entrySpec <- entryPrompt
  74   entryNum <- fmap (show . (+1) . length) $ allFilesIn "entries"
  75   stamp <- fmap (pack . show . round) getPOSIXTime
  76   videoTemplate <- readFile (homeDir ++ "/.xyz/entry-video.txt") >>= return . template . fromString
  77   normalTemplate <- readFile (homeDir ++ "/.xyz/entry.txt") >>= return . template . fromString
  78
  79   let rawEntry = case entrySpec of
  80         Just (title, videoSpec) -> do
  81           let baseContext = [("timestamp", stamp), ("title", title)]
  82           case videoSpec of
  83             Just (videoId, videoFilename) -> (title, toStrict . render videoTemplate $ context $ baseContext ++ [("videoid", videoId), ("videofilename", videoFilename)])
  84             Nothing -> (title, toStrict . render normalTemplate $ context baseContext)
  85
  86   let fileName = "entries/" ++ entryNum ++ "-" ++ (unpack . slugify $ fst rawEntry) ++ ".txt"
  87   writeFile fileName $ snd rawEntry
  88
  89   callCommand $ "nano " ++ fileName
  90
  91   push <- pushPrompt
  92   case push of
  93     True -> do callCommand . unpack $ "git add . && git commit -m \"" +++ (fst rawEntry) +++ "\" && git push"
  94     False -> return ()
  95
  96   putStrLn "Thanks for using xyz!"
  97
  98 usage :: IO ()
  99 usage =  putStr . ununlines $ [
 100   "usage: xyz <command>",
 101   "Commands:", unlines [
 102       "\tinit\t\tInitialise a new site",
 103       "\tbuild\t\tBuild the site",
 104       "\tentry\t\tInitialise an entry"
 105                        ]
 106   ]
 107
 108 parse ["init"] = initGlobalIfNeeded init >> exitSuccess
 109 parse ["build"] = continueIfValidProject build >> exitSuccess
 110 parse ["entry"] = continueIfValidProject entry >> exitSuccess
 111 parse [_] = usage >> exit
 112 parse [] = usage >> exit
 113
 114 exit = exitWith ExitSuccess