Option to choose between preview modes
This commit is contained in:
parent
48b170601f
commit
1af0421efe
2 changed files with 40 additions and 3 deletions
|
@ -13,16 +13,19 @@ module Text.Hakyll
|
||||||
, hakyllWithConfiguration
|
, hakyllWithConfiguration
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Control.Concurrent (forkIO, threadDelay)
|
||||||
import Control.Monad.Reader (runReaderT, liftIO, ask)
|
import Control.Monad.Reader (runReaderT, liftIO, ask)
|
||||||
import Control.Monad (when)
|
import Control.Monad (when)
|
||||||
import Data.Monoid (mempty)
|
import Data.Monoid (mempty)
|
||||||
import System.Environment (getArgs, getProgName)
|
import System.Environment (getArgs, getProgName)
|
||||||
import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
|
import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
|
||||||
|
import System.Time (getClockTime)
|
||||||
|
|
||||||
import Text.Pandoc
|
import Text.Pandoc
|
||||||
|
|
||||||
import Network.Hakyll.SimpleServer (simpleServer)
|
import Network.Hakyll.SimpleServer (simpleServer)
|
||||||
import Text.Hakyll.HakyllMonad
|
import Text.Hakyll.HakyllMonad
|
||||||
|
import Text.Hakyll.File
|
||||||
|
|
||||||
-- | The default reader options for pandoc parsing.
|
-- | The default reader options for pandoc parsing.
|
||||||
--
|
--
|
||||||
|
@ -52,6 +55,7 @@ defaultHakyllConfiguration absoluteUrl' = HakyllConfiguration
|
||||||
, siteDirectory = "_site"
|
, siteDirectory = "_site"
|
||||||
, cacheDirectory = "_cache"
|
, cacheDirectory = "_cache"
|
||||||
, enableIndexUrl = False
|
, enableIndexUrl = False
|
||||||
|
, previewMode = BuildOnRequest
|
||||||
, pandocParserState = defaultPandocParserState
|
, pandocParserState = defaultPandocParserState
|
||||||
, pandocWriterOptions = defaultPandocWriterOptions
|
, pandocWriterOptions = defaultPandocWriterOptions
|
||||||
}
|
}
|
||||||
|
@ -74,13 +78,35 @@ hakyllWithConfiguration configuration buildFunction = do
|
||||||
args <- getArgs
|
args <- getArgs
|
||||||
let f = case args of ["build"] -> buildFunction
|
let f = case args of ["build"] -> buildFunction
|
||||||
["clean"] -> clean
|
["clean"] -> clean
|
||||||
["preview", p] -> server (read p) buildFunction
|
["preview", p] -> preview (read p)
|
||||||
["preview"] -> server 8000 buildFunction
|
["preview"] -> preview defaultPort
|
||||||
["rebuild"] -> clean >> buildFunction
|
["rebuild"] -> clean >> buildFunction
|
||||||
["server", p] -> server (read p) (return ())
|
["server", p] -> server (read p) (return ())
|
||||||
["server"] -> server 8000 (return ())
|
["server"] -> server defaultPort (return ())
|
||||||
_ -> help
|
_ -> help
|
||||||
runReaderT f configuration
|
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 up directories.
|
||||||
--
|
--
|
||||||
|
|
|
@ -1,6 +1,7 @@
|
||||||
-- | Module describing the Hakyll monad stack.
|
-- | Module describing the Hakyll monad stack.
|
||||||
module Text.Hakyll.HakyllMonad
|
module Text.Hakyll.HakyllMonad
|
||||||
( HakyllConfiguration (..)
|
( HakyllConfiguration (..)
|
||||||
|
, PreviewMode (..)
|
||||||
, Hakyll
|
, Hakyll
|
||||||
, askHakyll
|
, askHakyll
|
||||||
, getAdditionalContext
|
, getAdditionalContext
|
||||||
|
@ -15,9 +16,17 @@ import Text.Pandoc (ParserState, WriterOptions)
|
||||||
import Text.Hakyll.Context (Context (..))
|
import Text.Hakyll.Context (Context (..))
|
||||||
|
|
||||||
-- | Our custom monad stack.
|
-- | Our custom monad stack.
|
||||||
|
--
|
||||||
type Hakyll = ReaderT HakyllConfiguration IO
|
type Hakyll = ReaderT HakyllConfiguration IO
|
||||||
|
|
||||||
|
-- | Preview mode.
|
||||||
|
--
|
||||||
|
data PreviewMode = BuildOnRequest
|
||||||
|
| BuildOnInterval
|
||||||
|
deriving (Show, Eq, Ord)
|
||||||
|
|
||||||
-- | Hakyll global configuration type.
|
-- | Hakyll global configuration type.
|
||||||
|
--
|
||||||
data HakyllConfiguration = HakyllConfiguration
|
data HakyllConfiguration = HakyllConfiguration
|
||||||
{ -- | Absolute URL of the site.
|
{ -- | Absolute URL of the site.
|
||||||
absoluteUrl :: String
|
absoluteUrl :: String
|
||||||
|
@ -30,6 +39,8 @@ data HakyllConfiguration = HakyllConfiguration
|
||||||
cacheDirectory :: FilePath
|
cacheDirectory :: FilePath
|
||||||
, -- | Enable index links.
|
, -- | Enable index links.
|
||||||
enableIndexUrl :: Bool
|
enableIndexUrl :: Bool
|
||||||
|
, -- | The preview mode used
|
||||||
|
previewMode :: PreviewMode
|
||||||
, -- | Pandoc parsing options
|
, -- | Pandoc parsing options
|
||||||
pandocParserState :: ParserState
|
pandocParserState :: ParserState
|
||||||
, -- | Pandoc writer options
|
, -- | Pandoc writer options
|
||||||
|
|
Loading…
Reference in a new issue