diff options
Diffstat (limited to 'src/Text/Hakyll')
-rw-r--r-- | src/Text/Hakyll/Context.hs | 85 | ||||
-rw-r--r-- | src/Text/Hakyll/ContextManipulations.hs | 84 | ||||
-rw-r--r-- | src/Text/Hakyll/Feed.hs | 5 | ||||
-rw-r--r-- | src/Text/Hakyll/File.hs | 2 | ||||
-rw-r--r-- | src/Text/Hakyll/HakyllAction.hs | 2 | ||||
-rw-r--r-- | src/Text/Hakyll/HakyllMonad.hs (renamed from src/Text/Hakyll/Hakyll.hs) | 15 | ||||
-rw-r--r-- | src/Text/Hakyll/Internal/Cache.hs | 5 | ||||
-rw-r--r-- | src/Text/Hakyll/Internal/Page.hs | 2 | ||||
-rw-r--r-- | src/Text/Hakyll/Internal/Template.hs | 2 | ||||
-rw-r--r-- | src/Text/Hakyll/Paginate.hs | 2 | ||||
-rw-r--r-- | src/Text/Hakyll/Render.hs | 3 | ||||
-rw-r--r-- | src/Text/Hakyll/Tags.hs | 5 |
12 files changed, 108 insertions, 104 deletions
diff --git a/src/Text/Hakyll/Context.hs b/src/Text/Hakyll/Context.hs index 285ccd0..d6fa583 100644 --- a/src/Text/Hakyll/Context.hs +++ b/src/Text/Hakyll/Context.hs @@ -1,88 +1,7 @@ --- | Module containing various functions to manipulate contexts. module Text.Hakyll.Context ( Context - , ContextManipulation - , renderValue - , changeValue - , copyValue - , renderDate - , changeExtension ) where -import Control.Arrow (arr) -import System.Locale (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 Data.Map (Map) -import Text.Hakyll.Regex (substituteRegex) -import Text.Hakyll.HakyllAction (HakyllAction) -import Text.Hakyll.Hakyll (Context) - --- | Type for context manipulating functions. -type ContextManipulation = Context -> Context - --- | Do something with a value in a @Context@, but keep the old value as well. --- This is probably the most common function to construct a --- @ContextManipulation@. -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 -> - 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 - --- | 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 @yyyy-mm-dd-title.extension@ --- format (default 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 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 defaultTimeLocale 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. --- --- > renderChainWith (changeExtension "php") --- > ["templates/default.html"] --- > (createPagePath "test.markdown") --- --- Will render 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 +type Context = Map String String diff --git a/src/Text/Hakyll/ContextManipulations.hs b/src/Text/Hakyll/ContextManipulations.hs new file mode 100644 index 0000000..c526816 --- /dev/null +++ b/src/Text/Hakyll/ContextManipulations.hs @@ -0,0 +1,84 @@ +-- | This module exports a number of functions that produce @HakyllAction@s to +-- manipulate @Context@s. +module Text.Hakyll.ContextManipulations + ( renderValue + , changeValue + , copyValue + , renderDate + , changeExtension + ) where + +import Control.Arrow (arr) +import System.Locale (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. +-- This is probably the most common function to construct a +-- @ContextManipulation@. +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 -> + 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 + +-- | 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 @yyyy-mm-dd-title.extension@ +-- format (default 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 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 defaultTimeLocale 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. +-- +-- > renderChainWith (changeExtension "php") +-- > ["templates/default.html"] +-- > (createPagePath "test.markdown") +-- +-- Will render 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 diff --git a/src/Text/Hakyll/Feed.hs b/src/Text/Hakyll/Feed.hs index 67d7320..44b7239 100644 --- a/src/Text/Hakyll/Feed.hs +++ b/src/Text/Hakyll/Feed.hs @@ -28,8 +28,9 @@ import Control.Monad.Reader (liftIO) import Data.Maybe (fromMaybe) import qualified Data.Map as M -import Text.Hakyll.Context (renderDate) -import Text.Hakyll.Hakyll (Hakyll, Context) +import Text.Hakyll.Context (Context) +import Text.Hakyll.ContextManipulations (renderDate) +import Text.Hakyll.HakyllMonad (Hakyll) import Text.Hakyll.Render (render, renderChain) import Text.Hakyll.Renderables (createListing) import Text.Hakyll.HakyllAction diff --git a/src/Text/Hakyll/File.hs b/src/Text/Hakyll/File.hs index b428a78..84d8183 100644 --- a/src/Text/Hakyll/File.hs +++ b/src/Text/Hakyll/File.hs @@ -23,7 +23,7 @@ import Data.List (isPrefixOf, sortBy) import Data.Ord (comparing) import Control.Monad.Reader (liftIO) -import Text.Hakyll.Hakyll +import Text.Hakyll.HakyllMonad import Text.Hakyll.Internal.FileType (isRenderableFile) -- | Auxiliary function to remove pathSeparators form the start. We don't deal diff --git a/src/Text/Hakyll/HakyllAction.hs b/src/Text/Hakyll/HakyllAction.hs index 8902edb..c1600a9 100644 --- a/src/Text/Hakyll/HakyllAction.hs +++ b/src/Text/Hakyll/HakyllAction.hs @@ -17,7 +17,7 @@ import Prelude hiding ((.), id) import System.IO (hPutStrLn, stderr) import Text.Hakyll.File (toDestination, isFileMoreRecent) -import Text.Hakyll.Hakyll +import Text.Hakyll.HakyllMonad -- | Type used for rendering computations that carry along dependencies. data HakyllAction a b = HakyllAction diff --git a/src/Text/Hakyll/Hakyll.hs b/src/Text/Hakyll/HakyllMonad.hs index bff57d0..4a9e696 100644 --- a/src/Text/Hakyll/Hakyll.hs +++ b/src/Text/Hakyll/HakyllMonad.hs @@ -1,7 +1,6 @@ -- | Module describing the Hakyll monad stack. -module Text.Hakyll.Hakyll - ( Context - , HakyllConfiguration (..) +module Text.Hakyll.HakyllMonad + ( HakyllConfiguration (..) , Hakyll , askHakyll , getAdditionalContext @@ -9,11 +8,12 @@ module Text.Hakyll.Hakyll import Control.Monad.Reader (ReaderT, ask) import Control.Monad (liftM) -import Data.Map (Map) import qualified Data.Map as M --- | Type for a context. -type Context = Map String String +import Text.Hakyll.Context (Context) + +-- | Our custom monad stack. +type Hakyll = ReaderT HakyllConfiguration IO -- | Hakyll global configuration type. data HakyllConfiguration = HakyllConfiguration @@ -32,9 +32,6 @@ data HakyllConfiguration = HakyllConfiguration previewPollDelay :: Int } --- | Our custom monad stack. -type Hakyll = ReaderT HakyllConfiguration IO - -- | Simplified @ask@ function for the Hakyll monad stack. -- -- Usage would typically be something like: diff --git a/src/Text/Hakyll/Internal/Cache.hs b/src/Text/Hakyll/Internal/Cache.hs index d586f45..2a196f1 100644 --- a/src/Text/Hakyll/Internal/Cache.hs +++ b/src/Text/Hakyll/Internal/Cache.hs @@ -6,10 +6,11 @@ module Text.Hakyll.Internal.Cache import Control.Monad ((<=<)) import Control.Monad.Reader (liftIO) -import Text.Hakyll.Hakyll (Hakyll) -import Text.Hakyll.File import Data.Binary +import Text.Hakyll.File +import Text.Hakyll.HakyllMonad (Hakyll) + -- | We can store all datatypes instantiating @Binary@ to the cache. The cache -- directory is specified by the @HakyllConfiguration@, usually @_cache@. storeInCache :: (Binary a) => a -> FilePath -> Hakyll () diff --git a/src/Text/Hakyll/Internal/Page.hs b/src/Text/Hakyll/Internal/Page.hs index 5168161..8500693 100644 --- a/src/Text/Hakyll/Internal/Page.hs +++ b/src/Text/Hakyll/Internal/Page.hs @@ -13,7 +13,7 @@ import Text.Pandoc import Text.Hakyll.Context (Context) import Text.Hakyll.File -import Text.Hakyll.Hakyll +import Text.Hakyll.HakyllMonad import Text.Hakyll.Regex (substituteRegex, matchesRegex) import Text.Hakyll.Util (trim) import Text.Hakyll.Internal.Cache diff --git a/src/Text/Hakyll/Internal/Template.hs b/src/Text/Hakyll/Internal/Template.hs index 6349dce..2a9b588 100644 --- a/src/Text/Hakyll/Internal/Template.hs +++ b/src/Text/Hakyll/Internal/Template.hs @@ -19,8 +19,8 @@ import Control.Monad.Reader (liftIO) import Test.QuickCheck -import Text.Hakyll.Hakyll (Hakyll) import Text.Hakyll.Context (Context) +import Text.Hakyll.HakyllMonad (Hakyll) import Text.Hakyll.Internal.Cache -- | Datatype used for template substitutions. diff --git a/src/Text/Hakyll/Paginate.hs b/src/Text/Hakyll/Paginate.hs index 159a3a4..aab2c0d 100644 --- a/src/Text/Hakyll/Paginate.hs +++ b/src/Text/Hakyll/Paginate.hs @@ -7,7 +7,7 @@ module Text.Hakyll.Paginate import Control.Applicative ((<$>)) -import Text.Hakyll.Hakyll (Context) +import Text.Hakyll.Context (Context) import Text.Hakyll.Renderables import Text.Hakyll.HakyllAction import Text.Hakyll.Util (link) diff --git a/src/Text/Hakyll/Render.hs b/src/Text/Hakyll/Render.hs index a81ec2f..ddca5d0 100644 --- a/src/Text/Hakyll/Render.hs +++ b/src/Text/Hakyll/Render.hs @@ -14,7 +14,8 @@ import System.Directory (copyFile) import Data.Maybe (fromMaybe) import qualified Data.Map as M -import Text.Hakyll.Hakyll (Hakyll, Context, askHakyll, getAdditionalContext) +import Text.Hakyll.Context (Context) +import Text.Hakyll.HakyllMonad (Hakyll, askHakyll, getAdditionalContext) import Text.Hakyll.File import Text.Hakyll.HakyllAction import Text.Hakyll.Internal.CompressCss diff --git a/src/Text/Hakyll/Tags.hs b/src/Text/Hakyll/Tags.hs index f4193eb..889bb9d 100644 --- a/src/Text/Hakyll/Tags.hs +++ b/src/Text/Hakyll/Tags.hs @@ -44,8 +44,9 @@ import Control.Arrow (second, (>>>)) import Control.Applicative ((<$>)) import System.FilePath -import Text.Hakyll.Context -import Text.Hakyll.Hakyll (Hakyll) +import Text.Hakyll.Context (Context) +import Text.Hakyll.ContextManipulations (changeValue) +import Text.Hakyll.HakyllMonad (Hakyll) import Text.Hakyll.Regex import Text.Hakyll.Renderables import Text.Hakyll.HakyllAction |