76ebcf9 · hakyll · git.iko.soy

git.iko.soy/hakyll

First careful transition from data to arrows. It compiles, but that's about it.

commit76ebcf97b4e2c993297aa914ce576fc0abd68d06 authorJasper Van der Jeugt <jaspervdj@gmail.com> dateThu 4 Mar 2010, 00:02 (17 years ago) parente4f09b0

5 files changed+78−35

compare with master

unifiedsplit

hakyll.cabal+1 src/Text/Hakyll/Paginate.hs+11−7 src/Text/Hakyll/Regex.hs+1−1 src/Text/Hakyll/RenderAction.hs+40 src/Text/Hakyll/Renderables.hs+25−27

hakyll.cabal+1

@@ -44,6 +44,7 @@ library

4444 Text.Hakyll.Hakyll

4545 Text.Hakyll.Regex

4646 Text.Hakyll.Render

47+ Text.Hakyll.RenderAction

4748 Text.Hakyll.Renderable

4849 Text.Hakyll.Renderables

4950 Text.Hakyll.Page

src/Text/Hakyll/Paginate.hs+11−7

@@ -5,8 +5,11 @@ module Text.Hakyll.Paginate

55 , paginate

66 ) where

8+import Control.Applicative ((<$>))

10+import Text.Hakyll.Context

811import Text.Hakyll.Renderables

9−import Text.Hakyll.Renderable (Renderable, getUrl)

12+import Text.Hakyll.RenderAction

1013import Text.Hakyll.Util (link)

1114

1215-- | A configuration for a pagination.

@@ -46,14 +49,15 @@ defaultPaginateConfiguration = PaginateConfiguration

4649-- When @$previous@ or @$next@ are not available, they will be just a label

4750-- without a link. The same goes for when we are on the first or last page for

4851-- @$first@ and @$last@.

49−paginate :: (Renderable a)

50− => PaginateConfiguration

51− -> [a]

52− -> [CombinedRenderable a CustomPage]

52+paginate :: PaginateConfiguration

53+ -> [RenderAction () Context]

54+ -> [RenderAction () Context]

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

5456 where

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

56− linkWithLabel f r = link (f configuration) `fmap` getUrl r

58+ linkWithLabel f r = case actionDestination r of

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

60+ Nothing -> error "No link found for pagination."

5761

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

5963 -- the list of renderables.

@@ -75,6 +79,6 @@ paginate configuration renderables = paginate' Nothing renderables (1 :: Int)

7579 , ("first", Right first)

7680 , ("last", Right last')

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

78− , ("length", Left $ show $ length $ renderables)

82+ , ("length", Left $ show $ length renderables)

7983 ]

8084 in (x `combine` customPage) : paginate' (Just x) xs (index + 1)

src/Text/Hakyll/Regex.hs+1−1

@@ -15,7 +15,7 @@ matchRegexAll :: Regex -> String -> Maybe (String, String, String, [String])

1515matchRegexAll = matchM

1616

1717-- | Replaces every occurance of the given regexp with the replacement string.

18−subRegex :: Regex -- ^ Search pattern

18+subRegex :: Regex -- ^ Search pattern

1919 -> String -- ^ Input string

2020 -> String -- ^ Replacement text

2121 -> String -- ^ Output string

src/Text/Hakyll/RenderAction.hsnew file+40

@@ -0,0 +1,40 @@

1+module Text.Hakyll.RenderAction

2+ ( RenderAction (..)

3+ , fromRenderable

4+ ) where

6+import Prelude hiding ((.), id)

7+import Control.Category

8+import Control.Monad ((<=<), mplus)

10+import Text.Hakyll.Hakyll

11+import Text.Hakyll.Context

12+import Text.Hakyll.Renderable

13+

14+data RenderAction a b = RenderAction

15+ { actionDependencies :: [FilePath]

16+ , actionDestination :: Maybe (Hakyll FilePath)

17+ , actionFunction :: a -> Hakyll b

18+ }

19+

20+instance Category RenderAction where

21+ id = RenderAction

22+ { actionDependencies = []

23+ , actionDestination = Nothing

24+ , actionFunction = return

25+ }

26+

27+ x . y = RenderAction

28+ { actionDependencies = actionDependencies x ++ actionDependencies y

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

30+ , actionFunction = actionFunction x <=< actionFunction y

31+ }

