summaryrefslogtreecommitdiff
path: root/src/Hakyll/Web
diff options
context:
space:
mode:
Diffstat (limited to 'src/Hakyll/Web')
-rw-r--r--src/Hakyll/Web/Feed.hs4
-rw-r--r--src/Hakyll/Web/Page/List.hs4
-rw-r--r--src/Hakyll/Web/Tags.hs6
-rw-r--r--src/Hakyll/Web/Template.hs100
4 files changed, 60 insertions, 54 deletions
diff --git a/src/Hakyll/Web/Feed.hs b/src/Hakyll/Web/Feed.hs
index f2f3342..218f28c 100644
--- a/src/Hakyll/Web/Feed.hs
+++ b/src/Hakyll/Web/Feed.hs
@@ -62,7 +62,7 @@ createFeed :: Template -- ^ Feed template
-> [Page String] -- ^ Items to include
-> String -- ^ Resulting feed
createFeed feedTemplate itemTemplate url configuration items =
- pageBody $ applyTemplate feedTemplate
+ pageBody $ applyTemplateToPage feedTemplate
$ trySetField "updated" updated
$ trySetField "title" (feedTitle configuration)
$ trySetField "description" (feedDescription configuration)
@@ -73,7 +73,7 @@ createFeed feedTemplate itemTemplate url configuration items =
$ fromBody body
where
-- Preprocess items
- items' = flip map items $ applyTemplate itemTemplate
+ items' = flip map items $ applyTemplateToPage itemTemplate
. trySetField "root" (feedRoot configuration)
-- Body: concatenated items
diff --git a/src/Hakyll/Web/Page/List.hs b/src/Hakyll/Web/Page/List.hs
index 1edb250..24721e7 100644
--- a/src/Hakyll/Web/Page/List.hs
+++ b/src/Hakyll/Web/Page/List.hs
@@ -55,8 +55,8 @@ pageListCompiler sort template =
--
applyTemplateToList :: Identifier Template
-> Compiler [Page String] [Page String]
-applyTemplateToList identifier =
- require identifier $ \posts template -> map (applyTemplate template) posts
+applyTemplateToList identifier = require identifier $
+ \posts template -> map (applyTemplateToPage template) posts
-- | Concatenate the bodies of a page list
--
diff --git a/src/Hakyll/Web/Tags.hs b/src/Hakyll/Web/Tags.hs
index 42612a7..4ea2ca0 100644
--- a/src/Hakyll/Web/Tags.hs
+++ b/src/Hakyll/Web/Tags.hs
@@ -65,6 +65,7 @@ import Hakyll.Web.Urls
import Hakyll.Core.Writable
import Hakyll.Core.Identifier
import Hakyll.Core.Compiler
+import Hakyll.Core.Util.Arrow
import Hakyll.Core.Util.String
-- | Data about tags
@@ -128,8 +129,7 @@ renderTags :: (String -> Identifier (Page a))
-- ^ Tag cloud renderer
renderTags makeUrl makeItem concatItems = proc (Tags tags) -> do
-- In tags' we create a list: [((tag, route), count)]
- tags' <- mapCompiler ((id &&& (getRouteFor <<^ makeUrl)) *** arr length)
- -< tags
+ tags' <- mapA ((id &&& (getRouteFor <<^ makeUrl)) *** arr length) -< tags
let -- Absolute frequencies of the pages
freqs = map snd tags'
@@ -195,7 +195,7 @@ renderTagsFieldWith tags destination makeUrl =
-- Compiler creating a comma-separated HTML string for a list of tags
renderTags' :: Compiler [String] String
renderTags' = arr (map $ id &&& makeUrl)
- >>> mapCompiler (id *** getRouteFor)
+ >>> mapA (id *** getRouteFor)
>>> arr (map $ uncurry renderLink)
>>> arr (renderHtml . mconcat . intersperse ", " . catMaybes)
diff --git a/src/Hakyll/Web/Template.hs b/src/Hakyll/Web/Template.hs
index 6b2f915..5b7256a 100644
--- a/src/Hakyll/Web/Template.hs
+++ b/src/Hakyll/Web/Template.hs
@@ -58,66 +58,78 @@
-- > <a href="/about.html"> About
-- > <a href="/code.html"> Code
-- > #{body}
---
+{-# LANGUAGE Arrows #-}
+{-# LANGUAGE ScopedTypeVariables #-}
module Hakyll.Web.Template
( Template
, applyTemplate
- , applyTemplateWith
+ , applyTemplateToPage
, applySelf
, templateCompiler
, templateCompilerWith
, applyTemplateCompiler
- , applyTemplateCompilerWith
) where
-import Control.Arrow
-import Data.Maybe (fromMaybe)
-import System.FilePath (takeExtension)
-import qualified Data.Map as M
-import Text.Hamlet (HamletSettings, defaultHamletSettings)
+--------------------------------------------------------------------------------
+import Control.Arrow
+import Control.Category (id)
+import qualified Data.Map as M
+import Data.Maybe (fromMaybe)
+import Prelude hiding (id)
+import System.FilePath (takeExtension)
+import Text.Hamlet (HamletSettings,
+ defaultHamletSettings)
-import Hakyll.Core.Compiler
-import Hakyll.Core.Identifier
-import Hakyll.Web.Template.Internal
-import Hakyll.Web.Template.Read
-import Hakyll.Web.Page.Internal
+--------------------------------------------------------------------------------
+import Hakyll.Core.Compiler
+import Hakyll.Core.Identifier
+import Hakyll.Core.Util.Arrow
+import Hakyll.Web.Page.Internal
+import Hakyll.Web.Template.Internal
+import Hakyll.Web.Template.Read
--- | Substitutes @$identifiers@ in the given @Template@ by values from the given
--- "Page". When a key is not found, it is left as it is.
---
-applyTemplate :: Template -> Page String -> Page String
-applyTemplate = applyTemplateWith defaultMissingHandler
--- | Default solution if a key is missing: render it again
-defaultMissingHandler :: String -> String
-defaultMissingHandler k = "$" ++ k ++ "$"
+--------------------------------------------------------------------------------
+applyTemplate :: forall a b. (ArrowChoice a, ArrowMap a)
+ => a (String, b) String
+ -> a (Template, b) String
+applyTemplate field =
+ arr (\(tpl, x) -> [(e, x) | e <- unTemplate tpl]) >>>
+ mapA applyElement >>^ concat
+ where
+ applyElement :: a (TemplateElement, b) String
+ applyElement = unElement >>> (id ||| field)
--- | A version of 'applyTemplate' which allows you to give a fallback option,
--- which can produce the value for a key if it is missing.
---
-applyTemplateWith :: (String -> String) -- ^ Fallback if key missing
- -> Template -- ^ Template to apply
- -> Page String -- ^ Input page
- -> Page String -- ^ Resulting page
-applyTemplateWith missing template page =
- fmap (const $ substitute =<< unTemplate template) page
+ unElement :: a (TemplateElement, b) (Either String (String, b))
+ unElement = arr $ \(e, x) -> case e of
+ Chunk c -> Left c
+ Escaped -> Left "$"
+ Key k -> Right (k, x)
+
+
+--------------------------------------------------------------------------------
+-- | TODO: Remove
+applyTemplateToPage :: Template -> Page String -> Page String
+applyTemplateToPage tpl page =
+ fmap (const $ applyTemplate pageField (tpl, page)) page
where
- map' = toMap page
- substitute (Chunk chunk) = chunk
- substitute (Key key) = fromMaybe (missing key) $ M.lookup key map'
- substitute (Escaped) = "$"
+ pageField (k, p) = fromMaybe ("$" ++ k ++ "$") $ M.lookup k $ toMap p
+{-# DEPRECATED applyTemplateToPage "Use applyTemplate" #-}
+
+--------------------------------------------------------------------------------
-- | Apply a page as it's own template. This is often very useful to fill in
-- certain keys like @$root@ and @$url@.
---
applySelf :: Page String -> Page String
-applySelf page = applyTemplate (readTemplate $ pageBody page) page
+applySelf page = applyTemplateToPage (readTemplate $ pageBody page) page
+{-# DEPRECATED applySelf "Use applyTemplate" #-}
+
+--------------------------------------------------------------------------------
-- | Read a template. If the extension of the file we're compiling is
-- @.hml@ or @.hamlet@, it will be considered as a Hamlet template, and parsed
-- as such.
---
templateCompiler :: Compiler () Template
templateCompiler = templateCompilerWith defaultHamletSettings
@@ -135,15 +147,9 @@ templateCompilerWith settings =
-- Hakyll template
else readTemplate string
+
+--------------------------------------------------------------------------------
applyTemplateCompiler :: Identifier Template -- ^ Template
-> Compiler (Page String) (Page String) -- ^ Compiler
-applyTemplateCompiler = applyTemplateCompilerWith defaultMissingHandler
-
--- | A version of 'applyTemplateCompiler' which allows you to pass a function
--- which is called for a key when it is missing.
---
-applyTemplateCompilerWith :: (String -> String)
- -> Identifier Template
- -> Compiler (Page String) (Page String)
-applyTemplateCompilerWith missing identifier =
- require identifier (flip $ applyTemplateWith missing)
+applyTemplateCompiler identifier = require identifier $
+ flip applyTemplateToPage
generated by cgit v1.2.3 (git 2.46.0) at 2025-11-10 10:46:32 +0000