git.iko.soy/hakyll
on master help sign in
Got it to compile again, disabled Tags for now.
1199692Jasper Van der Jeugt
hakyll.cabal+2−2
compare with master
unifiedsplit
@@ -45,11 +45,11 @@ library
45 Text.Hakyll.Regex
45 Text.Hakyll.Regex
46 Text.Hakyll.Render
46 Text.Hakyll.Render
47 Text.Hakyll.RenderAction
47 Text.Hakyll.RenderAction
48− Text.Hakyll.Renderable
48+ -- Text.Hakyll.Renderable
49 Text.Hakyll.Renderables
49 Text.Hakyll.Renderables
50 Text.Hakyll.Paginate
50 Text.Hakyll.Paginate
51 Text.Hakyll.Util
51 Text.Hakyll.Util
52− Text.Hakyll.Tags
52+ -- Text.Hakyll.Tags
53 Text.Hakyll.Internal.Cache
53 Text.Hakyll.Internal.Cache
54 Text.Hakyll.Internal.CompressCss
54 Text.Hakyll.Internal.CompressCss
55 Text.Hakyll.Internal.Page
55 Text.Hakyll.Internal.Page
src/Text/Hakyll/Internal/Page.hs−19
@@ -21,11 +21,8 @@ import Data.Binary
21
21
22import Text.Hakyll.Internal.Cache
22import Text.Hakyll.Internal.Cache
23import Text.Hakyll.Hakyll
23import Text.Hakyll.Hakyll
24−import Text.Hakyll.File
25import Text.Hakyll.Util (trim)
24import Text.Hakyll.Util (trim)
26import Text.Hakyll.Context (Context)
25import Text.Hakyll.Context (Context)
27−import Text.Hakyll.Renderable
28−import Text.Hakyll.RenderAction
29import Text.Hakyll.Regex (substituteRegex, matchesRegex)
26import Text.Hakyll.Regex (substituteRegex, matchesRegex)
30
27
31-- | A Page is basically key-value mapping. Certain keys have special
28-- | A Page is basically key-value mapping. Certain keys have special
@@ -42,16 +39,6 @@ fromContext = Page
42getValue :: String -> Page -> String
39getValue :: String -> Page -> String
43getValue str (Page page) = fromMaybe [] $ M.lookup str page
40getValue str (Page page) = fromMaybe [] $ M.lookup str page
44
41
45−-- | Get the URL for a certain page. This should always be defined. If
46−-- not, it will error.
47−getPageUrl :: Page -> String
48−getPageUrl (Page page) = fromMaybe (error "No page url") $ M.lookup "url" page
49−
50−-- | Get the original page path.
51−getPagePath :: Page -> String
52−getPagePath (Page page) =
53− fromMaybe (error "No page path") $ M.lookup "path" page
54−
55-- | Get the body for a certain page. When not defined, the body will be
42-- | Get the body for a certain page. When not defined, the body will be
56-- empty.
43-- empty.
57getBody :: Page -> String
44getBody :: Page -> String
@@ -155,12 +142,6 @@ readPage path = do
155 where
142 where
156 fileName = "pages" </> path
143 fileName = "pages" </> path
157
144
158−-- Make pages renderable.
159−instance Renderable Page where
160− getDependencies = (:[]) . getPagePath
161− getUrl = return . getPageUrl
162− toContext (Page page) = return page
163−
164-- Make pages serializable.
145-- Make pages serializable.
165instance Binary Page where
146instance Binary Page where
166 put (Page context) = put $ M.toAscList context
147 put (Page context) = put $ M.toAscList context
src/Text/Hakyll/Internal/Render.hs+8−8
@@ -15,10 +15,9 @@ import Data.List (foldl')
15import Data.Maybe (fromMaybe)
15import Data.Maybe (fromMaybe)
16
16
17import Text.Hakyll.Context (Context, ContextManipulation)
17import Text.Hakyll.Context (Context, ContextManipulation)
18−import Text.Hakyll.Renderable
19import Text.Hakyll.File
18import Text.Hakyll.File
20import Text.Hakyll.Hakyll
19import Text.Hakyll.Hakyll
21−import Text.Hakyll.Internal.Page
20+import Text.Hakyll.RenderAction
22import Text.Hakyll.Internal.Template
21import Text.Hakyll.Internal.Template
23
22
24-- | A pure render function.
23-- | A pure render function.
@@ -55,13 +54,14 @@ pureRenderChainWith manipulation templates context =
55
54
56-- | Write a page to the site destination. Final action after render
55-- | Write a page to the site destination. Final action after render
57-- chains and such.
56-- chains and such.
58−writePage :: Page -> Hakyll ()
57+writePage :: RenderAction Context ()
59−writePage page = do
58+writePage = createRenderAction $ \initialContext -> do
60 additionalContext' <- askHakyll additionalContext
59 additionalContext' <- askHakyll additionalContext
61− url <- getUrl page
60+ let url = fromMaybe (error "No url defined at write time.")
62− destination <- toDestination url
61+ (M.lookup "url" initialContext)
62+ body = fromMaybe "" (M.lookup "body" initialContext)
63 let context = additionalContext' `M.union` M.singleton "root" (toRoot url)
63 let context = additionalContext' `M.union` M.singleton "root" (toRoot url)
64+ destination <- toDestination url
64 makeDirectories destination
65 makeDirectories destination
65    -- Substitute $root here, just before writing.
66    -- Substitute $root here, just before writing.
66− liftIO $ writeFile destination $ finalSubstitute (fromString $ getBody page)
67+ liftIO $ writeFile destination $ finalSubstitute (fromString body) context
67− context
src/Text/Hakyll/Paginate.hs+10−10
@@ -55,8 +55,8 @@ paginate :: PaginateConfiguration
55paginate configuration renderables = paginate' Nothing renderables (1 :: Int)
55paginate configuration renderables = paginate' Nothing renderables (1 :: Int)
56 where
56 where
57 -- Create a link with a given label, taken from the configuration.
57 -- Create a link with a given label, taken from the configuration.
58− linkWithLabel f r = case actionDestination r of
58+ linkWithLabel f r = Right $ case actionUrl r of
59− Just l -> link (f configuration) <$> l
59+ Just l -> createSimpleRenderAction $ link (f configuration) <$> l
60 Nothing -> error "No link found for pagination."
60 Nothing -> error "No link found for pagination."
61
61
62 -- The main function that creates combined renderables by recursing over
62 -- The main function that creates combined renderables by recursing over
@@ -66,18 +66,18 @@ paginate configuration renderables = paginate' Nothing renderables (1 :: Int)
66 let (previous, first) = case maybePrev of
66 let (previous, first) = case maybePrev of
67 (Just r) -> ( linkWithLabel previousLabel r
67 (Just r) -> ( linkWithLabel previousLabel r
68 , linkWithLabel firstLabel (head renderables) )
68 , linkWithLabel firstLabel (head renderables) )
69− Nothing -> ( return $ previousLabel configuration
69+ Nothing -> ( Left $ previousLabel configuration
70− , return $ firstLabel configuration )
70+ , Left $ firstLabel configuration )
71 (next, last') = case xs of
71 (next, last') = case xs of
72 (n:_) -> ( linkWithLabel nextLabel n
72 (n:_) -> ( linkWithLabel nextLabel n
73 , linkWithLabel lastLabel (last renderables) )
73 , linkWithLabel lastLabel (last renderables) )
74− [] -> ( return $ nextLabel configuration
74+ [] -> ( Left $ nextLabel configuration
75− , return $ lastLabel configuration )
75+ , Left $ lastLabel configuration )
76 customPage = createCustomPage "" []
76 customPage = createCustomPage "" []
77− [ ("previous", Right previous)
77+ [ ("previous", previous)
78− , ("next", Right next)
78+ , ("next", next)
79− , ("first", Right first)
79+ , ("first", first)
80− , ("last", Right last')
80+ , ("last", last')
81 , ("index", Left $ show index)
81 , ("index", Left $ show index)
82 , ("length", Left $ show $ length renderables)
82 , ("length", Left $ show $ length renderables)
83 ]
83 ]
src/Text/Hakyll/Render.hs+51−40
@@ -13,15 +13,17 @@ module Text.Hakyll.Render
13 ) where
13 ) where
14
14
15import Control.Monad (unless)
15import Control.Monad (unless)
16+import Control.Arrow ((>>>))
16import Control.Monad.Reader (liftIO)
17import Control.Monad.Reader (liftIO)
17import System.Directory (copyFile)
18import System.Directory (copyFile)
19+import Data.Maybe (fromMaybe)
20+import qualified Data.Map as M
18
21
19import Text.Hakyll.Hakyll (Hakyll)
22import Text.Hakyll.Hakyll (Hakyll)
20−import Text.Hakyll.Context (ContextManipulation)
23+import Text.Hakyll.Context (ContextManipulation, Context)
21−import Text.Hakyll.Renderable
22import Text.Hakyll.File
24import Text.Hakyll.File
25+import Text.Hakyll.RenderAction
23import Text.Hakyll.Internal.CompressCss
26import Text.Hakyll.Internal.CompressCss
24−import Text.Hakyll.Internal.Page
25import Text.Hakyll.Internal.Render
27import Text.Hakyll.Internal.Render
26import Text.Hakyll.Internal.Template (readTemplate)
28import Text.Hakyll.Internal.Template (readTemplate)
27
29
@@ -36,23 +38,24 @@ depends file dependencies action = do
36 unless valid action
38 unless valid action
37
39
38-- | Render to a Page.
40-- | Render to a Page.
39−render :: Renderable a
40− => FilePath -- ^ Template to use for rendering.
41+render :: FilePath -- ^ Template to use for rendering.
41− -> a -- ^ Renderable object to render with given template.
42+ -> RenderAction Context Context -- ^ The render computation.
42− -> Hakyll Page -- ^ The body of the result will contain the render.
43render = renderWith id
43render = renderWith id
44
44
45-- | Render to a Page. This function allows you to manipulate the context
45-- | Render to a Page. This function allows you to manipulate the context
46-- first.
46-- first.
47−renderWith :: Renderable a
48− => ContextManipulation -- ^ Manipulation to apply on the context.
47+renderWith :: ContextManipulation -- ^ Manipulation to apply first.
49− -> FilePath -- ^ Template to use for rendering.
48+ -> FilePath -- ^ Template to use for rendering.
50− -> a -- ^ Data to render.
49+ -> RenderAction Context Context -- ^ The render computation.
51− -> Hakyll Page -- ^ Result of the render operation.
50+renderWith manipulation templatePath = RenderAction
52−renderWith manipulation templatePath renderable = do
51+ { actionDependencies = [templatePath]
52+ , actionUrl = Nothing
53+ , actionFunction = actionFunction'
54+ }
55+ where
56+ actionFunction' context = do
53− template <- readTemplate templatePath
57+ template <- readTemplate templatePath
54− context <- toContext renderable
55− return $ fromContext $ pureRenderWith manipulation template context
58+ return $ pureRenderWith manipulation template context
56
59
57-- | Render each renderable with the given templates, then concatenate the
60-- | Render each renderable with the given templates, then concatenate the
58-- result. So, basically this function:
61-- result. So, basically this function:
@@ -64,24 +67,31 @@ renderWith manipulation templatePath renderable = do
64--
67--
65-- * Concatenates the result.
68-- * Concatenates the result.
66--
69--
67−renderAndConcat :: Renderable a
68− => [FilePath] -- ^ Templates to apply on every renderable.
70+renderAndConcat :: [FilePath] -- ^ Templates to apply on every renderable.
69− -> [a] -- ^ Renderables to render.
71+ -> [RenderAction () Context] -- ^ Renderables to render.
70− -> Hakyll String
72+ -> RenderAction () String
71renderAndConcat = renderAndConcatWith id
73renderAndConcat = renderAndConcatWith id
72
74
73-- | Render each renderable with the given templates, then concatenate the
75-- | Render each renderable with the given templates, then concatenate the
74-- result. This function allows you to specify a @ContextManipulation@ to
76-- result. This function allows you to specify a @ContextManipulation@ to
75-- apply on every @Renderable@.
77-- apply on every @Renderable@.
76−renderAndConcatWith :: Renderable a
77− => ContextManipulation
78+renderAndConcatWith :: ContextManipulation
78 -> [FilePath]
79 -> [FilePath]
79− -> [a]
80+ -> [RenderAction () Context]
80− -> Hakyll String
81+ -> RenderAction () String
81−renderAndConcatWith manipulation templatePaths renderables = do
82+renderAndConcatWith manipulation templatePaths renderables = RenderAction
82− templates <- mapM readTemplate templatePaths
83+ { actionDependencies = renders >>= actionDependencies
83− contexts <- mapM toContext renderables
84+ , actionUrl = Nothing
84− return $ pureRenderAndConcatWith manipulation templates contexts
85+ , actionFunction = actionFunction'
86+ }
87+ where
88+ render' = chain (map render templatePaths)
89+ renders = map (>>> manipulationAction >>> render') renderables
90+ manipulationAction = createManipulationAction manipulation
91+
92+ actionFunction' = \_ -> do
93+ contexts <- mapM runRenderAction renders
94+ return $ concatMap (fromMaybe "" . M.lookup "body") contexts
85
95
86-- | Chain a render action for a page with a number of templates. This will
96-- | Chain a render action for a page with a number of templates. This will
87-- also write the result to the site destination. This is the preferred way
97-- also write the result to the site destination. This is the preferred way
@@ -93,23 +103,24 @@ renderAndConcatWith manipulation templatePaths renderables = do
93--
103--
94-- This code will first render @warning.html@ using @templates/notice.html@,
104-- This code will first render @warning.html@ using @templates/notice.html@,
95-- and will then render the result with @templates/default.html@.
105-- and will then render the result with @templates/default.html@.
96−renderChain :: Renderable a => [FilePath] -> a -> Hakyll ()
106+renderChain :: [FilePath] -> RenderAction () Context -> Hakyll ()
97renderChain = renderChainWith id
107renderChain = renderChainWith id
98
108
99-- | A more custom render chain that allows you to specify a
109-- | A more custom render chain that allows you to specify a
100-- @ContextManipulation@ which to apply on the context when it is read first.
110-- @ContextManipulation@ which to apply on the context when it is read first.
101−renderChainWith :: Renderable a
102− => ContextManipulation -> [FilePath] -> a -> Hakyll ()
111+renderChainWith :: ContextManipulation
112+ -> [FilePath]
113+ -> RenderAction () Context
114+ -> Hakyll ()
103−renderChainWith manipulation templatePaths renderable = do
115+renderChainWith manipulation templatePaths initial =
104− url <- getUrl renderable
116+ runRenderAction renderChainWith'
105− depends url dependencies render'
106 where
117 where
107− dependencies = getDependencies renderable ++ templatePaths
118+ renderChainWith' :: RenderAction () ()
108− render' = do
119+ renderChainWith' = initial >>> manipulationAction >>> chain' >>> writePage
109− templates <- mapM readTemplate templatePaths
120+
110− context <- toContext renderable
121+ chain' = chain (map render templatePaths)
111− let result = pureRenderChainWith manipulation templates context
122+ manipulationAction = createManipulationAction manipulation
112− writePage $ fromContext result
123+
113
124
114-- | Mark a certain file as static, so it will just be copied when the site is
125-- | Mark a certain file as static, so it will just be copied when the site is
115-- generated.
126-- generated.
src/Text/Hakyll/RenderAction.hs+27−13
@@ -1,6 +1,10 @@
1module Text.Hakyll.RenderAction
1module Text.Hakyll.RenderAction
2 ( RenderAction (..)
2 ( RenderAction (..)
3− , fromRenderable
3+ , createRenderAction
4+ , createSimpleRenderAction
5+ , createManipulationAction
6+ , chain
7+ , runRenderAction
4 ) where
8 ) where
5
9
6import Prelude hiding ((.), id)
10import Prelude hiding ((.), id)
@@ -9,32 +13,42 @@ import Control.Monad ((<=<), mplus)
9
13
10import Text.Hakyll.Hakyll
14import Text.Hakyll.Hakyll
11import Text.Hakyll.Context
15import Text.Hakyll.Context
12−import Text.Hakyll.Renderable
13
16
14data RenderAction a b = RenderAction
17data RenderAction a b = RenderAction
15 { actionDependencies :: [FilePath]
18 { actionDependencies :: [FilePath]
16− , actionDestination :: Maybe (Hakyll FilePath)
19+ , actionUrl :: Maybe (Hakyll FilePath)
17 , actionFunction :: a -> Hakyll b
20 , actionFunction :: a -> Hakyll b
18 }
21 }
19
22
23+createRenderAction :: (a -> Hakyll b) -> RenderAction a b
24+createRenderAction f = RenderAction
25+ { actionDependencies = []
26+ , actionUrl = Nothing
27+ , actionFunction = f
28+ }
29+
30+createSimpleRenderAction :: Hakyll b -> RenderAction () b
31+createSimpleRenderAction x = createRenderAction (const x)
32+
20instance Category RenderAction where
33instance Category RenderAction where
21 id = RenderAction
34 id = RenderAction
22 { actionDependencies = []
35 { actionDependencies = []
23− , actionDestination = Nothing
36+ , actionUrl = Nothing
24 , actionFunction = return
37 , actionFunction = return
25 }
38 }
26
39
27 x . y = RenderAction
40 x . y = RenderAction
28 { actionDependencies = actionDependencies x ++ actionDependencies y
41 { actionDependencies = actionDependencies x ++ actionDependencies y
29− , actionDestination = actionDestination y `mplus` actionDestination x
42+ , actionUrl = actionUrl y `mplus` actionUrl x
30 , actionFunction = actionFunction x <=< actionFunction y
43 , actionFunction = actionFunction x <=< actionFunction y
31 }
44 }
32
45
33−fromRenderable :: (Renderable a)
46+createManipulationAction :: ContextManipulation -> RenderAction Context Context
34− => a
47+createManipulationAction manipulation =
48+ createRenderAction (return . manipulation)
49+
35− -> RenderAction () Context
50+chain :: [RenderAction a a] -> RenderAction a a
36−fromRenderable renderable = RenderAction
51+chain = foldl1 (>>>)
37− { actionDependencies = getDependencies renderable
52+
38− , actionDestination = Just $ getUrl renderable
53+runRenderAction :: RenderAction () a -> Hakyll a
39− , actionFunction = const $ toContext renderable
54+runRenderAction action = actionFunction action ()
40− }
src/Text/Hakyll/Renderable.hsdeleted−18
@@ -1,18 +0,0 @@
1−module Text.Hakyll.Renderable
2− ( Renderable(toContext, getDependencies, getUrl)
3− ) where
4−
5−import Text.Hakyll.Hakyll (Hakyll)
6−import Text.Hakyll.Context (Context)
7−
8−-- | A class for datatypes that can be rendered to pages.
9−class Renderable a where
10− -- | Get a context to do substitutions with.
11− toContext :: a -> Hakyll Context
12−
13− -- | Get the dependencies for the renderable. This is used for cache
14− -- invalidation.
15− getDependencies :: a -> [FilePath]
16−
17− -- | Get the destination for the renderable.
18− getUrl :: a -> Hakyll FilePath
src/Text/Hakyll/Renderables.hs+26−47
@@ -14,14 +14,11 @@ import Control.Arrow (second)
14import Control.Monad (liftM2, mplus)
14import Control.Monad (liftM2, mplus)
15import Control.Applicative ((<$>))
15import Control.Applicative ((<$>))
16
16
17−import Data.Binary
18
17
19−import Text.Hakyll.Hakyll (Hakyll)
20−import Text.Hakyll.Renderable
21import Text.Hakyll.File
18import Text.Hakyll.File
22import Text.Hakyll.Context
19import Text.Hakyll.Context
23−import Text.Hakyll.Render
24import Text.Hakyll.RenderAction
20import Text.Hakyll.RenderAction
21+import Text.Hakyll.Render
25import Text.Hakyll.Internal.Page
22import Text.Hakyll.Internal.Page
26
23
27-- | Create a custom page.
24-- | Create a custom page.
@@ -33,16 +30,17 @@ import Text.Hakyll.Internal.Page
33-- cases.
30-- cases.
34createCustomPage :: String
31createCustomPage :: String
35 -> [FilePath]
32 -> [FilePath]
36− -> [(String, Either String (Hakyll String))]
33+ -> [(String, Either String (RenderAction () String))]
37 -> RenderAction () Context
34 -> RenderAction () Context
38createCustomPage url dependencies association = RenderAction
35createCustomPage url dependencies association = RenderAction
39 { actionDependencies = dependencies
36 { actionDependencies = dependencies
40− , actionDestination = Just $ return url
37+ , actionUrl = Just $ return url
41− , actionFunction = actionFunction'
38+ , actionFunction = \_ -> M.fromList <$> assoc'
42 }
39 }
43 where
40 where
44 mtuple (a, b) = b >>= \b' -> return (a, b')
41 mtuple (a, b) = b >>= \b' -> return (a, b')
45− actionFunction' () = M.fromList <$> mapM (mtuple . second (either return id)) association
42+ toHakyllString = second (either return runRenderAction)
43+ assoc' = mapM (mtuple . toHakyllString) association
46
44
47-- | A @createCustomPage@ function specialized in creating listings.
45-- | A @createCustomPage@ function specialized in creating listings.
48--
46--
@@ -57,10 +55,9 @@ createCustomPage url dependencies association = RenderAction
57-- > -- render the items with.
55-- > -- render the items with.
58-- > posts -- ^ Renderables to create the list with.
56-- > posts -- ^ Renderables to create the list with.
59-- > [("title", "Home")] -- ^ Additional context
57-- > [("title", "Home")] -- ^ Additional context
60−createListing :: (Renderable a)
61− => String -- ^ Destination of the page.
58+createListing :: String -- ^ Destination of the page.
62 -> FilePath -- ^ Template to render all items with.
59 -> FilePath -- ^ Template to render all items with.
63− -> [a] -- ^ Renderables in the list.
60+ -> [RenderAction () Context] -- ^ Renderables in the list.
64 -> [(String, String)] -- ^ Additional context.
61 -> [(String, String)] -- ^ Additional context.
65 -> RenderAction () Context
62 -> RenderAction () Context
66createListing = createListingWith id
63createListing = createListingWith id
@@ -69,17 +66,16 @@ createListing = createListingWith id
69--
66--
70-- In addition to @createListing@, this function allows you to specify an
67-- In addition to @createListing@, this function allows you to specify an
71-- extra @ContextManipulation@ for all @Renderable@s given.
68-- extra @ContextManipulation@ for all @Renderable@s given.
72−createListingWith :: (Renderable a)
73− => ContextManipulation -- ^ Manipulation for the renderables.
69+createListingWith :: ContextManipulation -- ^ Manipulation for the renderables.
74 -> String -- ^ Destination of the page.
70 -> String -- ^ Destination of the page.
75 -> FilePath -- ^ Template to render all items with.
71 -> FilePath -- ^ Template to render all items with.
76− -> [a] -- ^ Renderables in the list.
72+ -> [RenderAction () Context] -- ^ Renderables in the list.
77 -> [(String, String)] -- ^ Additional context.
73 -> [(String, String)] -- ^ Additional context.
78 -> RenderAction () Context
74 -> RenderAction () Context
79createListingWith manipulation url template renderables additional =
75createListingWith manipulation url template renderables additional =
80 createCustomPage url dependencies context
76 createCustomPage url dependencies context
81 where
77 where
82− dependencies = template : concatMap getDependencies renderables
78+ dependencies = template : concatMap actionDependencies renderables
83 context = ("body", Right concatenation) : additional'
79 context = ("body", Right concatenation) : additional'
84 concatenation = renderAndConcatWith manipulation [template] renderables
80 concatenation = renderAndConcatWith manipulation [template] renderables
85 additional' = map (second Left) additional
81 additional' = map (second Left) additional
@@ -93,7 +89,7 @@ newtype PagePath = PagePath FilePath
93createPagePath :: FilePath -> RenderAction () Context
89createPagePath :: FilePath -> RenderAction () Context
94createPagePath path = RenderAction
90createPagePath path = RenderAction
95 { actionDependencies = [path]
91 { actionDependencies = [path]
96− , actionDestination = Just $ toUrl path
92+ , actionUrl = Just $ toUrl path
97 , actionFunction = const (readPage path)
93 , actionFunction = const (readPage path)
98 }
94 }
99
95
@@ -112,38 +108,21 @@ combine :: RenderAction () Context -> RenderAction () Context
112 -> RenderAction () Context
108 -> RenderAction () Context
113combine x y = RenderAction
109combine x y = RenderAction
114 { actionDependencies = actionDependencies x ++ actionDependencies y
110 { actionDependencies = actionDependencies x ++ actionDependencies y
115− , actionDestination = actionDestination x `mplus` actionDestination y
111+ , actionUrl = actionUrl x `mplus` actionUrl y
116− , actionFunction = \_ -> liftM2 (M.union) (actionFunction x ()) (actionFunction y ())
112+ , actionFunction = \_ ->
113+ liftM2 (M.union) (runRenderAction x) (runRenderAction y)
117 }
114 }
118
115
119-- | Combine two renderables and set a custom URL. This behaves like @combine@,
116-- | Combine two renderables and set a custom URL. This behaves like @combine@,
120-- except that for the @url@ field, the given URL is always chosen.
117-- except that for the @url@ field, the given URL is always chosen.
121−combineWithUrl :: (Renderable a, Renderable b)
122− => FilePath
118+combineWithUrl :: FilePath
123− -> a
119+ -> RenderAction () Context
124− -> b
120+ -> RenderAction () Context
125− -> CombinedRenderable a b
121+ -> RenderAction () Context
126−combineWithUrl = CombinedRenderableWithUrl
122+combineWithUrl url x y = combine'
127−
123+ { actionUrl = Just $ return url
128−-- Render combinations.
124+ , actionFunction = \_ ->
129−instance (Renderable a, Renderable b)
125+ (M.insert "url" url) <$> runRenderAction combine'
130− => Renderable (CombinedRenderable a b) where
126+ }
131−
127+ where
132− -- Add the dependencies.
128+ combine' = combine x y
133− getDependencies (CombinedRenderable a b) =
134− getDependencies a ++ getDependencies b
135− getDependencies (CombinedRenderableWithUrl _ a b) =
136− getDependencies a ++ getDependencies b
137−
138− -- Take the url from the first renderable, or the specified URL.
139− getUrl (CombinedRenderable a _) = getUrl a
140− getUrl (CombinedRenderableWithUrl url _ _) = return url
141−
142− -- Take a union of the contexts.
143− toContext (CombinedRenderable a b) = do
144− c1 <- toContext a
145− c2 <- toContext b
146− return $ c1 `M.union` c2
147− toContext (CombinedRenderableWithUrl url a b) = do
148− c <- toContext (CombinedRenderable a b)
149− return $ M.singleton "url" url `M.union` c