32+

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+ }

src/Text/Hakyll/Renderables.hs+25−27

@@ -1,6 +1,5 @@

11module Text.Hakyll.Renderables

2− ( CustomPage

3− , createCustomPage

2+ ( createCustomPage

43 , createListing

54 , createListingWith

65 , PagePath

@@ -12,7 +11,8 @@ module Text.Hakyll.Renderables

1211

1312import qualified Data.Map as M

1413import Control.Arrow (second)

15−import Control.Monad (liftM)

14+import Control.Monad (liftM, liftM2, mplus)

15+import Control.Applicative ((<$>))

1616

1717import Data.Binary

1818

@@ -22,13 +22,7 @@ import Text.Hakyll.Renderable

2222import Text.Hakyll.File

2323import Text.Hakyll.Context

2424import Text.Hakyll.Render

25−

26−-- | A custom page.

27−data CustomPage = CustomPage

28− { customPageUrl :: String,

29− customPageDependencies :: [FilePath],

30− customPageContext :: [(String, Either String (Hakyll String))]

31− }

25+import Text.Hakyll.RenderAction

3226

3327-- | Create a custom page.

3428--

@@ -37,11 +31,18 @@ data CustomPage = CustomPage

3731-- A @Hakyll String@ is preferred for more complex data, since it allows

3832-- dependency checking. A @String@ is obviously more simple to use in some

3933-- cases.

40−createCustomPage :: String -- ^ Destination of the page, relative to _site.

41− -> [FilePath] -- ^ Dependencies of the page.

42− -> [(String, Either String (Hakyll String))] -- ^ Mapping.

43− -> CustomPage

44−createCustomPage = CustomPage

34+createCustomPage :: String

35+ -> [FilePath]

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

37+ -> RenderAction () Context

38+createCustomPage url dependencies association = RenderAction

39+ { actionDependencies = dependencies

40+ , actionDestination = Just $ return url

41+ , actionFunction = actionFunction'

42+ }

43+ where

44+ mtuple (a, b) = b >>= \b' -> return (a, b')

45+ actionFunction' () = M.fromList <$> mapM (mtuple . second (either return id)) association

4546

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

4748--

@@ -61,7 +62,7 @@ createListing :: (Renderable a)

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

6263 -> [a] -- ^ Renderables in the list.

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

64− -> CustomPage

65+ -> RenderAction () Context

6566createListing = createListingWith id

6667

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

@@ -74,7 +75,7 @@ createListingWith :: (Renderable a)

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

7576 -> [a] -- ^ Renderables in the list.

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

77− -> CustomPage

78+ -> RenderAction () Context

7879createListingWith manipulation url template renderables additional =

7980 createCustomPage url dependencies context

8081 where

@@ -83,14 +84,6 @@ createListingWith manipulation url template renderables additional =

8384 concatenation = renderAndConcatWith manipulation [template] renderables

8485 additional' = map (second Left) additional

8586

86−instance Renderable CustomPage where

87− getDependencies = customPageDependencies

88− getUrl = return . customPageUrl

89− toContext page = do

90− values <- mapM (either return id . snd) (customPageContext page)

91− let pairs = zip (map fst $ customPageContext page) values

92− return $ M.fromList $ ("url", customPageUrl page) : pairs

93−

9487-- | PagePath is a class that wraps a FilePath. This is used to render Pages

9588-- without reading them first through use of caching.

9689newtype PagePath = PagePath FilePath

@@ -122,8 +115,13 @@ data CombinedRenderable a b = CombinedRenderable a b

122115--

123116-- Since renderables are always more or less key-value maps, you can see

124117-- this as a @union@ between two maps.

125−combine :: (Renderable a, Renderable b) => a -> b -> CombinedRenderable a b

126−combine = CombinedRenderable

118+combine :: RenderAction () Context -> RenderAction () Context

119+ -> RenderAction () Context

120+combine x y = RenderAction

121+ { actionDependencies = actionDependencies x ++ actionDependencies y

122+ , actionDestination = actionDestination x `mplus` actionDestination y

123+ , actionFunction = \_ -> liftM2 (M.union) (actionFunction x ()) (actionFunction y ())

124+ }

127125

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

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