From a3d39730bc4f9cca381a2ec19345afb69ea1c466 Mon Sep 17 00:00:00 2001 From: Max New Date: Tue, 31 Oct 2017 16:12:38 -0400 Subject: [PATCH] Add Context instances for Contravariant, Divisible, Decidable --- hakyll.cabal | 2 ++ lib/Hakyll/Web/Template/Context.hs | 35 ++++++++++++++++++++++-------- 2 files changed, 28 insertions(+), 9 deletions(-) diff --git a/hakyll.cabal b/hakyll.cabal index 969f50c4f..983a0acd6 100644 --- a/hakyll.cabal +++ b/hakyll.cabal @@ -159,6 +159,7 @@ Library blaze-markup >= 0.5.1 && < 0.9, bytestring >= 0.9 && < 0.11, containers >= 0.3 && < 0.6, + contravariant >= 1.0 && < 1.5, cryptohash >= 0.7 && < 0.12, data-default >= 0.4 && < 0.8, deepseq >= 1.3 && < 1.5, @@ -254,6 +255,7 @@ Test-suite hakyll-tests blaze-markup >= 0.5.1 && < 0.9, bytestring >= 0.9 && < 0.11, containers >= 0.3 && < 0.6, + contravariant >= 1.0 && < 1.5, cryptohash >= 0.7 && < 0.12, data-default >= 0.4 && < 0.8, deepseq >= 1.3 && < 1.5, diff --git a/lib/Hakyll/Web/Template/Context.hs b/lib/Hakyll/Web/Template/Context.hs index b6c799452..4b41223b1 100644 --- a/lib/Hakyll/Web/Template/Context.hs +++ b/lib/Hakyll/Web/Template/Context.hs @@ -32,22 +32,25 @@ module Hakyll.Web.Template.Context -------------------------------------------------------------------------------- -import Control.Applicative (Alternative (..)) -import Control.Monad (msum) -import Data.List (intercalate) -import Data.Time.Clock (UTCTime (..)) -import Data.Time.Format (formatTime) -import qualified Data.Time.Format as TF -import Data.Time.Locale.Compat (TimeLocale, defaultTimeLocale) +import Control.Applicative (Alternative (..)) +import Control.Monad (msum) +import Data.Functor.Contravariant (Contravariant (..)) +import Data.Functor.Contravariant.Divisible (Decidable (..), Divisible (..)) +import Data.List (intercalate) +import Data.Time.Clock (UTCTime (..)) +import Data.Time.Format (formatTime) +import qualified Data.Time.Format as TF +import Data.Time.Locale.Compat (TimeLocale, defaultTimeLocale) +import Data.Void (absurd) import Hakyll.Core.Compiler import Hakyll.Core.Compiler.Internal import Hakyll.Core.Identifier import Hakyll.Core.Item import Hakyll.Core.Metadata import Hakyll.Core.Provider -import Hakyll.Core.Util.String (needlePrefix, splitAll) +import Hakyll.Core.Util.String (needlePrefix, splitAll) import Hakyll.Web.Html -import System.FilePath (splitDirectories, takeBaseName) +import System.FilePath (splitDirectories, takeBaseName) -------------------------------------------------------------------------------- @@ -83,6 +86,20 @@ instance Monoid (Context a) where mappend (Context f) (Context g) = Context $ \k a i -> f k a i <|> g k a i +-------------------------------------------------------------------------------- +instance Contravariant Context where + contramap f (Context g) = Context $ \k a i -> g k a (f <$> i) + +instance Divisible Context where + conquer = mempty + divide f c1 c2 = contramap (fst . f) c1 `mappend` contramap (snd . f) c2 + +instance Decidable Context where + lose refute = Context $ \_k _a i -> absurd . refute . itemBody $ i + choose chooser (Context f) (Context g) = Context $ \k a i -> case chooser (itemBody i) of + Left l -> f k a (itemSetBody l i) + Right r -> g k a (itemSetBody r i) + -------------------------------------------------------------------------------- field' :: String -> (Item a -> Compiler ContextField) -> Context a field' key value = Context $ \k _ i -> if k == key then value i else empty