summaryrefslogtreecommitdiff
path: root/src/Text
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text')
-rw-r--r--src/Text/Hakyll/Internal/Page.hs19
-rw-r--r--src/Text/Hakyll/Internal/Render.hs16
-rw-r--r--src/Text/Hakyll/Paginate.hs20
-rw-r--r--src/Text/Hakyll/Render.hs91
-rw-r--r--src/Text/Hakyll/RenderAction.hs40
-rw-r--r--src/Text/Hakyll/Renderable.hs18
-rw-r--r--src/Text/Hakyll/Renderables.hs73
7 files changed, 122 insertions, 155 deletions
diff --git a/src/Text/Hakyll/Internal/Page.hs b/src/Text/Hakyll/Internal/Page.hs
index 92e7249..4adddc5 100644
--- a/src/Text/Hakyll/Internal/Page.hs
+++ b/src/Text/Hakyll/Internal/Page.hs
@@ -21,11 +21,8 @@ import Data.Binary
import Text.Hakyll.Internal.Cache
import Text.Hakyll.Hakyll
-import Text.Hakyll.File
import Text.Hakyll.Util (trim)
import Text.Hakyll.Context (Context)
-import Text.Hakyll.Renderable
-import Text.Hakyll.RenderAction
import Text.Hakyll.Regex (substituteRegex, matchesRegex)
-- | A Page is basically key-value mapping. Certain keys have special
@@ -42,16 +39,6 @@ fromContext = Page
getValue :: String -> Page -> String
getValue str (Page page) = fromMaybe [] $ M.lookup str page
--- | Get the URL for a certain page. This should always be defined. If
--- not, it will error.
-getPageUrl :: Page -> String
-getPageUrl (Page page) = fromMaybe (error "No page url") $ M.lookup "url" page
-
--- | Get the original page path.
-getPagePath :: Page -> String
-getPagePath (Page page) =
- fromMaybe (error "No page path") $ M.lookup "path" page
-
-- | Get the body for a certain page. When not defined, the body will be
-- empty.
getBody :: Page -> String
@@ -155,12 +142,6 @@ readPage path = do
where
fileName = "pages" </> path
--- Make pages renderable.
-instance Renderable Page where
- getDependencies = (:[]) . getPagePath
- getUrl = return . getPageUrl
- toContext (Page page) = return page
-
-- Make pages serializable.
instance Binary Page where
put (Page context) = put $ M.toAscList context
diff --git a/src/Text/Hakyll/Internal/Render.hs b/src/Text/Hakyll/Internal/Render.hs
index 00b74a7..0fae8a7 100644
--- a/src/Text/Hakyll/Internal/Render.hs
+++ b/src/Text/Hakyll/Internal/Render.hs
@@ -15,10 +15,9 @@ import Data.List (foldl')
import Data.Maybe (fromMaybe)
import Text.Hakyll.Context (Context, ContextManipulation)
-import Text.Hakyll.Renderable
import Text.Hakyll.File
import Text.Hakyll.Hakyll
-import Text.Hakyll.Internal.Page
+import Text.Hakyll.RenderAction
import Text.Hakyll.Internal.Template
-- | A pure render function.
@@ -55,13 +54,14 @@ pureRenderChainWith manipulation templates context =
-- | Write a page to the site destination. Final action after render
-- chains and such.
-writePage :: Page -> Hakyll ()
-writePage page = do
+writePage :: RenderAction Context ()
+writePage = createRenderAction $ \initialContext -> do
additionalContext' <- askHakyll additionalContext
- url <- getUrl page
- destination <- toDestination url
+ let url = fromMaybe (error "No url defined at write time.")
+ (M.lookup "url" initialContext)
+ body = fromMaybe "" (M.lookup "body" initialContext)
let context = additionalContext' `M.union` M.singleton "root" (toRoot url)
+ destination <- toDestination url
makeDirectories destination
    -- Substitute $root here, just before writing.
- liftIO $ writeFile destination $ finalSubstitute (fromString $ getBody page)
- context
+ liftIO $ writeFile destination $ finalSubstitute (fromString body) context
diff --git a/src/Text/Hakyll/Paginate.hs b/src/Text/Hakyll/Paginate.hs
index e228404..4a0782a 100644
--- a/src/Text/Hakyll/Paginate.hs
+++ b/src/Text/Hakyll/Paginate.hs
@@ -55,8 +55,8 @@ paginate :: PaginateConfiguration
paginate configuration renderables = paginate' Nothing renderables (1 :: Int)
where
-- Create a link with a given label, taken from the configuration.
- linkWithLabel f r = case actionDestination r of
- Just l -> link (f configuration) <$> l
+ linkWithLabel f r = Right $ case actionUrl r of
+ Just l -> createSimpleRenderAction $ link (f configuration) <$> l
Nothing -> error "No link found for pagination."
-- The main function that creates combined renderables by recursing over
@@ -66,18 +66,18 @@ paginate configuration renderables = paginate' Nothing renderables (1 :: Int)
let (previous, first) = case maybePrev of
(Just r) -> ( linkWithLabel previousLabel r
, linkWithLabel firstLabel (head renderables) )
- Nothing -> ( return $ previousLabel configuration
- , return $ firstLabel configuration )
+ Nothing -> ( Left $ previousLabel configuration
+ , Left $ firstLabel configuration )
(next, last') = case xs of
(n:_) -> ( linkWithLabel nextLabel n
, linkWithLabel lastLabel (last renderables) )
- [] -> ( return $ nextLabel configuration
- , return $ lastLabel configuration )
+ [] -> ( Left $ nextLabel configuration
+ , Left $ lastLabel configuration )
customPage = createCustomPage "" []
- [ ("previous", Right previous)
- , ("next", Right next)
- , ("first", Right first)
- , ("last", Right last')
+ [ ("previous", previous)
+ , ("next", next)
+ , ("first", first)
+ , ("last", last')
, ("index", Left $ show index)
, ("length", Left $ show $ length renderables)
]
diff --git a/src/Text/Hakyll/Render.hs b/src/Text/Hakyll/Render.hs
index 98d1a3c..5915e36 100644
--- a/src/Text/Hakyll/Render.hs
+++ b/src/Text/Hakyll/Render.hs
@@ -13,15 +13,17 @@ module Text.Hakyll.Render
) where
import Control.Monad (unless)
+import Control.Arrow ((>>>))
import Control.Monad.Reader (liftIO)
import System.Directory (copyFile)
+import Data.Maybe (fromMaybe)
+import qualified Data.Map as M
import Text.Hakyll.Hakyll (Hakyll)
-import Text.Hakyll.Context (ContextManipulation)
-import Text.Hakyll.Renderable
+import Text.Hakyll.Context (ContextManipulation, Context)
import Text.Hakyll.File
+import Text.Hakyll.RenderAction
import Text.Hakyll.Internal.CompressCss
-import Text.Hakyll.Internal.Page
import Text.Hakyll.Internal.Render
import Text.Hakyll.Internal.Template (readTemplate)
@@ -36,23 +38,24 @@ depends file dependencies action = do
unless valid action
-- | Render to a Page.
-render :: Renderable a
- => FilePath -- ^ Template to use for rendering.
- -> a -- ^ Renderable object to render with given template.
- -> Hakyll Page -- ^ The body of the result will contain the render.
+render :: FilePath -- ^ Template to use for rendering.
+ -> RenderAction Context Context -- ^ The render computation.
render = renderWith id
-- | Render to a Page. This function allows you to manipulate the context
-- first.
-renderWith :: Renderable a
- => ContextManipulation -- ^ Manipulation to apply on the context.
- -> FilePath -- ^ Template to use for rendering.
- -> a -- ^ Data to render.
- -> Hakyll Page -- ^ Result of the render operation.
-renderWith manipulation templatePath renderable = do
- template <- readTemplate templatePath
- context <- toContext renderable
- return $ fromContext $ pureRenderWith manipulation template context
+renderWith :: ContextManipulation -- ^ Manipulation to apply first.
+ -> FilePath -- ^ Template to use for rendering.
+ -> RenderAction Context Context -- ^ The render computation.
+renderWith manipulation templatePath = RenderAction
+ { actionDependencies = [templatePath]
+ , actionUrl = Nothing
+ , actionFunction = actionFunction'
+ }
+ where
+ actionFunction' context = do
+ template <- readTemplate templatePath
+ return $ pureRenderWith manipulation template context
-- | Render each renderable with the given templates, then concatenate the
-- result. So, basically this function:
@@ -64,24 +67,31 @@ renderWith manipulation templatePath renderable = do
--
-- * Concatenates the result.
--
-renderAndConcat :: Renderable a
- => [FilePath] -- ^ Templates to apply on every renderable.
- -> [a] -- ^ Renderables to render.
- -> Hakyll String
+renderAndConcat :: [FilePath] -- ^ Templates to apply on every renderable.
+ -> [RenderAction () Context] -- ^ Renderables to render.
+ -> RenderAction () String
renderAndConcat = renderAndConcatWith id
-- | Render each renderable with the given templates, then concatenate the
-- result. This function allows you to specify a @ContextManipulation@ to
-- apply on every @Renderable@.
-renderAndConcatWith :: Renderable a
- => ContextManipulation
+renderAndConcatWith :: ContextManipulation
-> [FilePath]
- -> [a]
- -> Hakyll String
-renderAndConcatWith manipulation templatePaths renderables = do
- templates <- mapM readTemplate templatePaths
- contexts <- mapM toContext renderables
- return $ pureRenderAndConcatWith manipulation templates contexts
+ -> [RenderAction () Context]
+ -> RenderAction () String
+renderAndConcatWith manipulation templatePaths renderables = RenderAction
+ { actionDependencies = renders >>= actionDependencies
+ , actionUrl = Nothing
+ , actionFunction = actionFunction'
+ }
+ where
+ render' = chain (map render templatePaths)
+ renders = map (>>> manipulationAction >>> render') renderables
+ manipulationAction = createManipulationAction manipulation
+
+ actionFunction' = \_ -> do
+ contexts <- mapM runRenderAction renders
+ return $ concatMap (fromMaybe "" . M.lookup "body") contexts
-- | Chain a render action for a page with a number of templates. This will
-- also write the result to the site destination. This is the preferred way
@@ -93,23 +103,24 @@ renderAndConcatWith manipulation templatePaths renderables = do
--
-- This code will first render @warning.html@ using @templates/notice.html@,
-- and will then render the result with @templates/default.html@.
-renderChain :: Renderable a => [FilePath] -> a -> Hakyll ()
+renderChain :: [FilePath] -> RenderAction () Context -> Hakyll ()
renderChain = renderChainWith id
-- | A more custom render chain that allows you to specify a
-- @ContextManipulation@ which to apply on the context when it is read first.
-renderChainWith :: Renderable a
- => ContextManipulation -> [FilePath] -> a -> Hakyll ()
-renderChainWith manipulation templatePaths renderable = do
- url <- getUrl renderable
- depends url dependencies render'
+renderChainWith :: ContextManipulation
+ -> [FilePath]
+ -> RenderAction () Context
+ -> Hakyll ()
+renderChainWith manipulation templatePaths initial =
+ runRenderAction renderChainWith'
where
- dependencies = getDependencies renderable ++ templatePaths
- render' = do
- templates <- mapM readTemplate templatePaths
- context <- toContext renderable
- let result = pureRenderChainWith manipulation templates context
- writePage $ fromContext result
+ renderChainWith' :: RenderAction () ()
+ renderChainWith' = initial >>> manipulationAction >>> chain' >>> writePage
+
+ chain' = chain (map render templatePaths)
+ manipulationAction = createManipulationAction manipulation
+
-- | Mark a certain file as static, so it will just be copied when the site is
-- generated.
diff --git a/src/Text/Hakyll/RenderAction.hs b/src/Text/Hakyll/RenderAction.hs
index a84ce46..26fa445 100644
--- a/src/Text/Hakyll/RenderAction.hs
+++ b/src/Text/Hakyll/RenderAction.hs
@@ -1,6 +1,10 @@
module Text.Hakyll.RenderAction
( RenderAction (..)
- , fromRenderable
+ , createRenderAction
+ , createSimpleRenderAction
+ , createManipulationAction
+ , chain
+ , runRenderAction
) where
import Prelude hiding ((.), id)
@@ -9,32 +13,42 @@ import Control.Monad ((<=<), mplus)
import Text.Hakyll.Hakyll
import Text.Hakyll.Context
-import Text.Hakyll.Renderable
data RenderAction a b = RenderAction
{ actionDependencies :: [FilePath]
- , actionDestination :: Maybe (Hakyll FilePath)
+ , actionUrl :: Maybe (Hakyll FilePath)
, actionFunction :: a -> Hakyll b
}
+createRenderAction :: (a -> Hakyll b) -> RenderAction a b
+createRenderAction f = RenderAction
+ { actionDependencies = []
+ , actionUrl = Nothing
+ , actionFunction = f
+ }
+
+createSimpleRenderAction :: Hakyll b -> RenderAction () b
+createSimpleRenderAction x = createRenderAction (const x)
+
instance Category RenderAction where
id = RenderAction
{ actionDependencies = []
- , actionDestination = Nothing
+ , actionUrl = Nothing
, actionFunction = return
}
x . y = RenderAction
{ actionDependencies = actionDependencies x ++ actionDependencies y
- , actionDestination = actionDestination y `mplus` actionDestination x
+ , actionUrl = actionUrl y `mplus` actionUrl x
, actionFunction = actionFunction x <=< actionFunction y
}
-fromRenderable :: (Renderable a)
- => a
- -> RenderAction () Context
-fromRenderable renderable = RenderAction
- { actionDependencies = getDependencies renderable
- , actionDestination = Just $ getUrl renderable
- , actionFunction = const $ toContext renderable
- }
+createManipulationAction :: ContextManipulation -> RenderAction Context Context
+createManipulationAction manipulation =
+ createRenderAction (return . manipulation)
+
+chain :: [RenderAction a a] -> RenderAction a a
+chain = foldl1 (>>>)
+
+runRenderAction :: RenderAction () a -> Hakyll a
+runRenderAction action = actionFunction action ()
diff --git a/src/Text/Hakyll/Renderable.hs b/src/Text/Hakyll/Renderable.hs
deleted file mode 100644
index 60e75ee..0000000
--- a/src/Text/Hakyll/Renderable.hs
+++ /dev/null
@@ -1,18 +0,0 @@
-module Text.Hakyll.Renderable
- ( Renderable(toContext, getDependencies, getUrl)
- ) where
-
-import Text.Hakyll.Hakyll (Hakyll)
-import Text.Hakyll.Context (Context)
-
--- | A class for datatypes that can be rendered to pages.
-class Renderable a where
- -- | Get a context to do substitutions with.
- toContext :: a -> Hakyll Context
-
- -- | Get the dependencies for the renderable. This is used for cache
- -- invalidation.
- getDependencies :: a -> [FilePath]
-
- -- | Get the destination for the renderable.
- getUrl :: a -> Hakyll FilePath
diff --git a/src/Text/Hakyll/Renderables.hs b/src/Text/Hakyll/Renderables.hs
index 42c05cc..37bd521 100644
--- a/src/Text/Hakyll/Renderables.hs
+++ b/src/Text/Hakyll/Renderables.hs
@@ -14,14 +14,11 @@ import Control.Arrow (second)
import Control.Monad (liftM2, mplus)
import Control.Applicative ((<$>))
-import Data.Binary
-import Text.Hakyll.Hakyll (Hakyll)
-import Text.Hakyll.Renderable
import Text.Hakyll.File
import Text.Hakyll.Context
-import Text.Hakyll.Render
import Text.Hakyll.RenderAction
+import Text.Hakyll.Render
import Text.Hakyll.Internal.Page
-- | Create a custom page.
@@ -33,16 +30,17 @@ import Text.Hakyll.Internal.Page
-- cases.
createCustomPage :: String
-> [FilePath]
- -> [(String, Either String (Hakyll String))]
+ -> [(String, Either String (RenderAction () String))]
-> RenderAction () Context
createCustomPage url dependencies association = RenderAction
{ actionDependencies = dependencies
- , actionDestination = Just $ return url
- , actionFunction = actionFunction'
+ , actionUrl = Just $ return url
+ , actionFunction = \_ -> M.fromList <$> assoc'
}
where
mtuple (a, b) = b >>= \b' -> return (a, b')
- actionFunction' () = M.fromList <$> mapM (mtuple . second (either return id)) association
+ toHakyllString = second (either return runRenderAction)
+ assoc' = mapM (mtuple . toHakyllString) association
-- | A @createCustomPage@ function specialized in creating listings.
--
@@ -57,10 +55,9 @@ createCustomPage url dependencies association = RenderAction
-- > -- render the items with.
-- > posts -- ^ Renderables to create the list with.
-- > [("title", "Home")] -- ^ Additional context
-createListing :: (Renderable a)
- => String -- ^ Destination of the page.
+createListing :: String -- ^ Destination of the page.
-> FilePath -- ^ Template to render all items with.
- -> [a] -- ^ Renderables in the list.
+ -> [RenderAction () Context] -- ^ Renderables in the list.
-> [(String, String)] -- ^ Additional context.
-> RenderAction () Context
createListing = createListingWith id
@@ -69,17 +66,16 @@ createListing = createListingWith id
--
-- In addition to @createListing@, this function allows you to specify an
-- extra @ContextManipulation@ for all @Renderable@s given.
-createListingWith :: (Renderable a)
- => ContextManipulation -- ^ Manipulation for the renderables.
+createListingWith :: ContextManipulation -- ^ Manipulation for the renderables.
-> String -- ^ Destination of the page.
-> FilePath -- ^ Template to render all items with.
- -> [a] -- ^ Renderables in the list.
+ -> [RenderAction () Context] -- ^ Renderables in the list.
-> [(String, String)] -- ^ Additional context.
-> RenderAction () Context
createListingWith manipulation url template renderables additional =
createCustomPage url dependencies context
where
- dependencies = template : concatMap getDependencies renderables
+ dependencies = template : concatMap actionDependencies renderables
context = ("body", Right concatenation) : additional'
concatenation = renderAndConcatWith manipulation [template] renderables
additional' = map (second Left) additional
@@ -93,7 +89,7 @@ newtype PagePath = PagePath FilePath
createPagePath :: FilePath -> RenderAction () Context
createPagePath path = RenderAction
{ actionDependencies = [path]
- , actionDestination = Just $ toUrl path
+ , actionUrl = Just $ toUrl path
, actionFunction = const (readPage path)
}
@@ -112,38 +108,21 @@ combine :: RenderAction () Context -> RenderAction () Context
-> RenderAction () Context
combine x y = RenderAction
{ actionDependencies = actionDependencies x ++ actionDependencies y
- , actionDestination = actionDestination x `mplus` actionDestination y
- , actionFunction = \_ -> liftM2 (M.union) (actionFunction x ()) (actionFunction y ())
+ , actionUrl = actionUrl x `mplus` actionUrl y
+ , actionFunction = \_ ->
+ liftM2 (M.union) (runRenderAction x) (runRenderAction 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 :: (Renderable a, Renderable b)
- => FilePath
- -> a
- -> b
- -> CombinedRenderable a b
-combineWithUrl = CombinedRenderableWithUrl
-
--- Render combinations.
-instance (Renderable a, Renderable b)
- => Renderable (CombinedRenderable a b) where
-
- -- Add the dependencies.
- getDependencies (CombinedRenderable a b) =
- getDependencies a ++ getDependencies b
- getDependencies (CombinedRenderableWithUrl _ a b) =
- getDependencies a ++ getDependencies b
-
- -- Take the url from the first renderable, or the specified URL.
- getUrl (CombinedRenderable a _) = getUrl a
- getUrl (CombinedRenderableWithUrl url _ _) = return url
-
- -- Take a union of the contexts.
- toContext (CombinedRenderable a b) = do
- c1 <- toContext a
- c2 <- toContext b
- return $ c1 `M.union` c2
- toContext (CombinedRenderableWithUrl url a b) = do
- c <- toContext (CombinedRenderable a b)
- return $ M.singleton "url" url `M.union` c
+combineWithUrl :: FilePath
+ -> RenderAction () Context
+ -> RenderAction () Context
+ -> RenderAction () Context
+combineWithUrl url x y = combine'
+ { actionUrl = Just $ return url
+ , actionFunction = \_ ->
+ (M.insert "url" url) <$> runRenderAction combine'
+ }
+ where
+ combine' = combine x y
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-09 16:00:22 +0000