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)
   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)
  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" . 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 (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   --let filename = "entries/" ++ (show entryNum) ++ "-" ++ (unpack . (toLower. replace " " "-") $ pack entryName) ++ ".txt"
  65
  66   case entrySpec of
  67     Just (title, videoSpec) -> do
  68       let filename = "entries/" ++ entryNum ++ "-" ++ (unpack . slugify $ title) ++ ".txt"
  69       case videoSpec of
  70         Just (videoId, videoFilename) -> putStrLn "oh jimmy"
  71         Nothing -> putStrLn "oh bimmy"
  72
  73
  74   putStrLn "lel"
  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