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)
  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   entryNum <- fmap ((+1) . length) $ allFilesIn "entries"
  65   stamp <- fmap round getPOSIXTime
  66   let filename = "entries/" ++ (show entryNum) ++ "-" ++ (unpack . (toLower. replace " " "-") $ pack entryName) ++ ".txt"
  67   writeFile filename (show stamp ++ "::" ++ entryName ++ "\n")
  68   putStrLn $ "Created " ++ filename
  69   callCommand $ "emacsclient " ++ filename ++ " &"
  70
  71 usage :: IO ()
  72 usage =  putStr . ununlines $ [
  73   "usage: xyz <command>",
  74   "Commands:", unlines [
  75       "\tinit\t\tInitialise a new site",
  76       "\tbuild\t\tBuild the site",
  77       "\tentry\t\tInitialise an entry"
  78                        ]
  79   ]
  80
  81 parse ["init"] = init >> exit
  82 parse ["build"] = continueIfValidProject build >> exit
  83 parse ["entry"] = continueIfValidProject entry >> exit
  84 parse [_] = usage >> exit
  85 parse [] = usage >> exit
  86
  87 exit = exitWith ExitSuccess