76ebcf9 · hakyll · git.iko.soy

git.iko.soy/hakyll

on master help sign in

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

76ebcf9Jasper Van der Jeugt17 years ago

hakyll.cabal+1

compare with master

unifiedsplit

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

44 Text.Hakyll.Hakyll

45 Text.Hakyll.Regex

46 Text.Hakyll.Render

47+ Text.Hakyll.RenderAction

47 Text.Hakyll.Renderable

48 Text.Hakyll.Renderable

48 Text.Hakyll.Renderables

49 Text.Hakyll.Renderables

49 Text.Hakyll.Page

50 Text.Hakyll.Page

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

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

5 , paginate

6 ) where

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

10+import Text.Hakyll.Context

8import Text.Hakyll.Renderables

11import Text.Hakyll.Renderables

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

12+import Text.Hakyll.RenderAction

10import Text.Hakyll.Util (link)

13import Text.Hakyll.Util (link)

12-- | A configuration for a pagination.

15-- | A configuration for a pagination.

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

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

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

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

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

48-- @$first@ and @$last@.

51-- @$first@ and @$last@.

49−paginate :: (Renderable a)

50− => PaginateConfiguration

52+paginate :: PaginateConfiguration

51− -> [a]

53+ -> [RenderAction () Context]

52− -> [CombinedRenderable a CustomPage]

54+ -> [RenderAction () Context]

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

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

54 where

56 where

55 -- 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

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

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

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

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

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

59 -- the list of renderables.

63 -- the list of renderables.

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

75 , ("first", Right first)

79 , ("first", Right first)

76 , ("last", Right last')

80 , ("last", Right last')

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

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

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

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

79 ]

83 ]

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

84 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])

15matchRegexAll = matchM

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

18−subRegex :: Regex -- ^ Search pattern

18+subRegex :: Regex -- ^ Search pattern

19 -> String -- ^ Input string

20 -> String -- ^ Replacement text

21 -> 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 @@

1module Text.Hakyll.Renderables

2− ( CustomPage

3− , createCustomPage

2+ ( createCustomPage

4 , createListing

3 , createListing

5 , createListingWith

4 , createListingWith

6 , PagePath

5 , PagePath

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

13import qualified Data.Map as M

12import qualified Data.Map as M

14import Control.Arrow (second)

13import Control.Arrow (second)

15−import Control.Monad (liftM)

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

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

17import Data.Binary

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

22import Text.Hakyll.File

23import Text.Hakyll.Context

24import Text.Hakyll.Render

25−

25+import Text.Hakyll.RenderAction

26−-- | A custom page.

27−data CustomPage = CustomPage

28− { customPageUrl :: String,

29− customPageDependencies :: [FilePath],

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

31− }

33-- | Create a custom page.

27-- | Create a custom page.

34--

28--

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

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

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

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

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

39-- cases.

33-- cases.

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

34+createCustomPage :: String

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

35+ -> [FilePath]

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

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

43− -> CustomPage

37+ -> RenderAction () Context

44−createCustomPage = CustomPage

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

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

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

47--

48--

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

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

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

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

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

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

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

64− -> CustomPage

65+ -> RenderAction () Context

65createListing = createListingWith id

66createListing = createListingWith id

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

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

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

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

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

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

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

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

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

77− -> CustomPage

78+ -> RenderAction () Context

78createListingWith manipulation url template renderables additional =

79createListingWith manipulation url template renderables additional =

79 createCustomPage url dependencies context

80 createCustomPage url dependencies context

80 where

81 where

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

83 concatenation = renderAndConcatWith manipulation [template] renderables

84 concatenation = renderAndConcatWith manipulation [template] renderables

84 additional' = map (second Left) additional

85 additional' = map (second Left) additional

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−

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

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

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

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

96newtype PagePath = PagePath FilePath

89newtype PagePath = PagePath FilePath

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

122--

115--

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

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

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

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

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

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

126−combine = CombinedRenderable

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

127

125

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

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

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

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