packages feed

muon-0.1.0.0: src/Main.hs

{-# LANGUAGE OverloadedStrings #-}
module Main where

import qualified Data.Text as T
import Text.StringTemplate
import Control.Monad
import System.Directory
import System.FilePath.Glob
import System.Environment
import System.Process (runCommand)
import Post (generatePosts)
import Home (generateHome)
import Archive (generateArchive)
import Site (defaultSite)
import Page (generatePages)
import Constant
import Paths_muon

ensureDirs = mkdir sitePath

createDefaults = do
    d <- getDataFileName "def"
    mapM_ mkdir siteDirs
    mkdir "static"
    copyFile (d ++ "/style/style.css") "style/style.css"
    copyFile (d ++ "/posts/first.post") "posts/first.post"
    copyFile (d ++ "/posts/second.post") "posts/second.post"
    copyFile (d ++ "/templates/post.st") "templates/post.st"
    copyFile (d ++ "/templates/header.st") "templates/header.st"
    copyFile (d ++ "/templates/footer.st") "templates/footer.st"
    copyFile (d ++ "/templates/generic.st") "templates/generic.st"
    copyFile (d ++ "/pages/about") "pages/about"
    copyFile (d ++ "/pages/contact") "pages/contact"
    putStrLn "Initialised site directory"

copyStatic = do
    copyFile "style/style.css" (sitePath ++ "style.css")
    runCommand $ "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\n\
\Report bugs to <kaashif@kaashif.co.uk>"

clearSite = mkdir sitePath 
         >> removeDirectoryRecursive sitePath 
         >> mkdir sitePath

rsyncCmd = "rsync -a --delete site/ root@webserver:/var/www/htdocs/"

proc ::  String -> IO ()
proc cmd
    | cmd == "init" = createDefaults
    | cmd == "generate" = clearSite >> generateSite
    | cmd == "upload" = void $ runCommand rsyncCmd
    | otherwise = showHelp

getArgsHelp = do
    a <- getArgs
    if length a < 1
        then return ["help"]
        else return a

takeAction = getArgsHelp >>= mapM_ proc

main = ensureDirs >> takeAction