1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
--------------------------------------------------------------------------------
-- | Module providing the main hakyll function and command-line argument parsing
{-# LANGUAGE CPP #-}
module Hakyll.Main
( hakyll
, hakyllWith
, hakyllWithArgs
, hakyllWithExitCode
) where
--------------------------------------------------------------------------------
import System.Environment (getProgName)
import System.IO.Unsafe (unsafePerformIO)
import System.Exit (ExitCode(ExitSuccess), exitWith)
--------------------------------------------------------------------------------
import Options.Applicative
--------------------------------------------------------------------------------
import qualified Hakyll.Check as Check
import qualified Hakyll.Commands as Commands
import qualified Hakyll.Core.Configuration as Config
import qualified Hakyll.Core.Logger as Logger
import Hakyll.Core.Rules
--------------------------------------------------------------------------------
-- | This usually is the function with which the user runs the hakyll compiler
hakyll :: Rules a -> IO ()
hakyll = hakyllWith Config.defaultConfiguration
--------------------------------------------------------------------------------
-- | A variant of 'hakyll' which allows the user to specify a custom
-- configuration
hakyllWith :: Config.Configuration -> Rules a -> IO ()
hakyllWith conf rules = hakyllWithExitCode conf rules >>= exitWith
--------------------------------------------------------------------------------
-- | A variant of 'hakyll' which returns an 'ExitCode'
hakyllWithExitCode :: Config.Configuration -> Rules a -> IO ExitCode
hakyllWithExitCode conf rules = do
args <- defaultParser conf
hakyllWithExitCodeAndArgs conf args rules
--------------------------------------------------------------------------------
-- | A variant of 'hakyll' which expects a 'Configuration' and command-line
-- 'Options'. This gives freedom to implement your own parsing.
hakyllWithArgs :: Config.Configuration -> Options -> Rules a -> IO ()
hakyllWithArgs conf args rules =
hakyllWithExitCodeAndArgs conf args rules >>= exitWith
--------------------------------------------------------------------------------
hakyllWithExitCodeAndArgs :: Config.Configuration ->
Options -> Rules a -> IO ExitCode
hakyllWithExitCodeAndArgs conf args rules = do
let args' = optCommand args
verbosity' = if verbosity args then Logger.Debug else Logger.Message
check =
if internal_links args' then Check.InternalLinks else Check.All
logger <- Logger.new verbosity'
invokeCommands args' conf check logger rules
--------------------------------------------------------------------------------
defaultParser :: Config.Configuration -> IO Options
defaultParser conf =
customExecParser (prefs showHelpOnError)
(info (helper <*> optionParser conf)
(fullDesc <> progDesc
(progName ++ " - Static site compiler created with Hakyll")))
--------------------------------------------------------------------------------
invokeCommands :: Command -> Config.Configuration ->
Check.Check -> Logger.Logger -> Rules a -> IO ExitCode
invokeCommands args conf check logger rules =
case args of
Build -> Commands.build conf logger rules
Check _ -> Commands.check conf logger check >> ok
Clean -> Commands.clean conf logger >> ok
Deploy -> Commands.deploy conf
Preview p -> Commands.preview conf logger rules p >> ok
Rebuild -> Commands.rebuild conf logger rules
Server _ _ -> Commands.server conf logger (host args) (port args) >> ok
Watch _ p s -> Commands.watch conf logger (host args) p (not s) rules >> ok
where
ok = return ExitSuccess
--------------------------------------------------------------------------------
data Options = Options {verbosity :: Bool, optCommand :: Command}
deriving (Show)
data Command
= Build
| Check {internal_links :: Bool}
| Clean
| Deploy
| Preview {port :: Int}
| Rebuild
| Server {host :: String, port :: Int}
| Watch {host :: String, port :: Int, no_server :: Bool }
deriving (Show)
optionParser :: Config.Configuration -> Parser Options
optionParser conf = Options <$> verboseParser <*> commandParser conf
where
verboseParser = switch (long "verbose" <> short 'v' <> help "Run in verbose mode")
commandParser :: Config.Configuration -> Parser Command
commandParser conf = subparser $ foldr ((<>) . produceCommand) mempty commands
where
produceCommand (a,b) = command a (info (helper <*> fst b) (snd b))
portParser = option auto (long "port" <> help "Port to listen on" <> value (Config.previewPort conf))
hostParser = strOption (long "host" <> help "Host to bind on" <> value (Config.previewHost conf))
commands = [
("build", (pure Build,fullDesc <> progDesc "Generate the site")),
("check", (pure Check <*> switch (long "internal-links" <> help "Check internal links only"), fullDesc <> progDesc "Validate the site output")),
("clean", (pure Clean,fullDesc <> progDesc "Clean up and remove cache")),
("deploy", (pure Deploy,fullDesc <> progDesc "Upload/deploy your site")),
("preview", (pure Preview <*> portParser,fullDesc <> progDesc "[DEPRECATED] Please use the watch command")),
("rebuild", (pure Rebuild,fullDesc <> progDesc "Clean and build again")),
("server", (pure Server <*> hostParser <*> portParser,fullDesc <> progDesc "Start a preview server")),
("watch", (pure Watch <*> hostParser <*> portParser <*> switch (long "no-server" <> help "Disable the built-in web server"),fullDesc <> progDesc "Autocompile on changes and start a preview server. You can watch and recompile without running a server with --no-server."))
]
--------------------------------------------------------------------------------
-- | This is necessary because not everyone calls their program the same...
progName :: String
progName = unsafePerformIO getProgName
{-# NOINLINE progName #-}
|
