@@ -1,6 +1,7 @@
11--------------------------------------------------------------------------------
22-- | Module providing the main hakyll function and command-line argument parsing
3−{-# LANGUAGE CPP #-}
3+{-# LANGUAGE CPP #-}
4+{-# LANGUAGE DeriveDataTypeable #-}
45module Hakyll.Main
56 ( hakyll
67 , hakyllWith
@@ -8,171 +9,98 @@ module Hakyll.Main
89
910
1011--------------------------------------------------------------------------------
11−import Control.Monad (when)
12−import System.Directory (doesDirectoryExist,
13− removeDirectoryRecursive)
14−import System.Environment (getArgs, getProgName)
15−import System.Exit (exitWith)
16−import System.Process (system)
12+import System.Console.CmdArgs
13+import qualified System.Console.CmdArgs.Explicit as CA
14+import System.Environment (getProgName)
15+import System.IO.Unsafe (unsafePerformIO)
1716
1817
1918--------------------------------------------------------------------------------
20−import qualified Hakyll.Check as Check
21−import Hakyll.Core.Configuration
19+import qualified Hakyll.Commands as Commands
20+import qualified Hakyll.Core.Configuration as Config
21+import qualified Hakyll.Core.Logger as Logger
2222import Hakyll.Core.Rules
23−import Hakyll.Core.Runtime
24−
25−
26−--------------------------------------------------------------------------------
27−#ifdef PREVIEW_SERVER
28−import Control.Applicative ((<$>))
29−import Control.Concurrent (forkIO)
30−import qualified Data.Set as S
31−import Hakyll.Core.Identifier
32−import Hakyll.Core.Rules.Internal
33−import Hakyll.Preview.Poll
34−import Hakyll.Preview.Server
35−#endif
3623
3724
3825--------------------------------------------------------------------------------
3926-- | This usualy is the function with which the user runs the hakyll compiler
4027hakyll :: Rules a -> IO ()
41−hakyll = hakyllWith defaultConfiguration
28+hakyll = hakyllWith Config.defaultConfiguration
4229
4330
4431--------------------------------------------------------------------------------
4532-- | A variant of 'hakyll' which allows the user to specify a custom
4633-- configuration
47−hakyllWith :: Configuration -> Rules a -> IO ()
34+hakyllWith :: Config.Configuration -> Rules a -> IO ()
4835hakyllWith conf rules = do
49− args <- getArgs
50− case args of
51− ["build"] -> build conf rules
52− ["check"] -> check conf
53− ["clean"] -> clean conf
54− ["help"] -> help
55− ["preview"] -> preview conf rules 8000
56− ["preview", p] -> preview conf rules (read p)
57− ["rebuild"] -> rebuild conf rules
58− ["server"] -> server conf 8000
59− ["server", p] -> server conf (read p)
60− ["deploy"] -> deploy conf
61− _ -> help
62−
63−
64−--------------------------------------------------------------------------------
65−-- | Build the site
66−build :: Configuration -> Rules a -> IO ()
67−build conf rules = do
68− _ <- run conf rules
69− return ()
70−
36+ args' <- cmdArgs hakyllArgs
7137
72−--------------------------------------------------------------------------------
73−-- | Run the checker and exit
74−check :: Configuration -> IO ()
75−check config = Check.check config >>= exitWith
38+ -- Overwrite conf based on args
39+ let conf' = conf
40+ { Config.verbosity =
41+ if verbose args' then Logger.Debug else Config.verbosity conf
42+ }
7643
77−
78−--------------------------------------------------------------------------------
79−-- | Remove the output directories
80−clean :: Configuration -> IO ()
81−clean conf = do
82− remove $ destinationDirectory conf
83− remove $ storeDirectory conf
84− where
85− remove dir = do
86− putStrLn $ "Removing " ++ dir ++ "..."
87− exists <- doesDirectoryExist dir
88− when exists $ removeDirectoryRecursive dir
44+ case args' of
45+ Build _ -> Commands.build conf' rules
46+ Check _ -> Commands.check conf'
47+ Clean _ -> Commands.clean conf'
48+ Deploy _ -> Commands.deploy conf'
49+ Help _ -> showHelp
50+ Preview _ p -> Commands.preview conf' rules p
51+ Rebuild _ -> Commands.rebuild conf' rules
52+ Server _ _ -> Commands.server conf' (port args')
8953
9054
9155--------------------------------------------------------------------------------
9256-- | Show usage information.
93−help :: IO ()
94−help = do
95− name <- getProgName
96− mapM_ putStrLn
97− [ "ABOUT"
98− , ""
99− , "This is a Hakyll site generator program. You should always"
100− , "run it from the project root directory."
101− , ""
102− , "USAGE"
103− , ""
104− , name ++ " build Generate the site"
105− , name ++ " clean Clean up and remove cache"
106− , name ++ " help Show this message"
107− , name ++ " preview [port] Run a server and autocompile"
108− , name ++ " rebuild Clean up and build again"
109− , name ++ " server [port] Run a local test server"
110− , name ++ " deploy Upload/deploy your site"
111− , ""
112− ]
113−
114−#ifndef PREVIEW_SERVER
115− previewServerDisabled
116−#endif
57+showHelp :: IO ()
58+showHelp = print $ CA.helpText [] CA.HelpFormatOne $ cmdArgsMode hakyllArgs
11759
11860
11961--------------------------------------------------------------------------------
120−-- | Preview the site
121−preview :: Configuration -> Rules a -> Int -> IO ()
122−#ifdef PREVIEW_SERVER
123−preview conf rules port = do
124− -- Fork a thread polling for changes
125− _ <- forkIO $ previewPoll conf update
126−
127− -- Run the server in the main thread
128− server conf port
129− where
130− update = map toFilePath . S.toList . rulesResources <$> run conf rules
131−#else
132−preview _ _ _ = previewServerDisabled
133−#endif
62+data HakyllArgs
63+ = Build {verbose :: Bool}
64+ | Check {verbose :: Bool}
65+ | Clean {verbose :: Bool}
66+ | Deploy {verbose :: Bool}
67+ | Help {verbose :: Bool}
68+ | Preview {verbose :: Bool, port :: Int}
69+ | Rebuild {verbose :: Bool}
70+ | Server {verbose :: Bool, port :: Int}
71+ deriving (Data, Typeable, Show)
13472
13573
13674--------------------------------------------------------------------------------
137−-- | Rebuild the site
138−rebuild :: Configuration -> Rules a -> IO ()
139−rebuild conf rules = do
140− clean conf
141− build conf rules
75+hakyllArgs :: HakyllArgs
76+hakyllArgs = modes
77+ [ (Build $ verboseFlag def) &= help "Generate the site"
78+ , (Check $ verboseFlag def) &= help "Validate the site output"
79+ , (Clean $ verboseFlag def) &= help "Clean up and remove cache"
80+ , (Deploy $ verboseFlag def) &= help "Upload/deploy your site"
81+ , (Help $ verboseFlag def) &= help "Show this message" &= auto
82+ , (Preview (verboseFlag def) (portFlag 8000)) &=
83+ help "Start a preview server and autocompile on changes"
84+ , (Rebuild $ verboseFlag def) &= help "Clean and build again"
85+ , (Server (verboseFlag def) (portFlag 8000)) &=
86+ help "Start a preview server"
87+ ] &= help "Hakyll static site compiler" &= program progName
14288
14389
14490--------------------------------------------------------------------------------
145−-- | Start a server
146−server :: Configuration -> Int -> IO ()
147−#ifdef PREVIEW_SERVER
148−server conf port = do
149− let destination = destinationDirectory conf
150− staticServer destination preServeHook port
151− where
152− preServeHook _ = return ()
153−#else
154−server _ _ = previewServerDisabled
155−#endif
91+verboseFlag :: Data a => a -> a
92+verboseFlag x = x &= help "Run in verbose mode"
93+{-# INLINE verboseFlag #-}
15694
15795
15896--------------------------------------------------------------------------------
159−-- | Upload the site
160−deploy :: Configuration -> IO ()
161−deploy conf = do
162− _ <- system $ deployCommand conf
163− return ()
97+portFlag :: Data a => a -> a
98+portFlag x = x &= help "Port to listen on"
99+{-# INLINE portFlag #-}
164100
165101
166102--------------------------------------------------------------------------------
167−-- | Print a warning message about the preview serving not being enabled
168−#ifndef PREVIEW_SERVER
169−previewServerDisabled :: IO ()
170−previewServerDisabled =
171− mapM_ putStrLn
172− [ "PREVIEW SERVER"
173− , ""
174− , "The preview server is not enabled in the version of Hakyll. To"
175− , "enable it, set the flag to True and recompile Hakyll."
176− , "Alternatively, use an external tool to serve your site directory."
177− ]
178−#endif
103+-- | This is necessary because not everyone calls their program the same...
104+progName :: String
105+progName = unsafePerformIO getProgName
106+{-# NOINLINE progName #-}