muon-0.1.0.8: src/Main.hs
{-# LANGUAGE OverloadedStrings #-}
module Main where
import qualified Data.Text as T
import Text.StringTemplate
import Control.Monad
import Control.Exception
import System.Directory
import System.FilePath.Glob
import System.Environment
import System.Process (runInteractiveCommand)
import Post (generatePosts)
import Home (generateHome)
import Archive (generateArchive)
import Page (generatePages)
import Server (startServer)
import Constant
import Config
import Paths_muon
checkBlog = doesFileExist "config.ini"
ensureDirs = mkdir sitePath
copyDef dir file = copyFile (dir ++ "/" ++ file) file
createDefaults = do
d <- getDataFileName "def"
mapM_ mkdir siteDirs
mkdir "static"
copyDef d "style/style.css"
copyDef d "posts/first.post"
copyDef d "posts/second.post"
copyDef d "templates/post.st"
copyDef d "templates/header.st"
copyDef d "templates/footer.st"
copyDef d "templates/generic.st"
copyDef d "pages/about"
copyDef d "pages/contact"
copyDef d "config.ini"
putStrLn "Initialised site directory"
copyStatic = do
copyFile "style/style.css" (sitePath ++ "style.css")
runInteractiveCommand $ "cp -R static " ++ sitePath ++ "static"
generateSite = copyStatic
>> generatePosts
>> generateHome
>> generateArchive
>> generatePages
showHelp = putStrLn "Usage: muon [commands]\n\n\
\ help show this help message\n\
\ init initialise a default blog in the current dir\n\
\ generate generate static blog in 'site' directory\n\
\ serve serve site at localhost:8000\n\
\ upload upload site to server\n\n\
\Report bugs to <kaashif@kaashif.co.uk>"
clearSite = mkdir sitePath
>> removeDirectoryRecursive sitePath
>> mkdir sitePath
printRun :: String -> IO ()
printRun cmd = putStrLn ("Running \'" ++ cmd ++ "\'")
>> runInteractiveCommand cmd >> return ()
proc :: String -> IO ()
proc cmd
| cmd == "help" = showHelp
| cmd == "init" = createDefaults
| cmd == "generate" = clearSite >> generateSite
| cmd == "serve" = putStrLn "Serving site at http://127.0.0.1:8000/"
>> startServer
| cmd == "upload" = rsyncCmd >>= printRun
| otherwise = putStrLn (cmd ++ " is not a valid command!") >> showHelp
getArgsHelp = do
a <- getArgs
if length a < 1
then return ["help"]
else return a
takeAction :: [String] -> IO ()
takeAction args = mapM_ proc args
specialCase :: [String] -> Bool
specialCase args = elem (args !! 0) ["help", "init"]
main = do
isBlog <- checkBlog
args <- getArgsHelp
special <- catch (return $ specialCase args)
(\e -> let _ = (e :: ArrayException) in return False)
if (isBlog || special)
then ensureDirs >> takeAction args
else putStrLn "This directory is not a blog." >> showHelp