app/Main.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2
   3 module Main where
   4
   5 import Lib
   6 import System.Environment
   7 import System.Exit
   8 import System.Directory
   9 import Prelude hiding (init)
  10 import Data.List (intercalate)
  11 import Text.JSON
  12 import Text.JSON.Generic
  13 import Data.Text hiding (intercalate, unlines, init, length, splitAt)
  14 import Data.Time.Clock.POSIX
  15 import System.File.Tree hiding (mapM, mapM_)
  16 import System.Directory (doesFileExist)
  17 import System.Process
  18
  19 main :: IO ()
  20 main = getArgs >>= parse
  21
  22 continueIfValidProject :: IO() -> IO ()
  23 continueIfValidProject nextfn = do
  24   jsonExists <- doesFileExist "xyz.json"
  25   if jsonExists
  26     then nextfn
  27     else putStrLn "This does not appear to be a valid project directory"
  28
  29 init :: IO ()
  30 init = do
  31   dirExists <- doesFileExist "xyz.json"
  32   if dirExists
  33     then putStrLn "Project already initialised"
  34     else do createDirectory "entries"
  35             home <- getHomeDirectory
  36             templates <- allFilesIn $ home ++ "/.xyz/themes"
  37             putStrLn "Enter a name for your project:"
  38             projectName <- getLine
  39             putStrLn "Enter short description for your project:"
  40             projectDescription <- getLine
  41             putStrLn $ "Which theme would you like to use?\n\n" ++ (ununlines templates)
  42             theme <- getLine
  43             writeFile "xyz.json" . encode . toJSObject $ [("name", projectName), ("description", projectDescription), ("theme", theme)]
  44             putStrLn "Initialised empty project"
  45
  46 build :: IO ()
  47 build = do
  48   fileExists <- doesFileExist "xyz.json"
  49   if fileExists
  50     then do
  51         files <- allFilesIn "entries"
  52         home <- getHomeDirectory
  53         config <- readFile "xyz.json"
  54         someFunc (decodeJSON config :: ProjectConfig) files >> putStrLn "Build successful"
  55     else putStrLn "This does not appear to be a valid project directory"
  56
  57 ununlines :: [String] -> String
  58 ununlines = intercalate "\n\n"
  59
  60 entry :: IO ()
  61 entry = do
  62   putStrLn "Enter a name for this entry:"
  63   entryName <- getLine
  64   putStrLn "YouTube video ID?"
  65   ytUrl <- getLine
  66   ytFilename <- if (ytUrl /= "")
  67     then putStrLn "Video filename?" >> getLine >>= return . ("::" ++) . (++ ".webm")
  68     else return ""
  69
  70   entryNum <- fmap ((+1) . length) $ allFilesIn "entries"
  71   stamp <- fmap round getPOSIXTime
  72   let filename = "entries/" ++ (show entryNum) ++ "-" ++ (unpack . (toLower. replace " " "-") $ pack entryName) ++ ".txt"
  73   writeFile filename (show stamp ++ "::" ++ entryName ++ ytFilename ++ "\nEntry goes here!\nᚳᚱᛒ\n<a href=\"https://www.youtube.com/watch?v=" ++ ytUrl ++ "\">https://www.youtube.com/watch?v=" ++ ytUrl ++ "</a>")
  74   putStrLn $ "Created " ++ filename
  75   callCommand $ "nano " ++ filename
  76   callCommand $ "youtube-dl -f 'webm[height<1080]+bestaudio' \"https://www.youtube.com/watch?v=" ++ ytUrl ++ "\" -o 'build/videos/" ++ (snd . splitAt 2 $ ytFilename)   ++ "'"
  77   build
  78
  79 usage :: IO ()
  80 usage =  putStr . ununlines $ [
  81   "usage: xyz <command>",
  82   "Commands:", unlines [
  83       "\tinit\t\tInitialise a new site",
  84       "\tbuild\t\tBuild the site",
  85       "\tentry\t\tInitialise an entry"
  86                        ]
  87   ]
  88
  89 parse ["init"] = init >> exitSuccess
  90 parse ["build"] = continueIfValidProject build >> exitSuccess
  91 parse ["entry"] = continueIfValidProject entry >> exitSuccess
  92 parse [_] = usage >> exit
  93 parse [] = usage >> exit
  94
  95 exit = exitWith ExitSuccess