1 {-# LANGUAGE OverloadedStrings #-}
6 import System.Environment
8 import System.Directory
9 import Prelude hiding (init)
10 import Data.List (intercalate)
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)
20 main = getArgs >>= parse
22 continueIfValidProject :: IO() -> IO ()
23 continueIfValidProject nextfn = do
24 jsonExists <- doesFileExist "xyz.json"
27 else putStrLn "This does not appear to be a valid project directory"
31 dirExists <- doesFileExist "xyz.json"
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)
43 writeFile "xyz.json" . encode . toJSObject $ [("name", projectName), ("description", projectDescription), ("theme", theme)]
44 putStrLn "Initialised empty project"
48 fileExists <- doesFileExist "xyz.json"
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"
57 ununlines :: [String] -> String
58 ununlines = intercalate "\n\n"
62 putStrLn "Enter a name for this entry:"
64 putStrLn "YouTube video ID?"
66 ytFilename <- if (ytUrl /= "")
67 then putStrLn "Video filename?" >> getLine >>= return . ("::" ++) . (++ ".webm")
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>"
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
81 then callCommand $ "youtube-dl -f 'webm[height<1080]+bestaudio' \"https://www.youtube.com/watch?v=" ++ ytUrl ++ "\" -o 'build/videos/" ++ (snd . splitAt 2 $ ytFilename) ++ "'"
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"
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
101 exit = exitWith ExitSuccess