From fef1172c77e510054fc9bf95d5d2b85b8a15478e Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Mon, 13 Dec 2010 22:02:54 +0100 Subject: ContextManipulations → Metadata MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Text/Hakyll/ContextManipulations.hs | 124 -------------------------------- src/Text/Hakyll/Metadata.hs | 108 ++++++++++++++++++++++++++++ src/Text/Hakyll/Resource.hs | 21 +++--- src/Text/Hakyll/Transformer.hs | 26 ++++--- 4 files changed, 135 insertions(+), 144 deletions(-) delete mode 100644 src/Text/Hakyll/ContextManipulations.hs create mode 100644 src/Text/Hakyll/Metadata.hs (limited to 'src') diff --git a/src/Text/Hakyll/ContextManipulations.hs b/src/Text/Hakyll/ContextManipulations.hs deleted file mode 100644 index 1c26f72..0000000 --- a/src/Text/Hakyll/ContextManipulations.hs +++ /dev/null @@ -1,124 +0,0 @@ --- | This module exports a number of functions that produce @HakyllAction@s to --- manipulate @Context@s. -module Text.Hakyll.ContextManipulations - ( renderValue - , changeValue - , changeUrl - , copyValue - , 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) -import Data.Time.Clock (UTCTime) -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 (..)) - --- | 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. --- -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 - --- | Change a value in a @Context@. --- --- > 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 key = renderValue key key - --- | Change the URL of a page. This requires a special function, so dependency --- handling can happen correctly. --- -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} - --- | Copy a value from one key to another in a @Context@. -copyValue :: String -- ^ Source key. - -> String -- ^ Destination key. - -> HakyllAction Context Context -copyValue source destination = renderValue source destination id - --- | When the context has a key called @path@ in a --- @folder/yyyy-mm-dd-title.extension@ format (the convention for pages), --- this function can render the date. --- --- > renderDate "date" "%B %e, %Y" "Date unknown" --- --- Will render something like @January 32, 2010@. --- -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 -renderDate = renderDateWithLocale defaultTimeLocale - --- | This is an extended version of 'renderDate' that allows you to specify a --- time locale that is used for outputting the date. For more details, see --- 'renderDate'. --- -renderDateWithLocale :: TimeLocale -- ^ Output time locale. - -> String -- ^ Destination key. - -> String -- ^ Format to use on the date. - -> String -- ^ Default key. - -> HakyllAction Context Context -renderDateWithLocale locale key format defaultValue = - renderValue "path" key renderDate' - where - renderDate' filePath = fromMaybe defaultValue $ do - let dateString = substituteRegex "^([0-9]*-[0-9]*-[0-9]*).*" "\\1" - (takeFileName filePath) - time <- parseTime defaultTimeLocale - "%Y-%m-%d" - dateString :: Maybe UTCTime - return $ formatTime locale format time - --- | Change the extension of a file. This is only needed when you want to --- render, for example, mardown to @.php@ files instead of @.html@ files. --- --- > changeExtension "php" --- --- Will render @test.markdown@ to @test.php@ instead of @test.html@. -changeExtension :: String -- ^ Extension to change to. - -> HakyllAction Context Context -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/Metadata.hs b/src/Text/Hakyll/Metadata.hs new file mode 100644 index 0000000..7698dad --- /dev/null +++ b/src/Text/Hakyll/Metadata.hs @@ -0,0 +1,108 @@ +-- | This module exports a number of functions to manipulate metadata of +-- resources +-- +module Text.Hakyll.ContextManipulations + ( renderValue + , changeValue + , changeUrl + , copyValue + , renderDate + , renderDateWithLocale + , changeExtension + ) where + +import System.Locale (TimeLocale, defaultTimeLocale) +import System.FilePath (takeFileName, addExtension, dropExtension) +import Data.Time.Format (parseTime, formatTime) +import Data.Time.Clock (UTCTime) +import Data.Maybe (fromMaybe) +import qualified Data.Map as M + +import Text.Hakyll.Regex (substituteRegex) +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. +-- +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. + -> 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 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. + -> Transformer a a +changeValue key = renderValue key key + +-- | 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. + -> Transformer a a -- ^ Resulting action. +changeUrl f = let t = changeValue "url" f + in t {transformerUrl = return . f} + +-- | 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 +-- @folder/yyyy-mm-dd-title.extension@ format (the convention for pages), +-- this function can render the date. +-- +-- > renderDate "date" "%B %e, %Y" "Date unknown" +-- +-- Will render something like @January 32, 2010@. +-- +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. + -> Transformer a a +renderDate = renderDateWithLocale defaultTimeLocale + +-- | This is an extended version of 'renderDate' that allows you to specify a +-- time locale that is used for outputting the date. For more details, see +-- 'renderDate'. +-- +renderDateWithLocale :: TimeLocale -- ^ Output time locale. + -> String -- ^ Destination key. + -> String -- ^ Format to use on the date. + -> String -- ^ Default key. + -> Transformer a a +renderDateWithLocale locale key format defaultValue = + renderValue "path" key renderDate' + where + renderDate' filePath = fromMaybe defaultValue $ do + let dateString = substituteRegex "^([0-9]*-[0-9]*-[0-9]*).*" "\\1" + (takeFileName filePath) + time <- parseTime defaultTimeLocale + "%Y-%m-%d" + dateString :: Maybe UTCTime + return $ formatTime locale format time + +-- | Change the extension of a file. This is only needed when you want to +-- render, for example, mardown to @.php@ files instead of @.html@ files. +-- +-- > changeExtension "php" +-- +-- Will render @test.markdown@ to @test.php@ instead of @test.html@. +changeExtension :: String -- ^ Extension to change to. + -> Transformer a a -- ^ Resulting transformer +changeExtension extension = changeValue "url" changeExtension' + where + changeExtension' = flip addExtension extension . dropExtension 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 -- cgit v1.2.3