diff options
Diffstat (limited to 'src/Text/Hakyll')
-rw-r--r-- | src/Text/Hakyll/Renderables.hs | 60 |
1 files changed, 52 insertions, 8 deletions
diff --git a/src/Text/Hakyll/Renderables.hs b/src/Text/Hakyll/Renderables.hs index 0151f10..5832a09 100644 --- a/src/Text/Hakyll/Renderables.hs +++ b/src/Text/Hakyll/Renderables.hs @@ -3,6 +3,9 @@ module Text.Hakyll.Renderables , createCustomPage , PagePath , createPagePath + , CombinedRenderable + , combine + , combineWithURL ) where import qualified Data.Map as M @@ -14,9 +17,9 @@ import Text.Hakyll.File -- | A custom page. data CustomPage = CustomPage - { url :: String, - dependencies :: [FilePath], - mapping :: [(String, Either String (Hakyll String))] + { customPageURL :: String, + customPageDependencies :: [FilePath], + customPageContext :: [(String, Either String (Hakyll String))] } -- | Create a custom page. @@ -33,12 +36,12 @@ createCustomPage :: String -- ^ Destination of the page, relative to _site. createCustomPage = CustomPage instance Renderable CustomPage where - getDependencies = dependencies - getURL = url + getDependencies = customPageDependencies + getURL = customPageURL toContext page = do - values <- mapM (either (return) (>>= return) . snd) (mapping page) - return $ M.fromList $ [ ("url", url page) - ] ++ zip (map fst $ mapping page) values + values <- mapM (either return id . snd) (customPageContext page) + return $ M.fromList $ [ ("url", customPageURL page) + ] ++ zip (map fst $ customPageContext page) values -- | PagePath is a class that wraps a FilePath. This is used to render Pages -- without reading them first through use of caching. @@ -53,3 +56,44 @@ instance Renderable PagePath where getDependencies (PagePath path) = return path getURL (PagePath path) = toURL path toContext (PagePath path) = readPage path >>= toContext + +-- | A combination of two other renderables. +data CombinedRenderable a b = CombinedRenderable a b + | CombinedRenderableWithURL FilePath a b + +-- | Combine two renderables. The url will always be taken from the first +-- "Renderable". Also, if a `$key` is present in both renderables, the +-- value from the first "Renderable" will be taken as well. +combine :: (Renderable a, Renderable b) => a -> b -> CombinedRenderable a b +combine = CombinedRenderable + +-- | Combine two renderables and set a custom URL. +combineWithURL :: (Renderable a, Renderable b) + => FilePath + -> a + -> b + -> CombinedRenderable a b +combineWithURL = CombinedRenderableWithURL + +-- | Render combinations. +instance (Renderable a, Renderable b) + => Renderable (CombinedRenderable a b) where + + -- Add the dependencies. + getDependencies (CombinedRenderable a b) = + getDependencies a ++ getDependencies b + getDependencies (CombinedRenderableWithURL _ a b) = + getDependencies a ++ getDependencies b + + -- Take the url from the first renderable, or the specified URL. + getURL (CombinedRenderable a _) = getURL a + getURL (CombinedRenderableWithURL url _ _) = url + + -- Take a union of the contexts. + toContext (CombinedRenderable a b) = do + c1 <- toContext a + c2 <- toContext b + return $ c1 `M.union` c2 + toContext (CombinedRenderableWithURL url a b) = do + c <- toContext (CombinedRenderable a b) + return $ (M.singleton "url" url) `M.union` c |