summaryrefslogtreecommitdiff
path: root/src/Text/Hakyll.hs
blob: 506a0a9d0be4c534aca4eec13118d93c0b403f40 (plain)
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
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
-- | 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

    , module Text.Hakyll.Context
    , module Text.Hakyll.ContextManipulations
    , module Text.Hakyll.CreateContext
    , module Text.Hakyll.File
    , module Text.Hakyll.HakyllMonad
    , module Text.Hakyll.Regex
    , module Text.Hakyll.Render
    , module Text.Hakyll.HakyllAction
    , module Text.Hakyll.Paginate
    , module Text.Hakyll.Util
    , module Text.Hakyll.Tags
    , module Text.Hakyll.Feed
    , module Text.Hakyll.Configurations.Static
    ) 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.Context
import Text.Hakyll.ContextManipulations
import Text.Hakyll.CreateContext
import Text.Hakyll.File
import Text.Hakyll.HakyllMonad
import Text.Hakyll.Regex
import Text.Hakyll.Render
import Text.Hakyll.HakyllAction
import Text.Hakyll.Paginate
import Text.Hakyll.Util
import Text.Hakyll.Tags
import Text.Hakyll.Feed
import Text.Hakyll.Configurations.Static

-- | 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"