1199692 · hakyll · git.iko.soy

git.iko.soy/hakyll

Got it to compile again, disabled Tags for now.

commit11996929aae640c9cd3737fdb2736e6562c705de authorJasper Van der Jeugt <jaspervdj@gmail.com> dateThu 4 Mar 2010, 22:09 (17 years ago) parent192c4a1

8 files changed+124−157

compare with master

unifiedsplit

hakyll.cabal+2−2 src/Text/Hakyll/Internal/Page.hs−19 src/Text/Hakyll/Internal/Render.hs+8−8 src/Text/Hakyll/Paginate.hs+10−10 src/Text/Hakyll/Render.hs+51−40 src/Text/Hakyll/RenderAction.hs+27−13 src/Text/Hakyll/Renderable.hs−18 src/Text/Hakyll/Renderables.hs+26−47

hakyll.cabal+2−2

@@ -45,11 +45,11 @@ library

4545 Text.Hakyll.Regex

4646 Text.Hakyll.Render

4747 Text.Hakyll.RenderAction

48− Text.Hakyll.Renderable

48+ -- Text.Hakyll.Renderable

4949 Text.Hakyll.Renderables

5050 Text.Hakyll.Paginate

5151 Text.Hakyll.Util

52− Text.Hakyll.Tags

52+ -- Text.Hakyll.Tags

5353 Text.Hakyll.Internal.Cache

5454 Text.Hakyll.Internal.CompressCss

5555 Text.Hakyll.Internal.Page

src/Text/Hakyll/Internal/Page.hs−19

@@ -21,11 +21,8 @@ import Data.Binary

2121

2222import Text.Hakyll.Internal.Cache

2323import Text.Hakyll.Hakyll

24−import Text.Hakyll.File

2524import Text.Hakyll.Util (trim)

2625import Text.Hakyll.Context (Context)

27−import Text.Hakyll.Renderable

28−import Text.Hakyll.RenderAction

2926import Text.Hakyll.Regex (substituteRegex, matchesRegex)

3027

3128-- | A Page is basically key-value mapping. Certain keys have special

@@ -42,16 +39,6 @@ fromContext = Page

4239getValue :: String -> Page -> String

4340getValue str (Page page) = fromMaybe [] $ M.lookup str page

4441

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−

5542-- | Get the body for a certain page. When not defined, the body will be

5643-- empty.

5744getBody :: Page -> String

@@ -155,12 +142,6 @@ readPage path = do

155142 where

156143 fileName = "pages" </> path

157144

158−-- Make pages renderable.

159−instance Renderable Page where

160− getDependencies = (:[]) . getPagePath

161− getUrl = return . getPageUrl

162− toContext (Page page) = return page

163−

164145-- Make pages serializable.

165146instance Binary Page where

166147 put (Page context) = put $ M.toAscList context

src/Text/Hakyll/Internal/Render.hs+8−8

