From 4bc34b8a98ffa1e7f3478a596b73c4ab12d9cb1b Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Thu, 14 Jan 2010 20:46:08 +0100 Subject: Added ReaderT to our stack. --- src/Text/Hakyll/File.hs | 8 +++++-- src/Text/Hakyll/Hakyll.hs | 15 +++++++++++++ src/Text/Hakyll/Page.hs | 24 +++++++++++---------- src/Text/Hakyll/Render.hs | 44 +++++++++++++++++++++----------------- src/Text/Hakyll/Render/Internal.hs | 15 +++++++------ src/Text/Hakyll/Renderable.hs | 3 ++- src/Text/Hakyll/Renderables.hs | 6 ++++-- src/Text/Hakyll/Tags.hs | 3 ++- 8 files changed, 75 insertions(+), 43 deletions(-) create mode 100644 src/Text/Hakyll/Hakyll.hs (limited to 'src/Text/Hakyll') diff --git a/src/Text/Hakyll/File.hs b/src/Text/Hakyll/File.hs index 0ed91d5..3dd2538 100644 --- a/src/Text/Hakyll/File.hs +++ b/src/Text/Hakyll/File.hs @@ -17,6 +17,8 @@ import System.Directory import System.FilePath import Control.Monad import Data.List (isPrefixOf) +import Text.Hakyll.Hakyll (Hakyll) +import Control.Monad.Reader (liftIO) -- | Auxiliary function to remove pathSeparators form the start. We don't deal -- with absolute paths here. We also remove $root from the start. @@ -90,8 +92,10 @@ havingExtension :: String -> [FilePath] -> [FilePath] havingExtension extension = filter ((==) extension . takeExtension) -- | Perform an IO action on every file in a given directory. -directory :: (FilePath -> IO ()) -> FilePath -> IO () -directory action dir = getRecursiveContents dir >>= mapM_ action +directory :: (FilePath -> Hakyll ()) -> FilePath -> Hakyll () +directory action dir = do + contents <- liftIO $ getRecursiveContents dir + mapM_ action contents -- | Check if a cache file is still valid. isCacheValid :: FilePath -> [FilePath] -> IO Bool diff --git a/src/Text/Hakyll/Hakyll.hs b/src/Text/Hakyll/Hakyll.hs new file mode 100644 index 0000000..3690914 --- /dev/null +++ b/src/Text/Hakyll/Hakyll.hs @@ -0,0 +1,15 @@ +module Text.Hakyll.Hakyll + ( HakyllConfiguration (..) + , Hakyll + ) where + +import Text.Hakyll.Context (Context) +import System.FilePath (FilePath) +import Control.Monad.Reader (ReaderT) + +data HakyllConfiguration = HakyllConfiguration + { hakyllDestination :: FilePath + , hakyllGlobalContext :: Context + } + +type Hakyll = ReaderT HakyllConfiguration IO diff --git a/src/Text/Hakyll/Page.hs b/src/Text/Hakyll/Page.hs index 0b7776b..cbb881f 100644 --- a/src/Text/Hakyll/Page.hs +++ b/src/Text/Hakyll/Page.hs @@ -11,10 +11,12 @@ import qualified Data.List as L import Data.Maybe (fromMaybe) import Control.Parallel.Strategies (rnf, ($|)) +import Control.Monad.Reader (liftIO) import System.FilePath (FilePath, takeExtension) import System.IO +import Text.Hakyll.Hakyll (Hakyll) import Text.Hakyll.File import Text.Hakyll.Util (trim) import Text.Hakyll.Context (Context) @@ -66,9 +68,9 @@ renderFunction ext = writeHtmlString writerOptions readFunction _ = readMarkdown -- | Read metadata header from a file handle. -readMetaData :: Handle -> IO [(String, String)] +readMetaData :: Handle -> Hakyll [(String, String)] readMetaData handle = do - line <- hGetLine handle + line <- liftIO $ hGetLine handle if isDelimiter line then return [] else do others <- readMetaData handle @@ -81,8 +83,8 @@ isDelimiter :: String -> Bool isDelimiter = L.isPrefixOf "---" -- | Used for caching of files. -cachePage :: Page -> IO () -cachePage page@(Page mapping) = do +cachePage :: Page -> Hakyll () +cachePage page@(Page mapping) = liftIO $ do let destination = toCache $ getURL page makeDirectories destination handle <- openFile destination WriteMode @@ -98,21 +100,21 @@ cachePage page@(Page mapping) = do -- | Read a page from a file. Metadata is supported, and if the filename -- has a .markdown extension, it will be rendered using pandoc. Note that -- pages are not templates, so they should not contain $identifiers. -readPage :: FilePath -> IO Page +readPage :: FilePath -> Hakyll Page readPage pagePath = do -- Check cache. - getFromCache <- isCacheValid cacheFile [pagePath] + getFromCache <- liftIO $ isCacheValid cacheFile [pagePath] let path = if getFromCache then cacheFile else pagePath -- Read file. - handle <- openFile path ReadMode - line <- hGetLine handle + handle <- liftIO $ openFile path ReadMode + line <- liftIO $ hGetLine handle (metaData, body) <- if isDelimiter line then do md <- readMetaData handle - b <- hGetContents handle + b <- liftIO $ hGetContents handle return (md, b) - else do b <- hGetContents handle + else do b <- liftIO $ hGetContents handle return ([], line ++ "\n" ++ b) -- Render file @@ -123,7 +125,7 @@ readPage pagePath = do , ("path", pagePath) ] ++ metaData - seq (($|) id rnf rendered) $ hClose handle + seq (($|) id rnf rendered) $ liftIO $ hClose handle -- Cache if needed if getFromCache then return () else cachePage page diff --git a/src/Text/Hakyll/Render.hs b/src/Text/Hakyll/Render.hs index d8deea2..4b22836 100644 --- a/src/Text/Hakyll/Render.hs +++ b/src/Text/Hakyll/Render.hs @@ -11,10 +11,12 @@ module Text.Hakyll.Render ) where import Control.Monad (unless, mapM) +import Control.Monad.Reader (liftIO) import System.Directory (copyFile) import System.IO +import Text.Hakyll.Hakyll (Hakyll) import Text.Hakyll.Context (ContextManipulation) import Text.Hakyll.Page import Text.Hakyll.Renderable @@ -26,17 +28,17 @@ import Text.Hakyll.Render.Internal -- | Execute an IO action only when the cache is invalid. depends :: FilePath -- ^ File to be rendered or created. -> [FilePath] -- ^ Files the render depends on. - -> IO () -- ^ IO action to execute when the file is out of date. - -> IO () + -> Hakyll () -- ^ IO action to execute when the file is out of date. + -> Hakyll () depends file dependencies action = do - valid <- isCacheValid (toDestination file) dependencies + valid <- liftIO $ isCacheValid (toDestination file) dependencies unless valid action -- | Render to a Page. render :: Renderable a => FilePath -- ^ Template to use for rendering. -> a -- ^ Renderable object to render with given template. - -> IO Page -- ^ The body of the result will contain the render. + -> Hakyll Page -- ^ The body of the result will contain the render. render = renderWith id -- | Render to a Page. This function allows you to manipulate the context @@ -45,15 +47,15 @@ renderWith :: Renderable a => ContextManipulation -- ^ Manipulation to apply on the context. -> FilePath -- ^ Template to use for rendering. -> a -- ^ Renderable object to render with given template. - -> IO Page -- ^ The body of the result will contain the render. + -> Hakyll Page -- ^ The body of the result will contain the render. renderWith manipulation templatePath renderable = do - template <- readFile templatePath + template <- liftIO $ readFile templatePath context <- toContext renderable return $ fromContext $ pureRenderWith manipulation template context -- | Render each renderable with the given template, then concatenate the -- result. -renderAndConcat :: Renderable a => FilePath -> [a] -> IO String +renderAndConcat :: Renderable a => FilePath -> [a] -> Hakyll String renderAndConcat = renderAndConcatWith id -- | Render each renderable with the given template, then concatenate the @@ -63,41 +65,43 @@ renderAndConcatWith :: Renderable a => ContextManipulation -> FilePath -> [a] - -> IO String + -> Hakyll String renderAndConcatWith manipulation templatePath renderables = do - template <- readFile templatePath + template <- liftIO $ readFile templatePath contexts <- mapM toContext renderables return $ pureRenderAndConcatWith manipulation template contexts -- | Chain a render action for a page with a number of templates. This will -- also write the result to the site destination. This is the preferred way -- to do general rendering. -renderChain :: Renderable a => [FilePath] -> a -> IO () +renderChain :: Renderable a => [FilePath] -> a -> Hakyll () renderChain = renderChainWith id -- | A more custom render chain that allows you to specify a -- "ContextManipulation" which to apply on the context when it is read first. renderChainWith :: Renderable a - => ContextManipulation -> [FilePath] -> a -> IO () + => ContextManipulation -> [FilePath] -> a -> Hakyll () renderChainWith manipulation templatePaths renderable = - depends (getURL renderable) (getDependencies renderable ++ templatePaths) $ - do templates <- mapM readFile templatePaths - context <- toContext renderable - let result = pureRenderChainWith manipulation templates context - writePage $ fromContext result + depends (getURL renderable) dependencies render' + where + dependencies = (getDependencies renderable) ++ templatePaths + render' = do templates <- liftIO $ mapM readFile templatePaths + context <- toContext renderable + let result = pureRenderChainWith manipulation templates context + writePage $ fromContext result -- | Mark a certain file as static, so it will just be copied when the site is -- generated. -static :: FilePath -> IO () -static source = depends destination [source] action +static :: FilePath -> Hakyll () +static source = depends destination [source] (liftIO action) where destination = toDestination source action = do makeDirectories destination copyFile source destination -- | Render a css file, compressing it. -css :: FilePath -> IO () -css source = depends destination [source] css' +css :: FilePath -> Hakyll () +css source = depends destination [source] (liftIO css') where destination = toDestination source css' = do contents <- readFile source diff --git a/src/Text/Hakyll/Render/Internal.hs b/src/Text/Hakyll/Render/Internal.hs index 3b9bfbb..379c4c9 100644 --- a/src/Text/Hakyll/Render/Internal.hs +++ b/src/Text/Hakyll/Render/Internal.hs @@ -11,6 +11,8 @@ module Text.Hakyll.Render.Internal import qualified Data.Map as M import Text.Hakyll.Context (Context, ContextManipulation) +import Control.Monad.Reader (ask, liftIO) +import Control.Monad (liftM) import Data.List (isPrefixOf, foldl') import Data.Char (isAlpha) import Data.Maybe (fromMaybe) @@ -18,6 +20,7 @@ import Control.Parallel.Strategies (rnf, ($|)) import Text.Hakyll.Renderable import Text.Hakyll.Page import Text.Hakyll.File +import Text.Hakyll.Hakyll (Hakyll, hakyllGlobalContext) -- | Substitutes `$identifiers` in the given string by values from the given -- "Context". When a key is not found, it is left as it is. You can here @@ -79,13 +82,13 @@ pureRenderChainWith manipulation templates context = -- | Write a page to the site destination. Final action after render -- chains and such. -writePage :: Page -> IO () +writePage :: Page -> Hakyll () writePage page = do + globalContext <- liftM hakyllGlobalContext ask let destination = toDestination url - makeDirectories destination - writeFile destination body + context = (M.singleton "root" $ toRoot url) `M.union` globalContext + liftIO $ makeDirectories destination +    -- Substitute $root here, just before writing. + liftIO $ writeFile destination $ finalSubstitute (getBody page) context where url = getURL page -    -- Substitute $root here, just before writing. -    body = finalSubstitute (getBody page) -                           (M.singleton "root" $ toRoot url) diff --git a/src/Text/Hakyll/Renderable.hs b/src/Text/Hakyll/Renderable.hs index c8e780e..cafdb3c 100644 --- a/src/Text/Hakyll/Renderable.hs +++ b/src/Text/Hakyll/Renderable.hs @@ -2,13 +2,14 @@ module Text.Hakyll.Renderable ( Renderable(toContext, getDependencies, getURL) ) where +import Text.Hakyll.Hakyll (Hakyll) import System.FilePath (FilePath) import Text.Hakyll.Context (Context) -- | A class for datatypes that can be rendered to pages. class Renderable a where -- | Get a context to do substitutions with. - toContext :: a -> IO Context + toContext :: a -> Hakyll Context -- | Get the dependencies for the renderable. This is used for cache -- invalidation. diff --git a/src/Text/Hakyll/Renderables.hs b/src/Text/Hakyll/Renderables.hs index 26d1e86..19f25b5 100644 --- a/src/Text/Hakyll/Renderables.hs +++ b/src/Text/Hakyll/Renderables.hs @@ -5,6 +5,7 @@ module Text.Hakyll.Renderables , createPagePath ) where +import Text.Hakyll.Hakyll (Hakyll) import System.FilePath (FilePath) import qualified Data.Map as M import Text.Hakyll.Page @@ -15,13 +16,14 @@ import Text.Hakyll.File data CustomPage = CustomPage { url :: String, dependencies :: [FilePath], - mapping :: [(String, Either String (IO String))] + mapping :: [(String, Either String (Hakyll String))] } -- | Create a custom page. createCustomPage :: String -- ^ Destination of the page, relative to _site. -> [FilePath] -- ^ Dependencies of the page. - -> [(String, Either String (IO String))] -- ^ Key - value mapping for rendering. + -> [(String, Either String (Hakyll String))] -- ^ Key - value + -- mapping. -> CustomPage createCustomPage = CustomPage diff --git a/src/Text/Hakyll/Tags.hs b/src/Text/Hakyll/Tags.hs index 625584e..209d479 100644 --- a/src/Text/Hakyll/Tags.hs +++ b/src/Text/Hakyll/Tags.hs @@ -9,6 +9,7 @@ module Text.Hakyll.Tags import qualified Data.Map as M import Data.List (intercalate) import Control.Monad (foldM) +import Text.Hakyll.Hakyll (Hakyll) import Text.Hakyll.Context (ContextManipulation, renderValue) import Text.Hakyll.Regex @@ -19,7 +20,7 @@ import Control.Arrow (second) -- | Read a tag map. This creates a map from tags to page paths. This function -- assumes the tags are located in the `tags` metadata field, separated by -- commas. -readTagMap :: [FilePath] -> IO (M.Map String [FilePath]) +readTagMap :: [FilePath] -> Hakyll (M.Map String [FilePath]) readTagMap paths = foldM addPaths M.empty paths where addPaths current path = do -- cgit v1.2.3