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   ytLink <- if (ytUrl /= "")
  71     then return $ "\n<a href=\"https://www.youtube.com/watch?v=" ++ ytUrl ++ "\">https://www.youtube.com/watch?v=" ++ ytUrl ++ "</a>"
  72     else return ""
  73
  74   entryNum <- fmap ((+1) . length) $ allFilesIn "entries"
  75   stamp <- fmap round getPOSIXTime
  76   let filename = "entries/" ++ (show entryNum) ++ "-" ++ (unpack . (toLower. replace " " "-") $ pack entryName) ++ ".txt"
  77   writeFile filename (show stamp ++ "::" ++ entryName ++ ytFilename ++ "\nEntry goes here!\nᚳᚱᛒ" ++ ytLink)
  78   putStrLn $ "Created " ++ filename
  79   callCommand $ "nano " ++ filename
  80   if (ytUrl /= "")
  81     then callCommand $ "youtube-dl -f 'webm[height<1080]+bestaudio' \"https://www.youtube.com/watch?v=" ++ ytUrl ++ "\" -o 'build/videos/" ++ (snd . splitAt 2 $ ytFilename)   ++ "'"
  82     else return ()
  83   build
  84
  85 usage :: IO ()
  86 usage =  putStr . ununlines $ [
  87   "usage: xyz <command>",
  88   "Commands:", unlines [
  89       "\tinit\t\tInitialise a new site",
  90       "\tbuild\t\tBuild the site",
  91       "\tentry\t\tInitialise an entry"
  92                        ]
  93   ]
  94
  95 parse ["init"] = init >> exitSuccess
  96 parse ["build"] = continueIfValidProject build >> exitSuccess
  97 parse ["entry"] = continueIfValidProject entry >> exitSuccess
  98 parse [_] = usage >> exit
  99 parse [] = usage >> exit
 100
 101 exit = exitWith ExitSuccess