diff options
Diffstat (limited to 'src/Text/Hakyll/Renderables.hs')
| -rw-r--r-- | src/Text/Hakyll/Renderables.hs | 73 |
1 files changed, 26 insertions, 47 deletions
diff --git a/src/Text/Hakyll/Renderables.hs b/src/Text/Hakyll/Renderables.hs index 42c05cc..37bd521 100644 --- a/src/Text/Hakyll/Renderables.hs +++ b/src/Text/Hakyll/Renderables.hs @@ -14,14 +14,11 @@ import Control.Arrow (second) import Control.Monad (liftM2, mplus) import Control.Applicative ((<$>)) -import Data.Binary -import Text.Hakyll.Hakyll (Hakyll) -import Text.Hakyll.Renderable import Text.Hakyll.File import Text.Hakyll.Context -import Text.Hakyll.Render import Text.Hakyll.RenderAction +import Text.Hakyll.Render import Text.Hakyll.Internal.Page -- | Create a custom page. @@ -33,16 +30,17 @@ import Text.Hakyll.Internal.Page -- cases. createCustomPage :: String -> [FilePath] - -> [(String, Either String (Hakyll String))] + -> [(String, Either String (RenderAction () String))] -> RenderAction () Context createCustomPage url dependencies association = RenderAction { actionDependencies = dependencies - , actionDestination = Just $ return url - , actionFunction = actionFunction' + , actionUrl = Just $ return url + , actionFunction = \_ -> M.fromList <$> assoc' } where mtuple (a, b) = b >>= \b' -> return (a, b') - actionFunction' () = M.fromList <$> mapM (mtuple . second (either return id)) association + toHakyllString = second (either return runRenderAction) + assoc' = mapM (mtuple . toHakyllString) association -- | A @createCustomPage@ function specialized in creating listings. -- @@ -57,10 +55,9 @@ createCustomPage url dependencies association = RenderAction -- > -- render the items with. -- > posts -- ^ Renderables to create the list with. -- > [("title", "Home")] -- ^ Additional context -createListing :: (Renderable a) - => String -- ^ Destination of the page. +createListing :: String -- ^ Destination of the page. -> FilePath -- ^ Template to render all items with. - -> [a] -- ^ Renderables in the list. + -> [RenderAction () Context] -- ^ Renderables in the list. -> [(String, String)] -- ^ Additional context. -> RenderAction () Context createListing = createListingWith id @@ -69,17 +66,16 @@ createListing = createListingWith id -- -- In addition to @createListing@, this function allows you to specify an -- extra @ContextManipulation@ for all @Renderable@s given. -createListingWith :: (Renderable a) - => ContextManipulation -- ^ Manipulation for the renderables. +createListingWith :: ContextManipulation -- ^ Manipulation for the renderables. -> String -- ^ Destination of the page. -> FilePath -- ^ Template to render all items with. - -> [a] -- ^ Renderables in the list. + -> [RenderAction () Context] -- ^ Renderables in the list. -> [(String, String)] -- ^ Additional context. -> RenderAction () Context createListingWith manipulation url template renderables additional = createCustomPage url dependencies context where - dependencies = template : concatMap getDependencies renderables + dependencies = template : concatMap actionDependencies renderables context = ("body", Right concatenation) : additional' concatenation = renderAndConcatWith manipulation [template] renderables additional' = map (second Left) additional @@ -93,7 +89,7 @@ newtype PagePath = PagePath FilePath createPagePath :: FilePath -> RenderAction () Context createPagePath path = RenderAction { actionDependencies = [path] - , actionDestination = Just $ toUrl path + , actionUrl = Just $ toUrl path , actionFunction = const (readPage path) } @@ -112,38 +108,21 @@ combine :: RenderAction () Context -> RenderAction () Context -> RenderAction () Context combine x y = RenderAction { actionDependencies = actionDependencies x ++ actionDependencies y - , actionDestination = actionDestination x `mplus` actionDestination y - , actionFunction = \_ -> liftM2 (M.union) (actionFunction x ()) (actionFunction y ()) + , actionUrl = actionUrl x `mplus` actionUrl y + , actionFunction = \_ -> + liftM2 (M.union) (runRenderAction x) (runRenderAction y) } -- | Combine two renderables and set a custom URL. This behaves like @combine@, -- except that for the @url@ field, the given URL is always chosen. -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 _ _) = return 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 +combineWithUrl :: FilePath + -> RenderAction () Context + -> RenderAction () Context + -> RenderAction () Context +combineWithUrl url x y = combine' + { actionUrl = Just $ return url + , actionFunction = \_ -> + (M.insert "url" url) <$> runRenderAction combine' + } + where + combine' = combine x y |