diff options
author | Jasper Van der Jeugt <jaspervdj@gmail.com> | 2010-12-13 22:02:54 +0100 |
---|---|---|
committer | Jasper Van der Jeugt <jaspervdj@gmail.com> | 2010-12-13 22:02:54 +0100 |
commit | fef1172c77e510054fc9bf95d5d2b85b8a15478e (patch) | |
tree | aabea08d1c227062906858ec88f39794d10428ca | |
parent | 0da0dd469de6f3c7439099900676deb8a667bbe6 (diff) | |
download | hakyll-fef1172c77e510054fc9bf95d5d2b85b8a15478e.tar.gz |
ContextManipulations → Metadata
-rw-r--r-- | src/Text/Hakyll/Metadata.hs (renamed from src/Text/Hakyll/ContextManipulations.hs) | 76 | ||||
-rw-r--r-- | src/Text/Hakyll/Resource.hs | 21 | ||||
-rw-r--r-- | src/Text/Hakyll/Transformer.hs | 26 |
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 |