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
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
|
-- | This is the main Hakyll module, exporting the important @hakyll@ function.
--
-- Most configurations would use this @hakyll@ function more or less as the
-- main function:
--
-- > main = hakyll $ do
-- > directory css "css"
-- > directory static "images"
--
module Text.Hakyll
( defaultHakyllConfiguration
, hakyll
, hakyllWithConfiguration
, runDefaultHakyll
) where
import Control.Concurrent (forkIO, threadDelay)
import Control.Monad.Reader (runReaderT, liftIO, ask)
import Control.Monad (when)
import Data.Monoid (mempty)
import System.Environment (getArgs, getProgName)
import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
import System.Time (getClockTime)
import Text.Pandoc
import Text.Hamlet (defaultHamletSettings)
import Network.Hakyll.SimpleServer (simpleServer)
import Text.Hakyll.HakyllMonad
import Text.Hakyll.File
-- | The default reader options for pandoc parsing.
--
defaultPandocParserState :: ParserState
defaultPandocParserState = defaultParserState
{ -- The following option causes pandoc to read smart typography, a nice
-- and free bonus.
stateSmart = True
}
-- | The default writer options for pandoc rendering.
--
defaultPandocWriterOptions :: WriterOptions
defaultPandocWriterOptions = defaultWriterOptions
{ -- This option causes literate haskell to be written using '>' marks in
-- html, which I think is a good default.
writerLiterateHaskell = True
}
-- | The default hakyll configuration.
--
defaultHakyllConfiguration :: String -- ^ Absolute site URL.
-> HakyllConfiguration -- ^ Default config.
defaultHakyllConfiguration absoluteUrl' = HakyllConfiguration
{ absoluteUrl = absoluteUrl'
, additionalContext = mempty
, siteDirectory = "_site"
, cacheDirectory = "_cache"
, enableIndexUrl = False
, previewMode = BuildOnRequest
, pandocParserState = defaultPandocParserState
, pandocWriterOptions = defaultPandocWriterOptions
, hamletSettings = defaultHamletSettings
}
-- | Main function to run Hakyll with the default configuration. The
-- absolute URL is only used in certain cases, for example RSS feeds et
-- cetera.
--
hakyll :: String -- ^ Absolute URL of your site. Used in certain cases.
-> Hakyll () -- ^ You code.
-> IO ()
hakyll absolute = hakyllWithConfiguration configuration
where
configuration = defaultHakyllConfiguration absolute
-- | Main function to run hakyll with a custom configuration.
--
hakyllWithConfiguration :: HakyllConfiguration -> Hakyll () -> IO ()
hakyllWithConfiguration configuration buildFunction = do
args <- getArgs
let f = case args of ["build"] -> buildFunction
["clean"] -> clean
["preview", p] -> preview (read p)
["preview"] -> preview defaultPort
["rebuild"] -> clean >> buildFunction
["server", p] -> server (read p) (return ())
["server"] -> server defaultPort (return ())
_ -> help
runReaderT f configuration
where
preview port = case previewMode configuration of
BuildOnRequest -> server port buildFunction
BuildOnInterval -> do
let pIO = runReaderT (previewThread buildFunction) configuration
_ <- liftIO $ forkIO pIO
server port (return ())
defaultPort = 8000
-- | A preview thread that periodically recompiles the site.
--
previewThread :: Hakyll () -- ^ Build function
-> Hakyll () -- ^ Result
previewThread buildFunction = run =<< liftIO getClockTime
where
delay = 1000000
run time = do liftIO $ threadDelay delay
contents <- getRecursiveContents "."
valid <- isMoreRecent time contents
when valid buildFunction
run =<< liftIO getClockTime
-- | Clean up directories.
--
clean :: Hakyll ()
clean = do askHakyll siteDirectory >>= remove'
askHakyll cacheDirectory >>= remove'
where
remove' dir = liftIO $ do putStrLn $ "Removing " ++ dir ++ "..."
exists <- doesDirectoryExist dir
when exists $ removeDirectoryRecursive dir
-- | Show usage information.
--
help :: Hakyll ()
help = liftIO $ do
name <- getProgName
putStrLn $ "This is a Hakyll site generator program. You should always\n"
++ "run it from the project root directory.\n"
++ "\n"
++ "Usage:\n"
++ name ++ " build Generate the site.\n"
++ name ++ " clean Clean up and remove cache.\n"
++ name ++ " help Show this message.\n"
++ name ++ " preview [port] Run a server and autocompile.\n"
++ name ++ " rebuild Clean up and build again.\n"
++ name ++ " server [port] Run a local test server.\n"
-- | Start a server at the given port number.
--
server :: Integer -- ^ Port number to serve on.
-> Hakyll () -- ^ Pre-respond action.
-> Hakyll ()
server port preRespond = do
configuration <- ask
root <- askHakyll siteDirectory
let preRespondIO = runReaderT preRespond configuration
liftIO $ simpleServer (fromIntegral port) root preRespondIO
-- | Run a Hakyll action with default settings. This is mostly aimed at testing
-- code.
--
runDefaultHakyll :: Hakyll a -> IO a
runDefaultHakyll f =
runReaderT f $ defaultHakyllConfiguration "http://example.com"
|
