diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Hakyll/Core/Compiler/Internal.hs | 6 | ||||
| -rw-r--r-- | src/Hakyll/Web/Template/Context.hs | 24 |
2 files changed, 28 insertions, 2 deletions
diff --git a/src/Hakyll/Core/Compiler/Internal.hs b/src/Hakyll/Core/Compiler/Internal.hs index 2a3342f..6abeed9 100644 --- a/src/Hakyll/Core/Compiler/Internal.hs +++ b/src/Hakyll/Core/Compiler/Internal.hs @@ -19,8 +19,7 @@ module Hakyll.Core.Compiler.Internal -------------------------------------------------------------------------------- import Control.Applicative (Alternative (..), Applicative, pure, (<$>), (<*>)) -import Control.Arrow (Arrow, ArrowChoice, arr, first, - left) +import Control.Arrow import Control.Category (Category, id, (.)) import Control.Monad (liftM2, (<=<)) import Control.Monad.Error (ErrorT, catchError, runErrorT, @@ -137,6 +136,9 @@ instance ArrowChoice Compiler where left ~(Compiler d j) = Compiler d $ \e -> case e of Left l -> Left <$> j l Right r -> Right <$> return r + -- Defined here for efficiency + ~(Compiler d1 j1) ||| ~(Compiler d2 j2) = Compiler (liftM2 S.union d1 d2) $ + \e -> case e of Left x -> j1 x; Right y -> j2 y -------------------------------------------------------------------------------- diff --git a/src/Hakyll/Web/Template/Context.hs b/src/Hakyll/Web/Template/Context.hs new file mode 100644 index 0000000..5ca1556 --- /dev/null +++ b/src/Hakyll/Web/Template/Context.hs @@ -0,0 +1,24 @@ +-------------------------------------------------------------------------------- +module Hakyll.Web.Template.Context + ( Context + , field + ) where + + +-------------------------------------------------------------------------------- +import Control.Applicative (empty) +import Control.Arrow +import Hakyll.Core.Compiler + + +-------------------------------------------------------------------------------- +type Context a = Compiler (String, a) String + + +-------------------------------------------------------------------------------- +field :: String -> Compiler a String -> Context a +field key value = arr checkKey >>> empty ||| value + where + checkKey (k, x) + | k == key = Left () + | otherwise = Right x |