summaryrefslogtreecommitdiff
path: root/src/Text/Hakyll
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Hakyll')
-rw-r--r--src/Text/Hakyll/File.hs8
-rw-r--r--src/Text/Hakyll/Hakyll.hs15
-rw-r--r--src/Text/Hakyll/Page.hs24
-rw-r--r--src/Text/Hakyll/Render.hs44
-rw-r--r--src/Text/Hakyll/Render/Internal.hs15
-rw-r--r--src/Text/Hakyll/Renderable.hs3
-rw-r--r--src/Text/Hakyll/Renderables.hs6
-rw-r--r--src/Text/Hakyll/Tags.hs3
8 files changed, 75 insertions, 43 deletions
diff --git a/src/Text/Hakyll/File.hs b/src/Text/Hakyll/File.hs
index 0ed91d5..3dd2538 100644
--- a/src/Text/Hakyll/File.hs
+++ b/src/Text/Hakyll/File.hs
@@ -17,6 +17,8 @@ import System.Directory
import System.FilePath
import Control.Monad
import Data.List (isPrefixOf)
+import Text.Hakyll.Hakyll (Hakyll)
+import Control.Monad.Reader (liftIO)
-- | Auxiliary function to remove pathSeparators form the start. We don't deal
-- with absolute paths here. We also remove $root from the start.
@@ -90,8 +92,10 @@ havingExtension :: String -> [FilePath] -> [FilePath]
havingExtension extension = filter ((==) extension . takeExtension)
-- | Perform an IO action on every file in a given directory.
-directory :: (FilePath -> IO ()) -> FilePath -> IO ()
-directory action dir = getRecursiveContents dir >>= mapM_ action
+directory :: (FilePath -> Hakyll ()) -> FilePath -> Hakyll ()
+directory action dir = do
+ contents <- liftIO $ getRecursiveContents dir
+ mapM_ action contents
-- | Check if a cache file is still valid.
isCacheValid :: FilePath -> [FilePath] -> IO Bool
diff --git a/src/Text/Hakyll/Hakyll.hs b/src/Text/Hakyll/Hakyll.hs
new file mode 100644
index 0000000..3690914
--- /dev/null
+++ b/src/Text/Hakyll/Hakyll.hs
@@ -0,0 +1,15 @@
+module Text.Hakyll.Hakyll
+ ( HakyllConfiguration (..)
+ , Hakyll
+ ) where
+
+import Text.Hakyll.Context (Context)
+import System.FilePath (FilePath)
+import Control.Monad.Reader (ReaderT)
+
+data HakyllConfiguration = HakyllConfiguration
+ { hakyllDestination :: FilePath
+ , hakyllGlobalContext :: Context
+ }
+
+type Hakyll = ReaderT HakyllConfiguration IO
diff --git a/src/Text/Hakyll/Page.hs b/src/Text/Hakyll/Page.hs
index 0b7776b..cbb881f 100644
--- a/src/Text/Hakyll/Page.hs
+++ b/src/Text/Hakyll/Page.hs
@@ -11,10 +11,12 @@ import qualified Data.List as L
import Data.Maybe (fromMaybe)
import Control.Parallel.Strategies (rnf, ($|))
+import Control.Monad.Reader (liftIO)
import System.FilePath (FilePath, takeExtension)
import System.IO
+import Text.Hakyll.Hakyll (Hakyll)
import Text.Hakyll.File
import Text.Hakyll.Util (trim)
import Text.Hakyll.Context (Context)
@@ -66,9 +68,9 @@ renderFunction ext = writeHtmlString writerOptions
readFunction _ = readMarkdown
-- | Read metadata header from a file handle.
-readMetaData :: Handle -> IO [(String, String)]
+readMetaData :: Handle -> Hakyll [(String, String)]
readMetaData handle = do
- line <- hGetLine handle
+ line <- liftIO $ hGetLine handle
if isDelimiter line
then return []
else do others <- readMetaData handle
@@ -81,8 +83,8 @@ isDelimiter :: String -> Bool
isDelimiter = L.isPrefixOf "---"
-- | Used for caching of files.
-cachePage :: Page -> IO ()
-cachePage page@(Page mapping) = do
+cachePage :: Page -> Hakyll ()
+cachePage page@(Page mapping) = liftIO $ do
let destination = toCache $ getURL page
makeDirectories destination
handle <- openFile destination WriteMode
@@ -98,21 +100,21 @@ cachePage page@(Page mapping) = do
-- | Read a page from a file. Metadata is supported, and if the filename
-- has a .markdown extension, it will be rendered using pandoc. Note that
-- pages are not templates, so they should not contain $identifiers.
-readPage :: FilePath -> IO Page
+readPage :: FilePath -> Hakyll Page
readPage pagePath = do
-- Check cache.
- getFromCache <- isCacheValid cacheFile [pagePath]
+ getFromCache <- liftIO $ isCacheValid cacheFile [pagePath]
let path = if getFromCache then cacheFile else pagePath
-- Read file.
- handle <- openFile path ReadMode
- line <- hGetLine handle
+ handle <- liftIO $ openFile path ReadMode
+ line <- liftIO $ hGetLine handle
(metaData, body) <-
if isDelimiter line
then do md <- readMetaData handle
- b <- hGetContents handle
+ b <- liftIO $ hGetContents handle
return (md, b)
- else do b <- hGetContents handle
+ else do b <- liftIO $ hGetContents handle
return ([], line ++ "\n" ++ b)
-- Render file
@@ -123,7 +125,7 @@ readPage pagePath = do
, ("path", pagePath)
] ++ metaData
- seq (($|) id rnf rendered) $ hClose handle
+ seq (($|) id rnf rendered) $ liftIO $ hClose handle
-- Cache if needed
if getFromCache then return () else cachePage page
diff --git a/src/Text/Hakyll/Render.hs b/src/Text/Hakyll/Render.hs
index d8deea2..4b22836 100644
--- a/src/Text/Hakyll/Render.hs
+++ b/src/Text/Hakyll/Render.hs
@@ -11,10 +11,12 @@ module Text.Hakyll.Render
) where
import Control.Monad (unless, mapM)
+import Control.Monad.Reader (liftIO)
import System.Directory (copyFile)
import System.IO
+import Text.Hakyll.Hakyll (Hakyll)
import Text.Hakyll.Context (ContextManipulation)
import Text.Hakyll.Page
import Text.Hakyll.Renderable
@@ -26,17 +28,17 @@ import Text.Hakyll.Render.Internal
-- | Execute an IO action only when the cache is invalid.
depends :: FilePath -- ^ File to be rendered or created.
-> [FilePath] -- ^ Files the render depends on.
- -> IO () -- ^ IO action to execute when the file is out of date.
- -> IO ()
+ -> Hakyll () -- ^ IO action to execute when the file is out of date.
+ -> Hakyll ()
depends file dependencies action = do
- valid <- isCacheValid (toDestination file) dependencies
+ valid <- liftIO $ isCacheValid (toDestination file) dependencies
unless valid action
-- | Render to a Page.
render :: Renderable a
=> FilePath -- ^ Template to use for rendering.
-> a -- ^ Renderable object to render with given template.
- -> IO Page -- ^ The body of the result will contain the render.
+ -> Hakyll Page -- ^ The body of the result will contain the render.
render = renderWith id
-- | Render to a Page. This function allows you to manipulate the context
@@ -45,15 +47,15 @@ renderWith :: Renderable a
=> ContextManipulation -- ^ Manipulation to apply on the context.
-> FilePath -- ^ Template to use for rendering.
-> a -- ^ Renderable object to render with given template.
- -> IO Page -- ^ The body of the result will contain the render.
+ -> Hakyll Page -- ^ The body of the result will contain the render.
renderWith manipulation templatePath renderable = do
- template <- readFile templatePath
+ template <- liftIO $ readFile templatePath
context <- toContext renderable
return $ fromContext $ pureRenderWith manipulation template context
-- | Render each renderable with the given template, then concatenate the
-- result.
-renderAndConcat :: Renderable a => FilePath -> [a] -> IO String
+renderAndConcat :: Renderable a => FilePath -> [a] -> Hakyll String
renderAndConcat = renderAndConcatWith id
-- | Render each renderable with the given template, then concatenate the
@@ -63,41 +65,43 @@ renderAndConcatWith :: Renderable a
=> ContextManipulation
-> FilePath
-> [a]
- -> IO String
+ -> Hakyll String
renderAndConcatWith manipulation templatePath renderables = do
- template <- readFile templatePath
+ template <- liftIO $ readFile templatePath
contexts <- mapM toContext renderables
return $ pureRenderAndConcatWith manipulation template 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
-- to do general rendering.
-renderChain :: Renderable a => [FilePath] -> a -> IO ()
+renderChain :: Renderable a => [FilePath] -> a -> 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 -> IO ()
+ => ContextManipulation -> [FilePath] -> a -> Hakyll ()
renderChainWith manipulation templatePaths renderable =
- depends (getURL renderable) (getDependencies renderable ++ templatePaths) $
- do templates <- mapM readFile templatePaths
- context <- toContext renderable
- let result = pureRenderChainWith manipulation templates context
- writePage $ fromContext result
+ depends (getURL renderable) dependencies render'
+ where
+ dependencies = (getDependencies renderable) ++ templatePaths
+ render' = do templates <- liftIO $ mapM readFile templatePaths
+ context <- toContext renderable
+ let result = pureRenderChainWith manipulation templates context
+ writePage $ fromContext result
-- | Mark a certain file as static, so it will just be copied when the site is
-- generated.
-static :: FilePath -> IO ()
-static source = depends destination [source] action
+static :: FilePath -> Hakyll ()
+static source = depends destination [source] (liftIO action)
where
destination = toDestination source
action = do makeDirectories destination
copyFile source destination
-- | Render a css file, compressing it.
-css :: FilePath -> IO ()
-css source = depends destination [source] css'
+css :: FilePath -> Hakyll ()
+css source = depends destination [source] (liftIO css')
where
destination = toDestination source
css' = do contents <- readFile source
diff --git a/src/Text/Hakyll/Render/Internal.hs b/src/Text/Hakyll/Render/Internal.hs
index 3b9bfbb..379c4c9 100644
--- a/src/Text/Hakyll/Render/Internal.hs
+++ b/src/Text/Hakyll/Render/Internal.hs
@@ -11,6 +11,8 @@ module Text.Hakyll.Render.Internal
import qualified Data.Map as M
import Text.Hakyll.Context (Context, ContextManipulation)
+import Control.Monad.Reader (ask, liftIO)
+import Control.Monad (liftM)
import Data.List (isPrefixOf, foldl')
import Data.Char (isAlpha)
import Data.Maybe (fromMaybe)
@@ -18,6 +20,7 @@ import Control.Parallel.Strategies (rnf, ($|))
import Text.Hakyll.Renderable
import Text.Hakyll.Page
import Text.Hakyll.File
+import Text.Hakyll.Hakyll (Hakyll, hakyllGlobalContext)
-- | Substitutes `$identifiers` in the given string by values from the given
-- "Context". When a key is not found, it is left as it is. You can here
@@ -79,13 +82,13 @@ pureRenderChainWith manipulation templates context =
-- | Write a page to the site destination. Final action after render
-- chains and such.
-writePage :: Page -> IO ()
+writePage :: Page -> Hakyll ()
writePage page = do
+ globalContext <- liftM hakyllGlobalContext ask
let destination = toDestination url
- makeDirectories destination
- writeFile destination body
+ context = (M.singleton "root" $ toRoot url) `M.union` globalContext
+ liftIO $ makeDirectories destination
+    -- Substitute $root here, just before writing.
+ liftIO $ writeFile destination $ finalSubstitute (getBody page) context
where
url = getURL page
-    -- Substitute $root here, just before writing.
-    body = finalSubstitute (getBody page)
-                           (M.singleton "root" $ toRoot url)
diff --git a/src/Text/Hakyll/Renderable.hs b/src/Text/Hakyll/Renderable.hs
index c8e780e..cafdb3c 100644
--- a/src/Text/Hakyll/Renderable.hs
+++ b/src/Text/Hakyll/Renderable.hs
@@ -2,13 +2,14 @@ module Text.Hakyll.Renderable
( Renderable(toContext, getDependencies, getURL)
) where
+import Text.Hakyll.Hakyll (Hakyll)
import System.FilePath (FilePath)
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 -> IO Context
+ toContext :: a -> Hakyll Context
-- | Get the dependencies for the renderable. This is used for cache
-- invalidation.
diff --git a/src/Text/Hakyll/Renderables.hs b/src/Text/Hakyll/Renderables.hs
index 26d1e86..19f25b5 100644
--- a/src/Text/Hakyll/Renderables.hs
+++ b/src/Text/Hakyll/Renderables.hs
@@ -5,6 +5,7 @@ module Text.Hakyll.Renderables
, createPagePath
) where
+import Text.Hakyll.Hakyll (Hakyll)
import System.FilePath (FilePath)
import qualified Data.Map as M
import Text.Hakyll.Page
@@ -15,13 +16,14 @@ import Text.Hakyll.File
data CustomPage = CustomPage
{ url :: String,
dependencies :: [FilePath],
- mapping :: [(String, Either String (IO String))]
+ mapping :: [(String, Either String (Hakyll String))]
}
-- | Create a custom page.
createCustomPage :: String -- ^ Destination of the page, relative to _site.
-> [FilePath] -- ^ Dependencies of the page.
- -> [(String, Either String (IO String))] -- ^ Key - value mapping for rendering.
+ -> [(String, Either String (Hakyll String))] -- ^ Key - value
+ -- mapping.
-> CustomPage
createCustomPage = CustomPage
diff --git a/src/Text/Hakyll/Tags.hs b/src/Text/Hakyll/Tags.hs
index 625584e..209d479 100644
--- a/src/Text/Hakyll/Tags.hs
+++ b/src/Text/Hakyll/Tags.hs
@@ -9,6 +9,7 @@ module Text.Hakyll.Tags
import qualified Data.Map as M
import Data.List (intercalate)
import Control.Monad (foldM)
+import Text.Hakyll.Hakyll (Hakyll)
import Text.Hakyll.Context (ContextManipulation, renderValue)
import Text.Hakyll.Regex
@@ -19,7 +20,7 @@ import Control.Arrow (second)
-- | Read a tag map. This creates a map from tags to page paths. This function
-- assumes the tags are located in the `tags` metadata field, separated by
-- commas.
-readTagMap :: [FilePath] -> IO (M.Map String [FilePath])
+readTagMap :: [FilePath] -> Hakyll (M.Map String [FilePath])
readTagMap paths = foldM addPaths M.empty paths
where
addPaths current path = do
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-09 04:32:18 +0000