@@ -15,10 +15,9 @@ import Data.List (foldl')

1515import Data.Maybe (fromMaybe)

1616

1717import Text.Hakyll.Context (Context, ContextManipulation)

18−import Text.Hakyll.Renderable

1918import Text.Hakyll.File

2019import Text.Hakyll.Hakyll

21−import Text.Hakyll.Internal.Page

20+import Text.Hakyll.RenderAction

2221import Text.Hakyll.Internal.Template

2322

2423-- | A pure render function.

@@ -55,13 +54,14 @@ pureRenderChainWith manipulation templates context =

5554

5655-- | Write a page to the site destination. Final action after render

5756-- chains and such.

58−writePage :: Page -> Hakyll ()

59−writePage page = do

57+writePage :: RenderAction Context ()

58+writePage = createRenderAction $ \initialContext -> do

6059 additionalContext' <- askHakyll additionalContext

61− url <- getUrl page

62− destination <- toDestination url

60+ let url = fromMaybe (error "No url defined at write time.")

61+ (M.lookup "url" initialContext)

62+ body = fromMaybe "" (M.lookup "body" initialContext)

6363 let context = additionalContext' `M.union` M.singleton "root" (toRoot url)

64+ destination <- toDestination url

6465 makeDirectories destination

6566 -- Substitute $root here, just before writing.

66− liftIO $ writeFile destination $ finalSubstitute (fromString $ getBody page)

67− context

67+ liftIO $ writeFile destination $ finalSubstitute (fromString body) context

src/Text/Hakyll/Paginate.hs+10−10

@@ -55,8 +55,8 @@ paginate :: PaginateConfiguration

5555paginate configuration renderables = paginate' Nothing renderables (1 :: Int)

5656 where

5757 -- Create a link with a given label, taken from the configuration.

58− linkWithLabel f r = case actionDestination r of

59− Just l -> link (f configuration) <$> l

58+ linkWithLabel f r = Right $ case actionUrl r of

59+ Just l -> createSimpleRenderAction $ link (f configuration) <$> l

6060 Nothing -> error "No link found for pagination."

6161

6262 -- The main function that creates combined renderables by recursing over

@@ -66,18 +66,18 @@ paginate configuration renderables = paginate' Nothing renderables (1 :: Int)

6666 let (previous, first) = case maybePrev of

6767 (Just r) -> ( linkWithLabel previousLabel r

6868 , linkWithLabel firstLabel (head renderables) )

69− Nothing -> ( return $ previousLabel configuration

70− , return $ firstLabel configuration )

69+ Nothing -> ( Left $ previousLabel configuration

70+ , Left $ firstLabel configuration )

7171 (next, last') = case xs of

7272 (n:_) -> ( linkWithLabel nextLabel n

7373 , linkWithLabel lastLabel (last renderables) )

74− [] -> ( return $ nextLabel configuration

75− , return $ lastLabel configuration )

74+ [] -> ( Left $ nextLabel configuration

75+ , Left $ lastLabel configuration )

7676 customPage = createCustomPage "" []

77− [ ("previous", Right previous)

78− , ("next", Right next)

79− , ("first", Right first)

80− , ("last", Right last')

77+ [ ("previous", previous)

78+ , ("next", next)

79+ , ("first", first)

80+ , ("last", last')

8181 , ("index", Left $ show index)

8282 , ("length", Left $ show $ length renderables)

8383 ]

src/Text/Hakyll/Render.hs+51−40

@@ -13,15 +13,17 @@ module Text.Hakyll.Render

1313 ) where

1414

1515import Control.Monad (unless)

16+import Control.Arrow ((>>>))

1617import Control.Monad.Reader (liftIO)

1718import System.Directory (copyFile)

19+import Data.Maybe (fromMaybe)

20+import qualified Data.Map as M

1821

1922import Text.Hakyll.Hakyll (Hakyll)

20−import Text.Hakyll.Context (ContextManipulation)

21−import Text.Hakyll.Renderable

23+import Text.Hakyll.Context (ContextManipulation, Context)

2224import Text.Hakyll.File

25+import Text.Hakyll.RenderAction

2326import Text.Hakyll.Internal.CompressCss

24−import Text.Hakyll.Internal.Page

2527import Text.Hakyll.Internal.Render

2628import Text.Hakyll.Internal.Template (readTemplate)

2729

@@ -36,23 +38,24 @@ depends file dependencies action = do

3638 unless valid action

3739

3840-- | Render to a Page.

39−render :: Renderable a

40− => FilePath -- ^ Template to use for rendering.

41− -> a -- ^ Renderable object to render with given template.

42− -> Hakyll Page -- ^ The body of the result will contain the render.

41+render :: FilePath -- ^ Template to use for rendering.

42+ -> RenderAction Context Context -- ^ The render computation.

4343render = renderWith id

4444

4545-- | Render to a Page. This function allows you to manipulate the context

4646-- first.

47−renderWith :: Renderable a

48− => ContextManipulation -- ^ Manipulation to apply on the context.

49− -> FilePath -- ^ Template to use for rendering.

50− -> a -- ^ Data to render.

51− -> Hakyll Page -- ^ Result of the render operation.

52−renderWith manipulation templatePath renderable = do

53− template <- readTemplate templatePath

54− context <- toContext renderable

55− return $ fromContext $ pureRenderWith manipulation template context

47+renderWith :: ContextManipulation -- ^ Manipulation to apply first.

48+ -> FilePath -- ^ Template to use for rendering.

49+ -> RenderAction Context Context -- ^ The render computation.

50+renderWith manipulation templatePath = RenderAction

51+ { actionDependencies = [templatePath]

52+ , actionUrl = Nothing

53+ , actionFunction = actionFunction'

54+ }

55+ where

56+ actionFunction' context = do

57+ template <- readTemplate templatePath

58+ return $ pureRenderWith manipulation template context

5659

5760-- | Render each renderable with the given templates, then concatenate the

5861-- result. So, basically this function:

@@ -64,24 +67,31 @@ renderWith manipulation templatePath renderable = do

6467--

6568-- * Concatenates the result.

6669--

67−renderAndConcat :: Renderable a

68− => [FilePath] -- ^ Templates to apply on every renderable.

69− -> [a] -- ^ Renderables to render.

70− -> Hakyll String

70+renderAndConcat :: [FilePath] -- ^ Templates to apply on every renderable.

71+ -> [RenderAction () Context] -- ^ Renderables to render.

72+ -> RenderAction () String

7173renderAndConcat = renderAndConcatWith id

7274

7375-- | Render each renderable with the given templates, then concatenate the

7476-- result. This function allows you to specify a @ContextManipulation@ to

7577-- apply on every @Renderable@.

76−renderAndConcatWith :: Renderable a

77− => ContextManipulation

78+renderAndConcatWith :: ContextManipulation

7879 -> [FilePath]

79− -> [a]

80− -> Hakyll String

81−renderAndConcatWith manipulation templatePaths renderables = do

82− templates <- mapM readTemplate templatePaths

83− contexts <- mapM toContext renderables

84− return $ pureRenderAndConcatWith manipulation templates contexts

80+ -> [RenderAction () Context]

81+ -> RenderAction () String

82+renderAndConcatWith manipulation templatePaths renderables = RenderAction

83+ { actionDependencies = renders >>= actionDependencies

84+ , actionUrl = Nothing

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

8595

8696-- | Chain a render action for a page with a number of templates. This will

8797-- also write the result to the site destination. This is the preferred way

@@ -93,23 +103,24 @@ renderAndConcatWith manipulation templatePaths renderables = do

93103--

94104-- This code will first render @warning.html@ using @templates/notice.html@,

95105-- and will then render the result with @templates/default.html@.

96−renderChain :: Renderable a => [FilePath] -> a -> Hakyll ()

106+renderChain :: [FilePath] -> RenderAction () Context -> Hakyll ()

97107renderChain = renderChainWith id

98108

99109-- | A more custom render chain that allows you to specify a

100110-- @ContextManipulation@ which to apply on the context when it is read first.

101−renderChainWith :: Renderable a

102− => ContextManipulation -> [FilePath] -> a -> Hakyll ()

103−renderChainWith manipulation templatePaths renderable = do

104− url <- getUrl renderable

105− depends url dependencies render'

111+renderChainWith :: ContextManipulation

112+ -> [FilePath]

113+ -> RenderAction () Context

114+ -> Hakyll ()

115+renderChainWith manipulation templatePaths initial =

116+ runRenderAction renderChainWith'

106117 where

107− dependencies = getDependencies renderable ++ templatePaths

108− render' = do

109− templates <- mapM readTemplate templatePaths

110− context <- toContext renderable

111− let result = pureRenderChainWith manipulation templates context

112− writePage $ fromContext result

118+ renderChainWith' :: RenderAction () ()

119+ renderChainWith' = initial >>> manipulationAction >>> chain' >>> writePage

120+

121+ chain' = chain (map render templatePaths)

122+ manipulationAction = createManipulationAction manipulation

123+

113124

114125-- | Mark a certain file as static, so it will just be copied when the site is

115126-- generated.

src/Text/Hakyll/RenderAction.hs+27−13

@@ -1,6 +1,10 @@

11module Text.Hakyll.RenderAction

22 ( RenderAction (..)

3− , fromRenderable

3+ , createRenderAction

4+ , createSimpleRenderAction

5+ , createManipulationAction

6+ , chain

7+ , runRenderAction

48 ) where

610import Prelude hiding ((.), id)

@@ -9,32 +13,42 @@ import Control.Monad ((<=<), mplus)

913

1014import Text.Hakyll.Hakyll

1115import Text.Hakyll.Context

12−import Text.Hakyll.Renderable

1316

1417data RenderAction a b = RenderAction

1518 { actionDependencies :: [FilePath]

16− , actionDestination :: Maybe (Hakyll FilePath)

19+ , actionUrl :: Maybe (Hakyll FilePath)

1720 , actionFunction :: a -> Hakyll b

1821 }

1922

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+

2033instance Category RenderAction where

2134 id = RenderAction

2235 { actionDependencies = []

23− , actionDestination = Nothing

36+ , actionUrl = Nothing

2437 , actionFunction = return

2538 }

2639

2740 x . y = RenderAction

2841 { actionDependencies = actionDependencies x ++ actionDependencies y

29− , actionDestination = actionDestination y `mplus` actionDestination x

42+ , actionUrl = actionUrl y `mplus` actionUrl x

3043 , actionFunction = actionFunction x <=< actionFunction y

3144 }

3245

33−fromRenderable :: (Renderable a)

34− => a

35− -> RenderAction () Context

36−fromRenderable renderable = RenderAction

37− { actionDependencies = getDependencies renderable

38− , actionDestination = Just $ getUrl renderable

39− , actionFunction = const $ toContext renderable

40− }

46+createManipulationAction :: ContextManipulation -> RenderAction Context Context

47+createManipulationAction manipulation =

48+ createRenderAction (return . manipulation)

49+

50+chain :: [RenderAction a a] -> RenderAction a a

51+chain = foldl1 (>>>)

52+

53+runRenderAction :: RenderAction () a -> Hakyll a

54+runRenderAction action = actionFunction action ()

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)

1414import Control.Monad (liftM2, mplus)

1515import Control.Applicative ((<$>))

1616

17−import Data.Binary

1817

19−import Text.Hakyll.Hakyll (Hakyll)

20−import Text.Hakyll.Renderable

2118import Text.Hakyll.File

2219import Text.Hakyll.Context

23−import Text.Hakyll.Render

2420import Text.Hakyll.RenderAction

21+import Text.Hakyll.Render

2522import Text.Hakyll.Internal.Page

2623

2724-- | Create a custom page.

@@ -33,16 +30,17 @@ import Text.Hakyll.Internal.Page

3330-- cases.

3431createCustomPage :: String

3532 -> [FilePath]

36− -> [(String, Either String (Hakyll String))]

33+ -> [(String, Either String (RenderAction () String))]

3734 -> RenderAction () Context

3835createCustomPage url dependencies association = RenderAction

3936 { actionDependencies = dependencies

40− , actionDestination = Just $ return url

41− , actionFunction = actionFunction'

37+ , actionUrl = Just $ return url

38+ , actionFunction = \_ -> M.fromList <$> assoc'

4239 }

4340 where

4441 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

4644

4745-- | A @createCustomPage@ function specialized in creating listings.

4846--

@@ -57,10 +55,9 @@ createCustomPage url dependencies association = RenderAction

5755-- > -- render the items with.

5856-- > posts -- ^ Renderables to create the list with.

5957-- > [("title", "Home")] -- ^ Additional context

60−createListing :: (Renderable a)

61− => String -- ^ Destination of the page.

58+createListing :: String -- ^ Destination of the page.

6259 -> FilePath -- ^ Template to render all items with.

63− -> [a] -- ^ Renderables in the list.

60+ -> [RenderAction () Context] -- ^ Renderables in the list.

6461 -> [(String, String)] -- ^ Additional context.

6562 -> RenderAction () Context

6663createListing = createListingWith id

@@ -69,17 +66,16 @@ createListing = createListingWith id

6966--

7067-- In addition to @createListing@, this function allows you to specify an

7168-- extra @ContextManipulation@ for all @Renderable@s given.

72−createListingWith :: (Renderable a)

73− => ContextManipulation -- ^ Manipulation for the renderables.

69+createListingWith :: ContextManipulation -- ^ Manipulation for the renderables.

7470 -> String -- ^ Destination of the page.

7571 -> FilePath -- ^ Template to render all items with.

76− -> [a] -- ^ Renderables in the list.

72+ -> [RenderAction () Context] -- ^ Renderables in the list.

7773 -> [(String, String)] -- ^ Additional context.

7874 -> RenderAction () Context

7975createListingWith manipulation url template renderables additional =

8076 createCustomPage url dependencies context

8177 where

82− dependencies = template : concatMap getDependencies renderables

78+ dependencies = template : concatMap actionDependencies renderables

8379 context = ("body", Right concatenation) : additional'

8480 concatenation = renderAndConcatWith manipulation [template] renderables

8581 additional' = map (second Left) additional

@@ -93,7 +89,7 @@ newtype PagePath = PagePath FilePath

9389createPagePath :: FilePath -> RenderAction () Context

9490createPagePath path = RenderAction

9591 { actionDependencies = [path]

96− , actionDestination = Just $ toUrl path

92+ , actionUrl = Just $ toUrl path

9793 , actionFunction = const (readPage path)

9894 }

9995

@@ -112,38 +108,21 @@ combine :: RenderAction () Context -> RenderAction () Context

112108 -> RenderAction () Context

113109combine x y = RenderAction

114110 { actionDependencies = actionDependencies x ++ actionDependencies y

115− , actionDestination = actionDestination x `mplus` actionDestination y

116− , actionFunction = \_ -> liftM2 (M.union) (actionFunction x ()) (actionFunction y ())

111+ , actionUrl = actionUrl x `mplus` actionUrl y

112+ , actionFunction = \_ ->

113+ liftM2 (M.union) (runRenderAction x) (runRenderAction y)

117114 }

118115

119116-- | Combine two renderables and set a custom URL. This behaves like @combine@,

120117-- except that for the @url@ field, the given URL is always chosen.

121−combineWithUrl :: (Renderable a, Renderable b)

122− => FilePath

123− -> a

124− -> b

125− -> CombinedRenderable a b

126−combineWithUrl = CombinedRenderableWithUrl

127−

128−-- Render combinations.

129−instance (Renderable a, Renderable b)

130− => Renderable (CombinedRenderable a b) where

131−

132− -- Add the dependencies.

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

118+combineWithUrl :: FilePath

119+ -> RenderAction () Context

120+ -> RenderAction () Context

121+ -> RenderAction () Context

122+combineWithUrl url x y = combine'

123+ { actionUrl = Just $ return url

124+ , actionFunction = \_ ->

125+ (M.insert "url" url) <$> runRenderAction combine'

126+ }

127+ where

128+ combine' = combine x y