on master help sign in
Context module?
commit6b11cba1ef50892adf6a9f45e1f21c8da79b7858 authorJasper Van der Jeugt <m@jaspervdj.be> dateSat 10 Nov 2012, 13:26 (14 years ago) parent4cb6f92
3 files changed+29−2
hakyll.cabal+1 src/Hakyll/Core/Compiler/Internal.hs+4−2 src/Hakyll/Web/Template/Context.hs+24
hakyll.cabal+1
@@ -124,6 +124,7 @@ Library
124124 Hakyll.Web.Pandoc.FileType
125125 Hakyll.Web.Tags
126126 Hakyll.Web.Template
127+ Hakyll.Web.Template.Context
127128 Hakyll.Web.Template.Read
128129 Hakyll.Web.Urls
129130 Hakyll.Web.Urls.Relativize
src/Hakyll/Core/Compiler/Internal.hs+4−2
@@ -19,8 +19,7 @@ module Hakyll.Core.Compiler.Internal
1919--------------------------------------------------------------------------------
2020import Control.Applicative (Alternative (..), Applicative,
2121 pure, (<$>), (<*>))
22−import Control.Arrow (Arrow, ArrowChoice, arr, first,
23− left)
22+import Control.Arrow
2423import Control.Category (Category, id, (.))
2524import Control.Monad (liftM2, (<=<))
2625import Control.Monad.Error (ErrorT, catchError, runErrorT,
@@ -137,6 +136,9 @@ instance ArrowChoice Compiler where
137136 left ~(Compiler d j) = Compiler d $ \e -> case e of
138137 Left l -> Left <$> j l
139138 Right r -> Right <$> return r
139+ -- Defined here for efficiency
140+ ~(Compiler d1 j1) ||| ~(Compiler d2 j2) = Compiler (liftM2 S.union d1 d2) $
141+ \e -> case e of Left x -> j1 x; Right y -> j2 y
140142
141143
142144--------------------------------------------------------------------------------
src/Hakyll/Web/Template/Context.hsnew file+24
@@ -0,0 +1,24 @@
1+--------------------------------------------------------------------------------
2+module Hakyll.Web.Template.Context
3+ ( Context
4+ , field
5+ ) where
6+
7+
8+--------------------------------------------------------------------------------
9+import Control.Applicative (empty)
10+import Control.Arrow
11+import Hakyll.Core.Compiler
12+
13+
14+--------------------------------------------------------------------------------
15+type Context a = Compiler (String, a) String
16+
17+
18+--------------------------------------------------------------------------------
19+field :: String -> Compiler a String -> Context a
20+field key value = arr checkKey >>> empty ||| value
21+ where
22+ checkKey (k, x)
23+ | k == key = Left ()
24+ | otherwise = Right x