diff options
| -rw-r--r-- | src/Network/Hakyll/SimpleServer.hs | 9 | ||||
| -rw-r--r-- | src/Text/Hakyll.hs | 51 | ||||
| -rw-r--r-- | src/Text/Hakyll/HakyllMonad.hs | 2 |
3 files changed, 29 insertions, 33 deletions
diff --git a/src/Network/Hakyll/SimpleServer.hs b/src/Network/Hakyll/SimpleServer.hs index f17c490..4eef689 100644 --- a/src/Network/Hakyll/SimpleServer.hs +++ b/src/Network/Hakyll/SimpleServer.hs @@ -188,8 +188,12 @@ respond handle = do -- | Start a simple http server on the given 'PortNumber', serving the given -- directory. -simpleServer :: PortNumber -> FilePath -> IO () -simpleServer port root = do +-- +simpleServer :: PortNumber -- ^ Port to listen on. + -> FilePath -- ^ Root directory to serve. + -> IO () -- ^ Optional pre-respond action. + -> IO () +simpleServer port root preRespond = do -- Channel to send logs to logChan <- newChan @@ -200,6 +204,7 @@ simpleServer port root = do -- When a client connects, respond in a separate thread. listen socket = do (handle, _, _) <- accept socket + preRespond forkIO (runReaderT (respond handle) config) -- Handle logging in a separate thread diff --git a/src/Text/Hakyll.hs b/src/Text/Hakyll.hs index 8f74556..517c68d 100644 --- a/src/Text/Hakyll.hs +++ b/src/Text/Hakyll.hs @@ -14,20 +14,18 @@ module Text.Hakyll ) where import Control.Monad.Reader (runReaderT, liftIO, ask) -import Control.Concurrent (forkIO, threadDelay) import Control.Monad (when) import qualified Data.Map as M import System.Environment (getArgs, getProgName) import System.Directory (doesDirectoryExist, removeDirectoryRecursive) -import System.Time (getClockTime) import Text.Pandoc 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 @@ -36,6 +34,7 @@ defaultPandocParserState = defaultParserState } -- | The default writer options for pandoc rendering. +-- defaultPandocWriterOptions :: WriterOptions defaultPandocWriterOptions = defaultWriterOptions { -- This option causes literate haskell to be written using '>' marks in @@ -44,6 +43,7 @@ defaultPandocWriterOptions = defaultWriterOptions } -- | The default hakyll configuration. +-- defaultHakyllConfiguration :: HakyllConfiguration defaultHakyllConfiguration = HakyllConfiguration { absoluteUrl = "" @@ -51,14 +51,14 @@ defaultHakyllConfiguration = HakyllConfiguration , siteDirectory = "_site" , cacheDirectory = "_cache" , enableIndexUrl = False - , previewPollDelay = 1000000 , pandocParserState = defaultPandocParserState , pandocWriterOptions = defaultPandocWriterOptions } -- | Main function to run Hakyll with the default configuration. The --- absolute URL is only used in certain cases, for example RSS feeds et --- cetera. +-- 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 () @@ -67,20 +67,22 @@ hakyll absolute = hakyllWithConfiguration configuration configuration = defaultHakyllConfiguration { absoluteUrl = 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 buildFunction (read p) - ["preview"] -> preview buildFunction 8000 + ["preview", p] -> server (read p) buildFunction + ["preview"] -> server 8000 buildFunction ["rebuild"] -> clean >> buildFunction - ["server", p] -> server (read p) - ["server"] -> server 8000 + ["server", p] -> server (read p) (return ()) + ["server"] -> server 8000 (return ()) _ -> help runReaderT f configuration -- | Clean up directories. +-- clean :: Hakyll () clean = do askHakyll siteDirectory >>= remove' askHakyll cacheDirectory >>= remove' @@ -89,24 +91,8 @@ clean = do askHakyll siteDirectory >>= remove' exists <- doesDirectoryExist dir when exists $ removeDirectoryRecursive dir --- | Autocompile mode. -preview :: Hakyll () -> Integer -> Hakyll () -preview buildFunction port = do - buildFunction - _ <- startServer - liftIO getClockTime >>= run - where - startServer = do configuration <- ask - liftIO $ forkIO $ runReaderT (server port) configuration - run time = do delay <- askHakyll previewPollDelay - liftIO $ threadDelay delay - contents <- getRecursiveContents "." - valid <- isMoreRecent time contents - if valid then run time - else do buildFunction - liftIO getClockTime >>= run - -- | Show usage information. +-- help :: Hakyll () help = liftIO $ do name <- getProgName @@ -122,5 +108,12 @@ help = liftIO $ do ++ name ++ " server [port] Run a local test server.\n" -- | Start a server at the given port number. -server :: Integer -> Hakyll () -server p = askHakyll siteDirectory >>= liftIO . simpleServer (fromIntegral p) +-- +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 diff --git a/src/Text/Hakyll/HakyllMonad.hs b/src/Text/Hakyll/HakyllMonad.hs index fbfe5ae..372fad1 100644 --- a/src/Text/Hakyll/HakyllMonad.hs +++ b/src/Text/Hakyll/HakyllMonad.hs @@ -30,8 +30,6 @@ data HakyllConfiguration = HakyllConfiguration cacheDirectory :: FilePath , -- | Enable index links. enableIndexUrl :: Bool - , -- | Delay between polls in preview mode. - previewPollDelay :: Int , -- | Pandoc parsing options pandocParserState :: ParserState , -- | Pandoc writer options |