ContextManipulations → Metadata

3 files changed, 57 insertions, 66 deletions

diff --git a/src/Text/Hakyll/ContextManipulations.hs b/src/Text/Hakyll/Metadata.hs
index 1c26f72..7698dad 100644
--- a/src/Text/Hakyll/ContextManipulations.hs
+++ b/src/Text/Hakyll/Metadata.hs
@@ -1,5 +1,6 @@
--- | This module exports a number of functions that produce @HakyllAction@s to
---   manipulate @Context@s.
+-- | This module exports a number of functions to manipulate metadata of
+-- resources
+--
 module Text.Hakyll.ContextManipulations
     ( renderValue
     , changeValue
@@ -8,12 +9,8 @@ module Text.Hakyll.ContextManipulations
     , renderDate
     , renderDateWithLocale
     , changeExtension
-    , renderBody
-    , takeBody
     ) where
 
-import Control.Monad (liftM)
-import Control.Arrow (arr)
 import System.Locale (TimeLocale, defaultTimeLocale)
 import System.FilePath (takeFileName, addExtension, dropExtension)
 import Data.Time.Format (parseTime, formatTime)
@@ -22,8 +19,8 @@ import Data.Maybe (fromMaybe)
 import qualified Data.Map as M
 
 import Text.Hakyll.Regex (substituteRegex)
-import Text.Hakyll.HakyllAction (HakyllAction (..))
-import Text.Hakyll.Context (Context (..))
+import Text.Hakyll.Transformer (Transformer (..), transformMetadata)
+import Text.Hakyll.Resource
 
 -- | Do something with a value in a @Context@, but keep the old value as well.
 --   If the key given is not present in the @Context@, nothing will happen.
@@ -31,35 +28,37 @@ import Text.Hakyll.Context (Context (..))
 renderValue :: String              -- ^ Key of which the value should be copied.
             -> String              -- ^ Key the value should be copied to.
             -> (String -> String)  -- ^ Function to apply on the value.
-            -> HakyllAction Context Context
-renderValue source destination f = arr $ \(Context context) -> Context $
-    case M.lookup source context of
-        Nothing      -> context
-        (Just value) -> M.insert destination (f value) context
+            -> Transformer a a     -- ^ Resulting transformer
+renderValue source destination f = transformMetadata $ \(Metadata m) ->
+    Metadata $ case M.lookup source m of
+        Nothing      -> m
+        (Just value) -> M.insert destination (f value) m
 
--- | Change a value in a @Context@.
+-- | Change a value in the metadata
 --
 --   > import Data.Char (toUpper)
 --   > changeValue "title" (map toUpper)
 --
 --   Will put the title in UPPERCASE.
-changeValue :: String             -- ^ Key to change.
-            -> (String -> String) -- ^ Function to apply on the value.
-            -> HakyllAction Context Context
+changeValue :: String              -- ^ Key to change.
+            -> (String -> String)  -- ^ Function to apply on the value.
+            -> Transformer a a
 changeValue key = renderValue key key
 
--- | Change the URL of a page. This requires a special function, so dependency
--- handling can happen correctly.
+-- | Change the URL of a page. You should always use this function instead of
+-- 'changeValue' for this, because using 'changeValue' might break dependency
+-- handling when changing the @url@ field.
 -- 
-changeUrl :: (String -> String)            -- ^ Function to change URL with.
-          -> HakyllAction Context Context  -- ^ Resulting action.
-changeUrl f = let action = changeValue "url" f
-              in action {actionUrl = Right $ liftM f}
+changeUrl :: (String -> String)  -- ^ Function to change URL with.
+          -> Transformer a a     -- ^ Resulting action.
+changeUrl f = let t = changeValue "url" f
+              in t {transformerUrl = return . f}
 
--- | Copy a value from one key to another in a @Context@.
-copyValue :: String -- ^ Source key.
-          -> String -- ^ Destination key.
-          -> HakyllAction Context Context
+-- | Copy a metadata value from one key to another
+--
+copyValue :: String           -- ^ Source key.
+          -> String           -- ^ Destination key.
+          -> Transformer a a  -- ^ Resulting transformer
 copyValue source destination = renderValue source destination id
 
 -- | When the context has a key called @path@ in a
@@ -73,7 +72,7 @@ copyValue source destination = renderValue source destination id
 renderDate :: String -- ^ Key in which the rendered date should be placed.
            -> String -- ^ Format to use on the date.
            -> String -- ^ Default key, in case the date cannot be parsed.
-           -> HakyllAction Context Context
+           -> Transformer a a
 renderDate = renderDateWithLocale defaultTimeLocale
 
 -- | This is an extended version of 'renderDate' that allows you to specify a
@@ -84,7 +83,7 @@ renderDateWithLocale :: TimeLocale  -- ^ Output time locale.
                      -> String      -- ^ Destination key.
                      -> String      -- ^ Format to use on the date.
                      -> String      -- ^ Default key.
-                     -> HakyllAction Context Context
+                     -> Transformer a a
 renderDateWithLocale locale key format defaultValue =
     renderValue "path" key renderDate'
   where
@@ -102,23 +101,8 @@ renderDateWithLocale locale key format defaultValue =
 --   > changeExtension "php"
 --
 --   Will render @test.markdown@ to @test.php@ instead of @test.html@.
