diff options
Diffstat (limited to 'src/Hakyll')
| -rw-r--r-- | src/Hakyll/Commands.hs | 128 | ||||
| -rw-r--r-- | src/Hakyll/Core/Configuration.hs | 2 | ||||
| -rw-r--r-- | src/Hakyll/Main.hs | 194 |
3 files changed, 190 insertions, 134 deletions
diff --git a/src/Hakyll/Commands.hs b/src/Hakyll/Commands.hs new file mode 100644 index 0000000..88905ea --- /dev/null +++ b/src/Hakyll/Commands.hs @@ -0,0 +1,128 @@ +-------------------------------------------------------------------------------- +-- | Implementation of Hakyll commands: build, preview... +{-# LANGUAGE CPP #-} +module Hakyll.Commands + ( build + , check + , clean + , preview + , rebuild + , server + , deploy + ) where + + +-------------------------------------------------------------------------------- +import Control.Monad (when) +import System.Directory (doesDirectoryExist, + removeDirectoryRecursive) +import System.Exit (exitWith) +import System.Process (system) + + +-------------------------------------------------------------------------------- +import qualified Hakyll.Check as Check +import Hakyll.Core.Configuration +import Hakyll.Core.Rules +import Hakyll.Core.Runtime + + +-------------------------------------------------------------------------------- +#ifdef PREVIEW_SERVER +import Control.Applicative ((<$>)) +import Control.Concurrent (forkIO) +import qualified Data.Set as S +import Hakyll.Core.Identifier +import Hakyll.Core.Rules.Internal +import Hakyll.Preview.Poll +import Hakyll.Preview.Server +#endif + + +-------------------------------------------------------------------------------- +-- | Build the site +build :: Configuration -> Rules a -> IO () +build conf rules = do + _ <- run conf rules + return () + + +-------------------------------------------------------------------------------- +-- | Run the checker and exit +check :: Configuration -> IO () +check config = Check.check config >>= exitWith + + +-------------------------------------------------------------------------------- +-- | Remove the output directories +clean :: Configuration -> IO () +clean conf = do + remove $ destinationDirectory conf + remove $ storeDirectory conf + where + remove dir = do + putStrLn $ "Removing " ++ dir ++ "..." + exists <- doesDirectoryExist dir + when exists $ removeDirectoryRecursive dir + + +-------------------------------------------------------------------------------- +-- | Preview the site +preview :: Configuration -> Rules a -> Int -> IO () +#ifdef PREVIEW_SERVER +preview conf rules port = do + -- Fork a thread polling for changes + _ <- forkIO $ previewPoll conf update + + -- Run the server in the main thread + server conf port + where + update = map toFilePath . S.toList . rulesResources <$> run conf rules +#else +preview _ _ _ = previewServerDisabled +#endif + + +-------------------------------------------------------------------------------- +-- | Rebuild the site +rebuild :: Configuration -> Rules a -> IO () +rebuild conf rules = do + clean conf + build conf rules + + +-------------------------------------------------------------------------------- +-- | Start a server +server :: Configuration -> Int -> IO () +#ifdef PREVIEW_SERVER +server conf port = do + let destination = destinationDirectory conf + staticServer destination preServeHook port + where + preServeHook _ = return () +#else +server _ _ = previewServerDisabled +#endif + + +-------------------------------------------------------------------------------- +-- | Upload the site +deploy :: Configuration -> IO () +deploy conf = do + _ <- system $ deployCommand conf + return () + + +-------------------------------------------------------------------------------- +-- | Print a warning message about the preview serving not being enabled +#ifndef PREVIEW_SERVER +previewServerDisabled :: IO () +previewServerDisabled = + mapM_ putStrLn + [ "PREVIEW SERVER" + , "" + , "The preview server is not enabled in the version of Hakyll. To" + , "enable it, set the flag to True and recompile Hakyll." + , "Alternatively, use an external tool to serve your site directory." + ] +#endif diff --git a/src/Hakyll/Core/Configuration.hs b/src/Hakyll/Core/Configuration.hs index b5b5f77..c45d1a3 100644 --- a/src/Hakyll/Core/Configuration.hs +++ b/src/Hakyll/Core/Configuration.hs @@ -57,7 +57,7 @@ data Configuration = Configuration , -- | Use an in-memory cache for items. This is faster but uses more -- memory. inMemoryCache :: Bool - -- | Verbosity for the logger + -- | Verbosity for the logger. Can be overwritten by the command-line. , verbosity :: Verbosity } diff --git a/src/Hakyll/Main.hs b/src/Hakyll/Main.hs index 2d05e21..e7f10ab 100644 --- a/src/Hakyll/Main.hs +++ b/src/Hakyll/Main.hs @@ -1,6 +1,7 @@ -------------------------------------------------------------------------------- -- | Module providing the main hakyll function and command-line argument parsing -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} module Hakyll.Main ( hakyll , hakyllWith @@ -8,171 +9,98 @@ module Hakyll.Main -------------------------------------------------------------------------------- -import Control.Monad (when) -import System.Directory (doesDirectoryExist, - removeDirectoryRecursive) -import System.Environment (getArgs, getProgName) -import System.Exit (exitWith) -import System.Process (system) +import System.Console.CmdArgs +import qualified System.Console.CmdArgs.Explicit as CA +import System.Environment (getProgName) +import System.IO.Unsafe (unsafePerformIO) -------------------------------------------------------------------------------- -import qualified Hakyll.Check as Check -import Hakyll.Core.Configuration +import qualified Hakyll.Commands as Commands +import qualified Hakyll.Core.Configuration as Config +import qualified Hakyll.Core.Logger as Logger import Hakyll.Core.Rules -import Hakyll.Core.Runtime - - --------------------------------------------------------------------------------- -#ifdef PREVIEW_SERVER -import Control.Applicative ((<$>)) -import Control.Concurrent (forkIO) -import qualified Data.Set as S -import Hakyll.Core.Identifier -import Hakyll.Core.Rules.Internal -import Hakyll.Preview.Poll -import Hakyll.Preview.Server -#endif -------------------------------------------------------------------------------- -- | This usualy is the function with which the user runs the hakyll compiler hakyll :: Rules a -> IO () -hakyll = hakyllWith defaultConfiguration +hakyll = hakyllWith Config.defaultConfiguration -------------------------------------------------------------------------------- -- | A variant of 'hakyll' which allows the user to specify a custom -- configuration -hakyllWith :: Configuration -> Rules a -> IO () +hakyllWith :: Config.Configuration -> Rules a -> IO () hakyllWith conf rules = do - args <- getArgs - case args of - ["build"] -> build conf rules - ["check"] -> check conf - ["clean"] -> clean conf - ["help"] -> help - ["preview"] -> preview conf rules 8000 - ["preview", p] -> preview conf rules (read p) - ["rebuild"] -> rebuild conf rules - ["server"] -> server conf 8000 - ["server", p] -> server conf (read p) - ["deploy"] -> deploy conf - _ -> help - - --------------------------------------------------------------------------------- --- | Build the site -build :: Configuration -> Rules a -> IO () -build conf rules = do - _ <- run conf rules - return () - + args' <- cmdArgs hakyllArgs --------------------------------------------------------------------------------- --- | Run the checker and exit -check :: Configuration -> IO () -check config = Check.check config >>= exitWith + -- Overwrite conf based on args + let conf' = conf + { Config.verbosity = + if verbose args' then Logger.Debug else Config.verbosity conf + } - --------------------------------------------------------------------------------- --- | Remove the output directories -clean :: Configuration -> IO () -clean conf = do - remove $ destinationDirectory conf - remove $ storeDirectory conf - where - remove dir = do - putStrLn $ "Removing " ++ dir ++ "..." - exists <- doesDirectoryExist dir - when exists $ removeDirectoryRecursive dir + case args' of + Build _ -> Commands.build conf' rules + Check _ -> Commands.check conf' + Clean _ -> Commands.clean conf' + Deploy _ -> Commands.deploy conf' + Help _ -> showHelp + Preview _ p -> Commands.preview conf' rules p + Rebuild _ -> Commands.rebuild conf' rules + Server _ _ -> Commands.server conf' (port args') -------------------------------------------------------------------------------- -- | Show usage information. -help :: IO () -help = do - name <- getProgName - mapM_ putStrLn - [ "ABOUT" - , "" - , "This is a Hakyll site generator program. You should always" - , "run it from the project root directory." - , "" - , "USAGE" - , "" - , name ++ " build Generate the site" - , name ++ " clean Clean up and remove cache" - , name ++ " help Show this message" - , name ++ " preview [port] Run a server and autocompile" - , name ++ " rebuild Clean up and build again" - , name ++ " server [port] Run a local test server" - , name ++ " deploy Upload/deploy your site" - , "" - ] - -#ifndef PREVIEW_SERVER - previewServerDisabled -#endif +showHelp :: IO () +showHelp = print $ CA.helpText [] CA.HelpFormatOne $ cmdArgsMode hakyllArgs -------------------------------------------------------------------------------- --- | Preview the site -preview :: Configuration -> Rules a -> Int -> IO () -#ifdef PREVIEW_SERVER -preview conf rules port = do - -- Fork a thread polling for changes - _ <- forkIO $ previewPoll conf update - - -- Run the server in the main thread - server conf port - where - update = map toFilePath . S.toList . rulesResources <$> run conf rules -#else -preview _ _ _ = previewServerDisabled -#endif +data HakyllArgs + = Build {verbose :: Bool} + | Check {verbose :: Bool} + | Clean {verbose :: Bool} + | Deploy {verbose :: Bool} + | Help {verbose :: Bool} + | Preview {verbose :: Bool, port :: Int} + | Rebuild {verbose :: Bool} + | Server {verbose :: Bool, port :: Int} + deriving (Data, Typeable, Show) -------------------------------------------------------------------------------- --- | Rebuild the site -rebuild :: Configuration -> Rules a -> IO () -rebuild conf rules = do - clean conf - build conf rules +hakyllArgs :: HakyllArgs +hakyllArgs = modes + [ (Build $ verboseFlag def) &= help "Generate the site" + , (Check $ verboseFlag def) &= help "Validate the site output" + , (Clean $ verboseFlag def) &= help "Clean up and remove cache" + , (Deploy $ verboseFlag def) &= help "Upload/deploy your site" + , (Help $ verboseFlag def) &= help "Show this message" &= auto + , (Preview (verboseFlag def) (portFlag 8000)) &= + help "Start a preview server and autocompile on changes" + , (Rebuild $ verboseFlag def) &= help "Clean and build again" + , (Server (verboseFlag def) (portFlag 8000)) &= + help "Start a preview server" + ] &= help "Hakyll static site compiler" &= program progName -------------------------------------------------------------------------------- --- | Start a server -server :: Configuration -> Int -> IO () -#ifdef PREVIEW_SERVER -server conf port = do - let destination = destinationDirectory conf - staticServer destination preServeHook port - where - preServeHook _ = return () -#else -server _ _ = previewServerDisabled -#endif +verboseFlag :: Data a => a -> a +verboseFlag x = x &= help "Run in verbose mode" +{-# INLINE verboseFlag #-} -------------------------------------------------------------------------------- --- | Upload the site -deploy :: Configuration -> IO () -deploy conf = do - _ <- system $ deployCommand conf - return () +portFlag :: Data a => a -> a +portFlag x = x &= help "Port to listen on" +{-# INLINE portFlag #-} -------------------------------------------------------------------------------- --- | Print a warning message about the preview serving not being enabled -#ifndef PREVIEW_SERVER -previewServerDisabled :: IO () -previewServerDisabled = - mapM_ putStrLn - [ "PREVIEW SERVER" - , "" - , "The preview server is not enabled in the version of Hakyll. To" - , "enable it, set the flag to True and recompile Hakyll." - , "Alternatively, use an external tool to serve your site directory." - ] -#endif +-- | This is necessary because not everyone calls their program the same... +progName :: String +progName = unsafePerformIO getProgName +{-# NOINLINE progName #-} |