packages feed

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