git.iko.soy/hakyll
on master help sign in
Option to choose between preview modes
1af0421Jasper Van der Jeugt
src/Text/Hakyll.hs+29−3
compare with master
unifiedsplit
@@ -13,16 +13,19 @@ module Text.Hakyll
13 , hakyllWithConfiguration
13 , hakyllWithConfiguration
14 ) where
14 ) where
15
15
16+import Control.Concurrent (forkIO, threadDelay)
16import Control.Monad.Reader (runReaderT, liftIO, ask)
17import Control.Monad.Reader (runReaderT, liftIO, ask)
17import Control.Monad (when)
18import Control.Monad (when)
18import Data.Monoid (mempty)
19import Data.Monoid (mempty)
19import System.Environment (getArgs, getProgName)
20import System.Environment (getArgs, getProgName)
20import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
21import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
22+import System.Time (getClockTime)
21
23
22import Text.Pandoc
24import Text.Pandoc
23
25
24import Network.Hakyll.SimpleServer (simpleServer)
26import Network.Hakyll.SimpleServer (simpleServer)
25import Text.Hakyll.HakyllMonad
27import Text.Hakyll.HakyllMonad
28+import Text.Hakyll.File
26
29
27-- | The default reader options for pandoc parsing.
30-- | The default reader options for pandoc parsing.
28--
31--
@@ -52,6 +55,7 @@ defaultHakyllConfiguration absoluteUrl' = HakyllConfiguration
52 , siteDirectory = "_site"
55 , siteDirectory = "_site"
53 , cacheDirectory = "_cache"
56 , cacheDirectory = "_cache"
54 , enableIndexUrl = False
57 , enableIndexUrl = False
58+ , previewMode = BuildOnRequest
55 , pandocParserState = defaultPandocParserState
59 , pandocParserState = defaultPandocParserState
56 , pandocWriterOptions = defaultPandocWriterOptions
60 , pandocWriterOptions = defaultPandocWriterOptions
57 }
61 }
@@ -74,13 +78,35 @@ hakyllWithConfiguration configuration buildFunction = do
74 args <- getArgs
78 args <- getArgs
75 let f = case args of ["build"] -> buildFunction
79 let f = case args of ["build"] -> buildFunction
76 ["clean"] -> clean
80 ["clean"] -> clean
77− ["preview", p] -> server (read p) buildFunction
81+ ["preview", p] -> preview (read p)
78− ["preview"] -> server 8000 buildFunction
82+ ["preview"] -> preview defaultPort
79 ["rebuild"] -> clean >> buildFunction
83 ["rebuild"] -> clean >> buildFunction
80 ["server", p] -> server (read p) (return ())
84 ["server", p] -> server (read p) (return ())
81− ["server"] -> server 8000 (return ())
85+ ["server"] -> server defaultPort (return ())
82 _ -> help
86 _ -> help
83 runReaderT f configuration
87 runReaderT f configuration
88+ where
89+ preview port = case previewMode configuration of
90+ BuildOnRequest -> server port buildFunction
91+ BuildOnInterval -> do
92+ let pIO = runReaderT (previewThread buildFunction) configuration
93+ _ <- liftIO $ forkIO pIO
94+ server port (return ())
95+
96+ defaultPort = 8000
97+
98+-- | A preview thread that periodically recompiles the site.
99+--
100+previewThread :: Hakyll () -- ^ Build function
101+ -> Hakyll () -- ^ Result
102+previewThread buildFunction = run =<< liftIO getClockTime
103+ where
104+ delay = 1000000
105+ run time = do liftIO $ threadDelay delay
106+ contents <- getRecursiveContents "."
107+ valid <- isMoreRecent time contents
108+ when valid buildFunction
109+ run =<< liftIO getClockTime
84
110
85-- | Clean up directories.
111-- | Clean up directories.
86--
112--
src/Text/Hakyll/HakyllMonad.hs+11
@@ -1,6 +1,7 @@
1-- | Module describing the Hakyll monad stack.
1-- | Module describing the Hakyll monad stack.
2module Text.Hakyll.HakyllMonad
2module Text.Hakyll.HakyllMonad
3 ( HakyllConfiguration (..)
3 ( HakyllConfiguration (..)
4+ , PreviewMode (..)
4 , Hakyll
5 , Hakyll
5 , askHakyll
6 , askHakyll
6 , getAdditionalContext
7 , getAdditionalContext
@@ -15,9 +16,17 @@ import Text.Pandoc (ParserState, WriterOptions)
15import Text.Hakyll.Context (Context (..))
16import Text.Hakyll.Context (Context (..))
16
17
17-- | Our custom monad stack.
18-- | Our custom monad stack.
19+--
18type Hakyll = ReaderT HakyllConfiguration IO
20type Hakyll = ReaderT HakyllConfiguration IO
19
21
22+-- | Preview mode.
23+--
24+data PreviewMode = BuildOnRequest
25+ | BuildOnInterval
26+ deriving (Show, Eq, Ord)
27+
20-- | Hakyll global configuration type.
28-- | Hakyll global configuration type.
29+--
21data HakyllConfiguration = HakyllConfiguration
30data HakyllConfiguration = HakyllConfiguration
22 { -- | Absolute URL of the site.
31 { -- | Absolute URL of the site.
23 absoluteUrl :: String
32 absoluteUrl :: String
@@ -30,6 +39,8 @@ data HakyllConfiguration = HakyllConfiguration
30 cacheDirectory :: FilePath
39 cacheDirectory :: FilePath
31 , -- | Enable index links.
40 , -- | Enable index links.
32 enableIndexUrl :: Bool
41 enableIndexUrl :: Bool
42+ , -- | The preview mode used
43+ previewMode :: PreviewMode
33 , -- | Pandoc parsing options
44 , -- | Pandoc parsing options
34 pandocParserState :: ParserState
45 pandocParserState :: ParserState
35 , -- | Pandoc writer options
46 , -- | Pandoc writer options