{-# 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 " 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