diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Text/Hakyll/Context.hs | 6 | ||||
| -rw-r--r-- | src/Text/Hakyll/Paginate.hs | 74 | ||||
| -rw-r--r-- | src/Text/Hakyll/Render.hs | 16 |
3 files changed, 85 insertions, 11 deletions
diff --git a/src/Text/Hakyll/Context.hs b/src/Text/Hakyll/Context.hs index 69816b6..892d5f7 100644 --- a/src/Text/Hakyll/Context.hs +++ b/src/Text/Hakyll/Context.hs @@ -27,8 +27,8 @@ type ContextManipulation = Context -> Context -- | Do something with a value in a @Context@, but keep the old value as well. -- This is probably the most common function to construct a -- @ContextManipulation@. -renderValue :: String -- ^ Key of which the value should be copied. - -> String -- ^ Key the value should be copied to. +renderValue :: String -- ^ Key of which the value should be copied. + -> String -- ^ Key the value should be copied to. -> (String -> String) -- ^ Function to apply on the value. -> ContextManipulation renderValue src dst f context = case M.lookup src context of @@ -41,7 +41,7 @@ renderValue src dst f context = case M.lookup src context of -- > changeValue "title" (map toUpper) -- -- Will put the title in UPPERCASE. -changeValue :: String -- ^ Key of which the value should be changed. +changeValue :: String -- ^ Key to change. -> (String -> String) -- ^ Function to apply on the value. -> ContextManipulation changeValue key = renderValue key key diff --git a/src/Text/Hakyll/Paginate.hs b/src/Text/Hakyll/Paginate.hs new file mode 100644 index 0000000..0f35854 --- /dev/null +++ b/src/Text/Hakyll/Paginate.hs @@ -0,0 +1,74 @@ +-- | Module aimed to paginate web pages. +module Text.Hakyll.Paginate + ( PaginateConfiguration (..) + , defaultPaginateConfiguration + , paginate + ) where + +import Text.Hakyll.Renderables +import Text.Hakyll.Renderable (Renderable, getUrl) +import Text.Hakyll.Util (link) + +-- | A configuration for a pagination. +data PaginateConfiguration = PaginateConfiguration + { -- | Label for the link to the previous page. + previousLabel :: String + , -- | Label for the link to the next page. + nextLabel :: String + , -- | Label for the link to the first page. + firstLabel :: String + , -- | Label for the link to the last page. + lastLabel :: String + } + +-- | A simple default configuration for pagination. +defaultPaginateConfiguration :: PaginateConfiguration +defaultPaginateConfiguration = PaginateConfiguration + { previousLabel = "Previous" + , nextLabel = "Next" + , firstLabel = "First" + , lastLabel = "Last" + } + +-- | The most important function for pagination. This function operates on a +-- list of renderables (the pages), and basically just adds fields to them +-- by combining them with a custom page. +-- +-- The following metadata fields will be added: +-- +-- - @$previous@: A link to the previous page. +-- - @$next@: A link to the next page. +-- - @$first@: A link to the first page. +-- - @$last@: A link to the last page. +-- - @$index@: 1-based index of the current page. +-- - @$length@: Total number of pages. +-- +paginate :: (Renderable a) + => PaginateConfiguration + -> [a] + -> [CombinedRenderable a CustomPage] +paginate configuration renderables = paginate' Nothing renderables (1 :: Int) + where + linkWithLabel f r = link (f configuration) `fmap` getUrl r + + first = linkWithLabel firstLabel (head renderables) + last' = linkWithLabel lastLabel (last renderables) + length' = length renderables + + paginate' _ [] _ = [] + paginate' maybePrev (x:xs) index = + let previous = case maybePrev of + (Just r) -> linkWithLabel previousLabel r + Nothing -> return $ previousLabel configuration + next = case xs of + (n:_) -> linkWithLabel nextLabel n + [] -> return $ nextLabel configuration + customPage = createCustomPage "" [] + [ ("previous", Right previous) + , ("next", Right next) + , ("first", Right first) + , ("last", Right last') + , ("index", Left $ show index) + , ("length", Left $ show length') + ] + in (x `combine` customPage) : paginate' (Just x) xs (index + 1) diff --git a/src/Text/Hakyll/Render.hs b/src/Text/Hakyll/Render.hs index 34e1780..64fc0ab 100644 --- a/src/Text/Hakyll/Render.hs +++ b/src/Text/Hakyll/Render.hs @@ -26,9 +26,9 @@ import Text.Hakyll.Internal.CompressCss import Text.Hakyll.Internal.Render -- | Execute an IO action only when the cache is invalid. -depends :: FilePath -- ^ File to be rendered or created. +depends :: FilePath -- ^ File to be rendered or created. -> [FilePath] -- ^ Files the render depends on. - -> Hakyll () -- ^ IO action to execute when the file is out of date. + -> Hakyll () -- ^ Action to execute when the file is out of date. -> Hakyll () depends file dependencies action = do destination <- toDestination file @@ -37,8 +37,8 @@ depends file dependencies action = do -- | Render to a Page. render :: Renderable a - => FilePath -- ^ Template to use for rendering. - -> a -- ^ Renderable object to render with given template. + => FilePath -- ^ Template to use for rendering. + -> a -- ^ Renderable object to render with given template. -> Hakyll Page -- ^ The body of the result will contain the render. render = renderWith id @@ -46,9 +46,9 @@ render = renderWith id -- first. renderWith :: Renderable a => ContextManipulation -- ^ Manipulation to apply on the context. - -> FilePath -- ^ Template to use for rendering. - -> a -- ^ Renderable object to render with given template. - -> Hakyll Page -- ^ The body of the result will contain the render. + -> FilePath -- ^ Template to use for rendering. + -> a -- ^ Data to render. + -> Hakyll Page -- ^ Result of the render operation. renderWith manipulation templatePath renderable = do template <- readTemplate templatePath context <- toContext renderable @@ -66,7 +66,7 @@ renderWith manipulation templatePath renderable = do -- renderAndConcat :: Renderable a => [FilePath] -- ^ Templates to apply on every renderable. - -> [a] -- ^ Renderables to render. + -> [a] -- ^ Renderables to render. -> Hakyll String renderAndConcat = renderAndConcatWith id |