packages feed

muon-0.1.0.3: 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 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"
    copyFile (d ++ "/config.ini") "config.ini"
    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