From d25b0b683410211530c977625685349b11b8ff72 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Thu, 11 Mar 2010 11:03:40 +0100 Subject: Moved some modules around for fun and profit. --- hakyll.cabal | 3 +- src/Text/Hakyll.hs | 2 +- src/Text/Hakyll/Context.hs | 85 +-------------------------------- src/Text/Hakyll/ContextManipulations.hs | 84 ++++++++++++++++++++++++++++++++ src/Text/Hakyll/Feed.hs | 5 +- src/Text/Hakyll/File.hs | 2 +- src/Text/Hakyll/Hakyll.hs | 53 -------------------- src/Text/Hakyll/HakyllAction.hs | 2 +- src/Text/Hakyll/HakyllMonad.hs | 50 +++++++++++++++++++ src/Text/Hakyll/Internal/Cache.hs | 5 +- src/Text/Hakyll/Internal/Page.hs | 2 +- src/Text/Hakyll/Internal/Template.hs | 2 +- src/Text/Hakyll/Paginate.hs | 2 +- src/Text/Hakyll/Render.hs | 3 +- src/Text/Hakyll/Tags.hs | 5 +- 15 files changed, 155 insertions(+), 150 deletions(-) create mode 100644 src/Text/Hakyll/ContextManipulations.hs delete mode 100644 src/Text/Hakyll/Hakyll.hs create mode 100644 src/Text/Hakyll/HakyllMonad.hs diff --git a/hakyll.cabal b/hakyll.cabal index 47b9b0b..fa1ead2 100644 --- a/hakyll.cabal +++ b/hakyll.cabal @@ -44,8 +44,9 @@ library exposed-modules: Network.Hakyll.SimpleServer Text.Hakyll Text.Hakyll.Context + Text.Hakyll.ContextManipulations Text.Hakyll.File - Text.Hakyll.Hakyll + Text.Hakyll.HakyllMonad Text.Hakyll.Regex Text.Hakyll.Render Text.Hakyll.HakyllAction diff --git a/src/Text/Hakyll.hs b/src/Text/Hakyll.hs index 5a8a37b..2545014 100644 --- a/src/Text/Hakyll.hs +++ b/src/Text/Hakyll.hs @@ -22,7 +22,7 @@ import System.Directory (doesDirectoryExist, removeDirectoryRecursive) import System.Time (getClockTime) import Network.Hakyll.SimpleServer (simpleServer) -import Text.Hakyll.Hakyll +import Text.Hakyll.HakyllMonad import Text.Hakyll.File -- | The default hakyll configuration. 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/Hakyll.hs b/src/Text/Hakyll/Hakyll.hs deleted file mode 100644 index bff57d0..0000000 --- a/src/Text/Hakyll/Hakyll.hs +++ /dev/null @@ -1,53 +0,0 @@ --- | Module describing the Hakyll monad stack. -module Text.Hakyll.Hakyll - ( Context - , HakyllConfiguration (..) - , Hakyll - , askHakyll - , getAdditionalContext - ) where - -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 - --- | Hakyll global configuration type. -data HakyllConfiguration = HakyllConfiguration - { -- | Absolute URL of the site. - absoluteUrl :: String - , -- | An additional context to use when rendering. This additional context - -- is used globally. - additionalContext :: Context - , -- | Directory where the site is placed. - siteDirectory :: FilePath - , -- | Directory for cache files. - cacheDirectory :: FilePath - , -- | Enable index links. - enableIndexUrl :: Bool - , -- | Delay between polls in preview mode. - 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: --- --- > doSomething :: a -> b -> Hakyll c --- > doSomething arg1 arg2 = do --- > siteDirectory' <- askHakyll siteDirectory --- > ... --- -askHakyll :: (HakyllConfiguration -> a) -> Hakyll a -askHakyll = flip liftM ask - -getAdditionalContext :: HakyllConfiguration -> Context -getAdditionalContext configuration = - M.insert "absolute" (absoluteUrl configuration) - (additionalContext configuration) 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/HakyllMonad.hs b/src/Text/Hakyll/HakyllMonad.hs new file mode 100644 index 0000000..4a9e696 --- /dev/null +++ b/src/Text/Hakyll/HakyllMonad.hs @@ -0,0 +1,50 @@ +-- | Module describing the Hakyll monad stack. +module Text.Hakyll.HakyllMonad + ( HakyllConfiguration (..) + , Hakyll + , askHakyll + , getAdditionalContext + ) where + +import Control.Monad.Reader (ReaderT, ask) +import Control.Monad (liftM) +import qualified Data.Map as M + +import Text.Hakyll.Context (Context) + +-- | Our custom monad stack. +type Hakyll = ReaderT HakyllConfiguration IO + +-- | Hakyll global configuration type. +data HakyllConfiguration = HakyllConfiguration + { -- | Absolute URL of the site. + absoluteUrl :: String + , -- | An additional context to use when rendering. This additional context + -- is used globally. + additionalContext :: Context + , -- | Directory where the site is placed. + siteDirectory :: FilePath + , -- | Directory for cache files. + cacheDirectory :: FilePath + , -- | Enable index links. + enableIndexUrl :: Bool + , -- | Delay between polls in preview mode. + previewPollDelay :: Int + } + +-- | Simplified @ask@ function for the Hakyll monad stack. +-- +-- Usage would typically be something like: +-- +-- > doSomething :: a -> b -> Hakyll c +-- > doSomething arg1 arg2 = do +-- > siteDirectory' <- askHakyll siteDirectory +-- > ... +-- +askHakyll :: (HakyllConfiguration -> a) -> Hakyll a +askHakyll = flip liftM ask + +getAdditionalContext :: HakyllConfiguration -> Context +getAdditionalContext configuration = + M.insert "absolute" (absoluteUrl configuration) + (additionalContext configuration) 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 -- cgit v1.2.3