cmdargs isn't pretty but it's the best we have...

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 #-}