-changeExtension :: String -- ^ Extension to change to.
-                -> HakyllAction Context Context
+changeExtension :: String           -- ^ Extension to change to.
+                -> Transformer a a  -- ^ Resulting transformer
 changeExtension extension = changeValue "url" changeExtension'
   where
     changeExtension' = flip addExtension extension . dropExtension
-
--- | Change the body of a file using a certain manipulation.
---
---   > import Data.Char (toUpper)
---   > renderBody (map toUpper)
---
---   Will put the entire body of the page in UPPERCASE.
-renderBody :: (String -> String)
-           -> HakyllAction Context Context
-renderBody = renderValue "body" "body"
-
--- | Get the resulting body text from a context
---
-takeBody :: HakyllAction Context String
-takeBody = arr $ fromMaybe "" . M.lookup "body" . unContext
diff --git a/src/Text/Hakyll/Resource.hs b/src/Text/Hakyll/Resource.hs
index a8a77b2..b0ffb8c 100644
--- a/src/Text/Hakyll/Resource.hs
+++ b/src/Text/Hakyll/Resource.hs
@@ -1,21 +1,25 @@
 -- | A resource represents data for a website
 --
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 module Text.Hakyll.Resource
     ( Metadata (..)
     , Resource (..)
     , getData
     , getMetadata
-    , getMetadataList
     ) where
 
 import Data.Monoid (Monoid, mempty, mappend)
 import Control.Applicative (Applicative, (<*>), pure)
+import Data.Map (Map)
+import qualified Data.Map as M
 
 -- | Metadata for a resource
 --
-newtype Metadata = Metadata {unMetadata :: [(String, String)]}
-                 deriving (Show, Eq, Ord, Monoid)
+newtype Metadata = Metadata {unMetadata :: Map String String}
+                 deriving (Show, Eq, Ord)
+
+instance Monoid Metadata where
+    mempty = Metadata M.empty
+    (Metadata m1) `mappend` (Metadata m2) = Metadata $ m1 `M.union` m2
 
 -- | A resource represents a data source for the website. It contains a value
 -- and a number of metadata fields
@@ -50,11 +54,4 @@ getData = resourceData
 -- | Get a metadata field from a resource
 --
 getMetadata :: String -> Resource a -> Maybe String
-getMetadata k (Resource m _) = lookup k $ unMetadata m
-
--- | Get a metadata field from a resource. If multiple fields with the same name
--- exist, they will all be returned
---
-getMetadataList :: String -> Resource a -> [String]
-getMetadataList k = map snd . filter ((== k) . fst)
-                  . unMetadata . resourceMetadata
+getMetadata k (Resource m _) = M.lookup k $ unMetadata m
diff --git a/src/Text/Hakyll/Transformer.hs b/src/Text/Hakyll/Transformer.hs
index fff8470..669e1d0 100644
--- a/src/Text/Hakyll/Transformer.hs
+++ b/src/Text/Hakyll/Transformer.hs
@@ -5,17 +5,17 @@ module Text.Hakyll.Transformer
     , transformResourceM
     , transformData
     , transformDataM
-    , transformMetaData
-    , transformMetaDataM
+    , transformMetadata
+    , transformMetadataM
     , runTransformer
     , runTransformerForced
     ) where
 
-import Data.Monoid (mappend, mempty)
+import Data.Monoid (Monoid, mappend, mempty)
 import Control.Arrow
 import Control.Category
 import Control.Applicative ((<$>))
-import Control.Monad ((<=<), unless)
+import Control.Monad ((<=<), unless, liftM2)
 import Prelude hiding ((.), id)
 
 import Text.Hakyll.Resource
@@ -34,6 +34,16 @@ data Transformer a b = Transformer
       transformerFunction     :: Resource a -> Hakyll (Resource b)
     }
 
+instance Monoid b => Monoid (Transformer a b) where
+    mempty = arr (const mempty)
+    mappend x y = Transformer
+        { transformerDependencies =
+            transformerDependencies x ++ transformerDependencies y
+        , transformerUrl = transformerUrl x
+        , transformerFunction = \r ->
+            liftM2 mappend (transformerFunction x r) (transformerFunction y r)
+        }
+
 instance Category Transformer where
     id = Transformer
         { transformerDependencies = []
@@ -70,11 +80,11 @@ transformDataM :: (a -> Hakyll b) -> Transformer a b
 transformDataM f = transformResourceM $ \(Resource m x) ->
     f x >>= return . Resource m
 
-transformMetaData :: (Metadata -> Metadata) -> Transformer a a
-transformMetaData = transformMetaDataM . (return .)
+transformMetadata :: (Metadata -> Metadata) -> Transformer a a
+transformMetadata = transformMetadataM . (return .)
 
-transformMetaDataM :: (Metadata -> Hakyll Metadata) -> Transformer a a
-transformMetaDataM f = transformResourceM $ \(Resource m x) -> do
+transformMetadataM :: (Metadata -> Hakyll Metadata) -> Transformer a a
+transformMetadataM f = transformResourceM $ \(Resource m x) -> do
     m' <- f m
     return $ Resource m' x