From a2c15932b713e81dcd1344f9227db2c3a65103bf Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Thu, 11 Mar 2010 12:10:55 +0100 Subject: Gave some functions better (more appropriate) names. --- src/Text/Hakyll/Context.hs | 4 ++ src/Text/Hakyll/ContextManipulations.hs | 14 ++--- src/Text/Hakyll/CreateContext.hs | 99 +++++++++++++++++++++++++++++++ src/Text/Hakyll/Feed.hs | 18 +++--- src/Text/Hakyll/Paginate.hs | 2 +- src/Text/Hakyll/Render.hs | 31 ++++------ src/Text/Hakyll/Renderables.hs | 102 -------------------------------- src/Text/Hakyll/Tags.hs | 6 +- 8 files changed, 135 insertions(+), 141 deletions(-) create mode 100644 src/Text/Hakyll/CreateContext.hs delete mode 100644 src/Text/Hakyll/Renderables.hs (limited to 'src') diff --git a/src/Text/Hakyll/Context.hs b/src/Text/Hakyll/Context.hs index d6fa583..c5c77d4 100644 --- a/src/Text/Hakyll/Context.hs +++ b/src/Text/Hakyll/Context.hs @@ -1,7 +1,11 @@ +-- | This (quite small) module exports the datatype used for contexts. A +-- @Context@ is a simple key-value mapping. You can render these @Context@s +-- with templates, and manipulate them in various ways. module Text.Hakyll.Context ( Context ) where import Data.Map (Map) +-- | Datatype used for key-value mappings. type Context = Map String String diff --git a/src/Text/Hakyll/ContextManipulations.hs b/src/Text/Hakyll/ContextManipulations.hs index c526816..9f95232 100644 --- a/src/Text/Hakyll/ContextManipulations.hs +++ b/src/Text/Hakyll/ContextManipulations.hs @@ -21,8 +21,7 @@ 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@. +-- 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. @@ -49,8 +48,9 @@ copyValue :: String -- ^ Source 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. +-- | 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" -- @@ -72,11 +72,9 @@ renderDate key format defaultValue = renderValue "path" key renderDate' -- | 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") +-- > changeExtension "php" -- --- Will render to @test.php@ instead of @test.html@. +-- 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' diff --git a/src/Text/Hakyll/CreateContext.hs b/src/Text/Hakyll/CreateContext.hs new file mode 100644 index 0000000..2e08850 --- /dev/null +++ b/src/Text/Hakyll/CreateContext.hs @@ -0,0 +1,99 @@ +-- | A module that provides different ways to create a @Context@. These +-- functions all use the @HakyllAction@ arrow, so they produce values of the +-- type @HakyllAction () Context@. +module Text.Hakyll.CreateContext + ( createPage + , createCustomPage + , createListing + , combine + , combineWithUrl + ) where + +import qualified Data.Map as M +import Control.Arrow (second) +import Control.Monad (liftM2, mplus) +import Control.Applicative ((<$>)) + +import Text.Hakyll.File +import Text.Hakyll.Context +import Text.Hakyll.HakyllAction +import Text.Hakyll.Render +import Text.Hakyll.Internal.Page + +-- | Create a @Context@ from a page file stored on the disk. This is probably +-- the most common way to create a @Context@. +createPage :: FilePath -> HakyllAction () Context +createPage path = HakyllAction + { actionDependencies = [path] + , actionUrl = Just $ toUrl path + , actionFunction = const (readPage path) + } + +-- | Create a "custom page" @Context@. +-- +-- The association list given maps keys to values for substitution. Note +-- that as value, you can either give a @String@ or a +-- @HakyllAction () String@. The latter is preferred for more complex data, +-- since it allows dependency checking. A @String@ is obviously more simple +-- to use in some cases. +createCustomPage :: String + -> [(String, Either String (HakyllAction () String))] + -> HakyllAction () Context +createCustomPage url association = HakyllAction + { actionDependencies = dataDependencies + , actionUrl = Just $ return url + , actionFunction = \_ -> M.fromList <$> assoc' + } + where + mtuple (a, b) = b >>= \b' -> return (a, b') + toHakyllString = second (either return runHakyllAction) + assoc' = mapM (mtuple . toHakyllString) $ ("url", Left url) : association + dataDependencies = map snd association >>= getDependencies + getDependencies (Left _) = [] + getDependencies (Right x) = actionDependencies x + +-- | A @createCustomPage@ function specialized in creating listings. +-- +-- This function creates a listing of a certain list of @Context@s. Every +-- item in the list is created by applying the given template to every +-- renderable. You can also specify additional context to be included in the +-- @CustomPage@. +createListing :: String -- ^ Destination of the page. + -> [FilePath] -- ^ Templates to render items with. + -> [HakyllAction () Context] -- ^ Renderables in the list. + -> [(String, Either String (HakyllAction () String))] + -> HakyllAction () Context +createListing url templates renderables additional = + createCustomPage url context + where + context = ("body", Right concatenation) : additional + concatenation = renderAndConcat templates renderables + +-- | Combine two renderables. The url will always be taken from the first +-- @Renderable@. Also, if a `$key` is present in both renderables, the +-- value from the first @Renderable@ will be taken as well. +-- +-- Since renderables are always more or less key-value maps, you can see +-- this as a @union@ between two maps. +combine :: HakyllAction () Context -> HakyllAction () Context + -> HakyllAction () Context +combine x y = HakyllAction + { actionDependencies = actionDependencies x ++ actionDependencies y + , actionUrl = actionUrl x `mplus` actionUrl y + , actionFunction = \_ -> + liftM2 M.union (runHakyllAction x) (runHakyllAction y) + } + +-- | Combine two renderables and set a custom URL. This behaves like @combine@, +-- except that for the @url@ field, the given URL is always chosen. +combineWithUrl :: FilePath + -> HakyllAction () Context + -> HakyllAction () Context + -> HakyllAction () Context +combineWithUrl url x y = combine' + { actionUrl = Just $ return url + , actionFunction = \_ -> + M.insert "url" url <$> runHakyllAction combine' + } + where + combine' = combine x y diff --git a/src/Text/Hakyll/Feed.hs b/src/Text/Hakyll/Feed.hs index 44b7239..40e4257 100644 --- a/src/Text/Hakyll/Feed.hs +++ b/src/Text/Hakyll/Feed.hs @@ -2,12 +2,11 @@ -- you must make sure you set the `absoluteUrl` field in the main Hakyll -- configuration. -- --- Apart from that, the main rendering functions (@renderRss@, --- @renderRssWith@, @renderAtom@ all @renderAtomWith@) all assume that you --- pass the list of @Renderable@s so that the most recent entry in the feed is --- the first item in the list. +-- Apart from that, the main rendering functions (@renderRss@, @renderAtom@) +-- all assume that you pass the list of items so that the most recent entry +-- in the feed is the first item in the list. -- --- Also note that the @Renderable@s should have (at least) the following +-- Also note that the @Context@s should have (at least) the following -- fields to produce a correct feed: -- -- - @$title@: Title of the item. @@ -16,7 +15,8 @@ -- -- - @$url@: URL to the item - this is usually set automatically. -- --- Furthermore, the feed will not validate if an empty list is passed. +-- Furthermore, the feed will be generated, but will be incorrect (it won't +-- validate) if an empty list is passed. module Text.Hakyll.Feed ( FeedConfiguration (..) , renderRss @@ -29,10 +29,10 @@ import Data.Maybe (fromMaybe) import qualified Data.Map as M import Text.Hakyll.Context (Context) +import Text.Hakyll.CreateContext (createListing) 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 import Paths_hakyll @@ -53,8 +53,8 @@ data FeedConfiguration = FeedConfiguration -- The items should be sorted on date. createFeed :: FeedConfiguration -- ^ Feed configuration. -> [HakyllAction () Context] -- ^ Items to include. - -> FilePath -- ^ Feed template. - -> FilePath -- ^ Item template. + -> FilePath -- ^ Feed template. + -> FilePath -- ^ Item template. -> HakyllAction () Context createFeed configuration renderables template itemTemplate = listing >>> render template diff --git a/src/Text/Hakyll/Paginate.hs b/src/Text/Hakyll/Paginate.hs index aab2c0d..b895cbb 100644 --- a/src/Text/Hakyll/Paginate.hs +++ b/src/Text/Hakyll/Paginate.hs @@ -8,7 +8,7 @@ module Text.Hakyll.Paginate import Control.Applicative ((<$>)) import Text.Hakyll.Context (Context) -import Text.Hakyll.Renderables +import Text.Hakyll.CreateContext import Text.Hakyll.HakyllAction import Text.Hakyll.Util (link) diff --git a/src/Text/Hakyll/Render.hs b/src/Text/Hakyll/Render.hs index ddca5d0..6f06953 100644 --- a/src/Text/Hakyll/Render.hs +++ b/src/Text/Hakyll/Render.hs @@ -9,6 +9,7 @@ module Text.Hakyll.Render ) where import Control.Arrow ((>>>)) +import Control.Applicative ((<$>)) import Control.Monad.Reader (liftIO) import System.Directory (copyFile) import Data.Maybe (fromMaybe) @@ -21,10 +22,10 @@ import Text.Hakyll.HakyllAction import Text.Hakyll.Internal.CompressCss import Text.Hakyll.Internal.Template --- | A pure render function. +-- | A pure render function - used internally. pureRender :: Template -- ^ Template to use for rendering. - -> Context -- ^ Renderable object to render with given template. - -> Context -- ^ The body of the result will contain the render. + -> Context -- ^ Renderable object to render with given template. + -> Context -- ^ The body of the result will contain the render. pureRender template context = -- Ignore $root when substituting here. We will only replace that in the -- final render (just before writing). @@ -32,29 +33,26 @@ pureRender template context = body = regularSubstitute template contextIgnoringRoot in M.insert "body" body context --- | Render to a Page. +-- | This is the most simple render action. You render a @Context@ with a +-- template, and get back the result. render :: FilePath -- ^ Template to use for rendering. -> HakyllAction Context Context -- ^ The render computation. render templatePath = HakyllAction { actionDependencies = [templatePath] , actionUrl = Nothing - , actionFunction = actionFunction' + , actionFunction = \context -> + flip pureRender context <$> readTemplate templatePath } - where - actionFunction' context = do - template <- readTemplate templatePath - return $ pureRender template context --- | Render each renderable with the given templates, then concatenate the +-- | Render each @Context@ with the given templates, then concatenate the -- result. So, basically this function: -- --- * Takes every renderable. +-- - Takes every @Context@. -- --- * Renders every renderable with all given templates. This is comparable +-- - Renders every @Context@ with all given templates. This is comparable -- with a renderChain action. -- --- * Concatenates the result. --- +-- - Concatenates the result and returns that as a @String@. renderAndConcat :: [FilePath] -> [HakyllAction () Context] -> HakyllAction () String @@ -87,11 +85,8 @@ renderChain :: [FilePath] renderChain templatePaths initial = runHakyllActionIfNeeded renderChainWith' where - renderChainWith' :: HakyllAction () () renderChainWith' = initial >>> chain' >>> writePage - - chain' = chain (map render templatePaths) - + chain' = chain $ map render templatePaths -- | Mark a certain file as static, so it will just be copied when the site is -- generated. diff --git a/src/Text/Hakyll/Renderables.hs b/src/Text/Hakyll/Renderables.hs deleted file mode 100644 index 53530c6..0000000 --- a/src/Text/Hakyll/Renderables.hs +++ /dev/null @@ -1,102 +0,0 @@ -module Text.Hakyll.Renderables - ( createCustomPage - , createListing - , createPagePath - , combine - , combineWithUrl - ) where - -import qualified Data.Map as M -import Control.Arrow (second) -import Control.Monad (liftM2, mplus) -import Control.Applicative ((<$>)) - -import Text.Hakyll.File -import Text.Hakyll.Context -import Text.Hakyll.HakyllAction -import Text.Hakyll.Render -import Text.Hakyll.Internal.Page - --- | Create a custom page. --- --- The association list given maps keys to values for substitution. Note --- that as value, you can either give a @String@ or a @Hakyll String@. --- A @Hakyll String@ is preferred for more complex data, since it allows --- dependency checking. A @String@ is obviously more simple to use in some --- cases. -createCustomPage :: String - -> [(String, Either String (HakyllAction () String))] - -> HakyllAction () Context -createCustomPage url association = HakyllAction - { actionDependencies = dataDependencies - , actionUrl = Just $ return url - , actionFunction = \_ -> M.fromList <$> assoc' - } - where - mtuple (a, b) = b >>= \b' -> return (a, b') - toHakyllString = second (either return runHakyllAction) - assoc' = mapM (mtuple . toHakyllString) $ ("url", Left url) : association - dataDependencies = map snd association >>= getDependencies - getDependencies (Left _) = [] - getDependencies (Right x) = actionDependencies x - --- | A @createCustomPage@ function specialized in creating listings. --- --- This function creates a listing of a certain list of renderables. Every --- item in the list is created by applying the given template to every --- renderable. You can also specify additional context to be included in the --- @CustomPage@. --- --- > let customPage = createListing --- > "index.html" -- Destination of the page. --- > ["templates/postitem.html"] -- Paths to templates to render the --- > -- items with. --- > posts -- Renderables to create the list with. --- > [("title", Left "Home")] -- Additional context -createListing :: String -- ^ Destination of the page. - -> [FilePath] -- ^ Templates to render items with. - -> [HakyllAction () Context] -- ^ Renderables in the list. - -> [(String, Either String (HakyllAction () String))] - -> HakyllAction () Context -createListing url templates renderables additional = - createCustomPage url context - where - context = ("body", Right concatenation) : additional - concatenation = renderAndConcat templates renderables - --- | Create a PagePath from a FilePath. -createPagePath :: FilePath -> HakyllAction () Context -createPagePath path = HakyllAction - { actionDependencies = [path] - , actionUrl = Just $ toUrl path - , actionFunction = const (readPage path) - } - --- | Combine two renderables. The url will always be taken from the first --- @Renderable@. Also, if a `$key` is present in both renderables, the --- value from the first @Renderable@ will be taken as well. --- --- Since renderables are always more or less key-value maps, you can see --- this as a @union@ between two maps. -combine :: HakyllAction () Context -> HakyllAction () Context - -> HakyllAction () Context -combine x y = HakyllAction - { actionDependencies = actionDependencies x ++ actionDependencies y - , actionUrl = actionUrl x `mplus` actionUrl y - , actionFunction = \_ -> - liftM2 M.union (runHakyllAction x) (runHakyllAction y) - } - --- | Combine two renderables and set a custom URL. This behaves like @combine@, --- except that for the @url@ field, the given URL is always chosen. -combineWithUrl :: FilePath - -> HakyllAction () Context - -> HakyllAction () Context - -> HakyllAction () Context -combineWithUrl url x y = combine' - { actionUrl = Just $ return url - , actionFunction = \_ -> - M.insert "url" url <$> runHakyllAction combine' - } - where - combine' = combine x y diff --git a/src/Text/Hakyll/Tags.hs b/src/Text/Hakyll/Tags.hs index 889bb9d..5e9f76f 100644 --- a/src/Text/Hakyll/Tags.hs +++ b/src/Text/Hakyll/Tags.hs @@ -46,9 +46,9 @@ import System.FilePath import Text.Hakyll.Context (Context) import Text.Hakyll.ContextManipulations (changeValue) +import Text.Hakyll.CreateContext (createPage) import Text.Hakyll.HakyllMonad (Hakyll) import Text.Hakyll.Regex -import Text.Hakyll.Renderables import Text.Hakyll.HakyllAction import Text.Hakyll.Util import Text.Hakyll.Internal.Cache @@ -82,11 +82,11 @@ readMap getTagsFunction identifier paths = HakyllAction else do assocMap' <- readTagMap' storeInCache (M.toAscList assocMap') fileName return assocMap' - return $ M.map (map createPagePath) assocMap + return $ M.map (map createPage) assocMap readTagMap' = foldM addPaths M.empty paths addPaths current path = do - context <- runHakyllAction $ createPagePath path + context <- runHakyllAction $ createPage path let tags = getTagsFunction context addPaths' = flip (M.insertWith (++)) [path] return $ foldr addPaths' current tags -- cgit v1.2.3