@@ -58,66 +58,78 @@
5858-- > <a href="/about.html"> About
5959-- > <a href="/code.html"> Code
6060-- > #{body}
61−--
61+{-# LANGUAGE Arrows #-}
62+{-# LANGUAGE ScopedTypeVariables #-}
6263module Hakyll.Web.Template
6364 ( Template
6465 , applyTemplate
65− , applyTemplateWith
66+ , applyTemplateToPage
6667 , applySelf
6768 , templateCompiler
6869 , templateCompilerWith
6970 , applyTemplateCompiler
70− , applyTemplateCompilerWith
7171 ) where
7272
73−import Control.Arrow
74−import Data.Maybe (fromMaybe)
75−import System.FilePath (takeExtension)
76−import qualified Data.Map as M
7773
78−import Text.Hamlet (HamletSettings, defaultHamletSettings)
74+--------------------------------------------------------------------------------
75+import Control.Arrow
76+import Control.Category (id)
77+import qualified Data.Map as M
78+import Data.Maybe (fromMaybe)
79+import Prelude hiding (id)
80+import System.FilePath (takeExtension)
81+import Text.Hamlet (HamletSettings,
82+ defaultHamletSettings)
7983
80−import Hakyll.Core.Compiler
81−import Hakyll.Core.Identifier
82−import Hakyll.Web.Template.Internal
83−import Hakyll.Web.Template.Read
84−import Hakyll.Web.Page.Internal
84+--------------------------------------------------------------------------------
85+import Hakyll.Core.Compiler
86+import Hakyll.Core.Identifier
87+import Hakyll.Core.Util.Arrow
88+import Hakyll.Web.Page.Internal
89+import Hakyll.Web.Template.Internal
90+import Hakyll.Web.Template.Read
8591
86−-- | Substitutes @$identifiers@ in the given @Template@ by values from the given
87−-- "Page". When a key is not found, it is left as it is.
88−--
89−applyTemplate :: Template -> Page String -> Page String
90−applyTemplate = applyTemplateWith defaultMissingHandler
9192
92−-- | Default solution if a key is missing: render it again
93−defaultMissingHandler :: String -> String
94−defaultMissingHandler k = "$" ++ k ++ "$"
93+--------------------------------------------------------------------------------
94+applyTemplate :: forall a b. (ArrowChoice a, ArrowMap a)
95+ => a (String, b) String
96+ -> a (Template, b) String
97+applyTemplate field =
98+ arr (\(tpl, x) -> [(e, x) | e <- unTemplate tpl]) >>>
99+ mapA applyElement >>^ concat
100+ where
101+ applyElement :: a (TemplateElement, b) String
102+ applyElement = unElement >>> (id ||| field)
95103
96−-- | A version of 'applyTemplate' which allows you to give a fallback option,
97−-- which can produce the value for a key if it is missing.
98−--
99−applyTemplateWith :: (String -> String) -- ^ Fallback if key missing
100− -> Template -- ^ Template to apply
101− -> Page String -- ^ Input page
102− -> Page String -- ^ Resulting page
103−applyTemplateWith missing template page =
104− fmap (const $ substitute =<< unTemplate template) page
104+ unElement :: a (TemplateElement, b) (Either String (String, b))
105+ unElement = arr $ \(e, x) -> case e of
106+ Chunk c -> Left c
107+ Escaped -> Left "$"
108+ Key k -> Right (k, x)
109+
110+
111+--------------------------------------------------------------------------------
112+-- | TODO: Remove
113+applyTemplateToPage :: Template -> Page String -> Page String
114+applyTemplateToPage tpl page =
115+ fmap (const $ applyTemplate pageField (tpl, page)) page
105116 where
106− map' = toMap page
107− substitute (Chunk chunk) = chunk
108− substitute (Key key) = fromMaybe (missing key) $ M.lookup key map'
109− substitute (Escaped) = "$"
117+ pageField (k, p) = fromMaybe ("$" ++ k ++ "$") $ M.lookup k $ toMap p
118+{-# DEPRECATED applyTemplateToPage "Use applyTemplate" #-}
119+
110120
121+--------------------------------------------------------------------------------
111122-- | Apply a page as it's own template. This is often very useful to fill in
112123-- certain keys like @$root@ and @$url@.
113−--
114124applySelf :: Page String -> Page String
115−applySelf page = applyTemplate (readTemplate $ pageBody page) page
125+applySelf page = applyTemplateToPage (readTemplate $ pageBody page) page
126+{-# DEPRECATED applySelf "Use applyTemplate" #-}
127+
116128
129+--------------------------------------------------------------------------------
117130-- | Read a template. If the extension of the file we're compiling is
118131-- @.hml@ or @.hamlet@, it will be considered as a Hamlet template, and parsed
119132-- as such.
120−--
121133templateCompiler :: Compiler () Template
122134templateCompiler = templateCompilerWith defaultHamletSettings
123135
@@ -135,15 +147,9 @@ templateCompilerWith settings =
135147 -- Hakyll template
136148 else readTemplate string
137149
150+
151+--------------------------------------------------------------------------------
138152applyTemplateCompiler :: Identifier Template -- ^ Template
139153 -> Compiler (Page String) (Page String) -- ^ Compiler
140−applyTemplateCompiler = applyTemplateCompilerWith defaultMissingHandler
141−
142−-- | A version of 'applyTemplateCompiler' which allows you to pass a function
143−-- which is called for a key when it is missing.
144−--
145−applyTemplateCompilerWith :: (String -> String)
146− -> Identifier Template
147− -> Compiler (Page String) (Page String)
148−applyTemplateCompilerWith missing identifier =
149− require identifier (flip $ applyTemplateWith missing)
154+applyTemplateCompiler identifier = require identifier $
155+ flip applyTemplateToPage