git.iko.soy/hakyll
on master help sign in
Added ReaderT to our stack.
4bc34b8Jasper Van der Jeugt
examples/brochure/hakyll.hs+2−2
compare with master
unifiedsplit
@@ -1,9 +1,9 @@
1−import Text.Hakyll (hakyll)
1+import Text.Hakyll (hakyll, defaultHakyllConfiguration)
2import Text.Hakyll.File (directory)
2import Text.Hakyll.File (directory)
3import Text.Hakyll.Render (css, static, renderChain)
3import Text.Hakyll.Render (css, static, renderChain)
4import Text.Hakyll.Renderables (createPagePath)
4import Text.Hakyll.Renderables (createPagePath)
5
5
6−main = hakyll $ do
6+main = hakyll defaultHakyllConfiguration $ do
7 directory css "css"
7 directory css "css"
8 render "about.markdown"
8 render "about.markdown"
9 render "index.markdown"
9 render "index.markdown"
hakyll.cabal+1
@@ -36,6 +36,7 @@ library
36 time >= 1,
36 time >= 1,
37 parallel >= 1
37 parallel >= 1
38 exposed-modules: Text.Hakyll
38 exposed-modules: Text.Hakyll
39+ Text.Hakyll.Hakyll
39 Text.Hakyll.Render
40 Text.Hakyll.Render
40 Text.Hakyll.Renderable
41 Text.Hakyll.Renderable
41 Text.Hakyll.Renderables
42 Text.Hakyll.Renderables
src/Text/Hakyll.hs+23−9
@@ -1,28 +1,42 @@
1module Text.Hakyll
1module Text.Hakyll
2+ ( defaultHakyllConfiguration
2− ( hakyll
3+ , hakyll
3 ) where
4 ) where
4
5
6+import Control.Monad.Reader (runReaderT)
7+import qualified Data.Map as M
8+
5import Network.Hakyll.SimpleServer (simpleServer)
9import Network.Hakyll.SimpleServer (simpleServer)
10+import Text.Hakyll.Hakyll
6
11
7import System.Environment (getArgs, getProgName)
12import System.Environment (getArgs, getProgName)
8import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
13import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
9
14
15+-- | Default hakyll configuration.
16+defaultHakyllConfiguration :: HakyllConfiguration
17+defaultHakyllConfiguration = HakyllConfiguration
18+ { hakyllDestination = "_site"
19+ , hakyllGlobalContext = M.empty
20+ }
21+
10-- | Main function to run hakyll.
22-- | Main function to run hakyll.
11−hakyll :: IO () -> IO ()
23+hakyll :: HakyllConfiguration -> Hakyll () -> IO ()
12−hakyll buildFunction = do
24+hakyll configuration buildFunction = do
13 args <- getArgs
25 args <- getArgs
14− case args of ["build"] -> build buildFunction
26+ case args of ["build"] -> build'
15 ["clean"] -> clean
27 ["clean"] -> clean
16− ["preview", p] -> build buildFunction >> server (read p)
28+ ["preview", p] -> build' >> server (read p)
17− ["preview"] -> build buildFunction >> server 8000
29+ ["preview"] -> build' >> server 8000
18 ["server", p] -> server (read p)
30 ["server", p] -> server (read p)
19 ["server"] -> server 8000
31 ["server"] -> server 8000
20 _ -> help
32 _ -> help
33+ where
34+ build' = build configuration buildFunction
21
35
22-- | Build the site.
36-- | Build the site.
23−build :: IO () -> IO ()
37+build :: HakyllConfiguration -> Hakyll () -> IO ()
24−build buildFunction = do putStrLn "Generating..."
38+build configuration buildFunction = do putStrLn "Generating..."
25− buildFunction
39+ runReaderT buildFunction configuration
26
40
27-- | Clean up directories.
41-- | Clean up directories.
28clean :: IO ()
42clean :: IO ()
src/Text/Hakyll/File.hs+6−2
@@ -17,6 +17,8 @@ import System.Directory
17import System.FilePath
17import System.FilePath
18import Control.Monad
18import Control.Monad
19import Data.List (isPrefixOf)
19import Data.List (isPrefixOf)
20+import Text.Hakyll.Hakyll (Hakyll)
21+import Control.Monad.Reader (liftIO)
20
22
21-- | Auxiliary function to remove pathSeparators form the start. We don't deal
23-- | Auxiliary function to remove pathSeparators form the start. We don't deal
22-- with absolute paths here. We also remove $root from the start.
24-- with absolute paths here. We also remove $root from the start.
@@ -90,8 +92,10 @@ havingExtension :: String -> [FilePath] -> [FilePath]
90havingExtension extension = filter ((==) extension . takeExtension)
92havingExtension extension = filter ((==) extension . takeExtension)
91
93
92-- | Perform an IO action on every file in a given directory.
94-- | Perform an IO action on every file in a given directory.
93−directory :: (FilePath -> IO ()) -> FilePath -> IO ()
95+directory :: (FilePath -> Hakyll ()) -> FilePath -> Hakyll ()
96+directory action dir = do
94−directory action dir = getRecursiveContents dir >>= mapM_ action
97+ contents <- liftIO $ getRecursiveContents dir
98+ mapM_ action contents
95
99
96-- | Check if a cache file is still valid.
100-- | Check if a cache file is still valid.
97isCacheValid :: FilePath -> [FilePath] -> IO Bool
101isCacheValid :: FilePath -> [FilePath] -> IO Bool
src/Text/Hakyll/Hakyll.hsnew file+15
@@ -0,0 +1,15 @@
1+module Text.Hakyll.Hakyll
2+ ( HakyllConfiguration (..)
3+ , Hakyll
4+ ) where
5+
6+import Text.Hakyll.Context (Context)
7+import System.FilePath (FilePath)
8+import Control.Monad.Reader (ReaderT)
9+
10+data HakyllConfiguration = HakyllConfiguration
11+ { hakyllDestination :: FilePath
12+ , hakyllGlobalContext :: Context
13+ }
14+
15+type Hakyll = ReaderT HakyllConfiguration IO
src/Text/Hakyll/Page.hs+13−11
@@ -11,10 +11,12 @@ import qualified Data.List as L
11import Data.Maybe (fromMaybe)
11import Data.Maybe (fromMaybe)
12
12
13import Control.Parallel.Strategies (rnf, ($|))
13import Control.Parallel.Strategies (rnf, ($|))
14+import Control.Monad.Reader (liftIO)
14
15
15import System.FilePath (FilePath, takeExtension)
16import System.FilePath (FilePath, takeExtension)
16import System.IO
17import System.IO
17
18
19+import Text.Hakyll.Hakyll (Hakyll)
18import Text.Hakyll.File
20import Text.Hakyll.File
19import Text.Hakyll.Util (trim)
21import Text.Hakyll.Util (trim)
20import Text.Hakyll.Context (Context)
22import Text.Hakyll.Context (Context)
@@ -66,9 +68,9 @@ renderFunction ext = writeHtmlString writerOptions
66 readFunction _ = readMarkdown
68 readFunction _ = readMarkdown
67
69
68-- | Read metadata header from a file handle.
70-- | Read metadata header from a file handle.
69−readMetaData :: Handle -> IO [(String, String)]
71+readMetaData :: Handle -> Hakyll [(String, String)]
70readMetaData handle = do
72readMetaData handle = do
71− line <- hGetLine handle
73+ line <- liftIO $ hGetLine handle
72 if isDelimiter line
74 if isDelimiter line
73 then return []
75 then return []
74 else do others <- readMetaData handle
76 else do others <- readMetaData handle
@@ -81,8 +83,8 @@ isDelimiter :: String -> Bool
81isDelimiter = L.isPrefixOf "---"
83isDelimiter = L.isPrefixOf "---"
82
84
83-- | Used for caching of files.
85-- | Used for caching of files.
84−cachePage :: Page -> IO ()
86+cachePage :: Page -> Hakyll ()
85−cachePage page@(Page mapping) = do
87+cachePage page@(Page mapping) = liftIO $ do
86 let destination = toCache $ getURL page
88 let destination = toCache $ getURL page
87 makeDirectories destination
89 makeDirectories destination
88 handle <- openFile destination WriteMode
90 handle <- openFile destination WriteMode
@@ -98,21 +100,21 @@ cachePage page@(Page mapping) = do
98-- | Read a page from a file. Metadata is supported, and if the filename
100-- | Read a page from a file. Metadata is supported, and if the filename
99-- has a .markdown extension, it will be rendered using pandoc. Note that
101-- has a .markdown extension, it will be rendered using pandoc. Note that
100-- pages are not templates, so they should not contain $identifiers.
102-- pages are not templates, so they should not contain $identifiers.
101−readPage :: FilePath -> IO Page
103+readPage :: FilePath -> Hakyll Page
102readPage pagePath = do
104readPage pagePath = do
103 -- Check cache.
105 -- Check cache.
104− getFromCache <- isCacheValid cacheFile [pagePath]
106+ getFromCache <- liftIO $ isCacheValid cacheFile [pagePath]
105 let path = if getFromCache then cacheFile else pagePath
107 let path = if getFromCache then cacheFile else pagePath
106
108
107 -- Read file.
109 -- Read file.
108− handle <- openFile path ReadMode
110+ handle <- liftIO $ openFile path ReadMode
109− line <- hGetLine handle
111+ line <- liftIO $ hGetLine handle
110 (metaData, body) <-
112 (metaData, body) <-
111 if isDelimiter line
113 if isDelimiter line
112 then do md <- readMetaData handle
114 then do md <- readMetaData handle
113− b <- hGetContents handle
115+ b <- liftIO $ hGetContents handle
114 return (md, b)
116 return (md, b)
115− else do b <- hGetContents handle
117+ else do b <- liftIO $ hGetContents handle
116 return ([], line ++ "\n" ++ b)
118 return ([], line ++ "\n" ++ b)
117
119
118 -- Render file
120 -- Render file
@@ -123,7 +125,7 @@ readPage pagePath = do
123 , ("path", pagePath)
125 , ("path", pagePath)
124 ] ++ metaData
126 ] ++ metaData
125
127
126− seq (($|) id rnf rendered) $ hClose handle
128+ seq (($|) id rnf rendered) $ liftIO $ hClose handle
127
129
128 -- Cache if needed
130 -- Cache if needed
129 if getFromCache then return () else cachePage page
131 if getFromCache then return () else cachePage page
src/Text/Hakyll/Render.hs+24−20
@@ -11,10 +11,12 @@ module Text.Hakyll.Render
11 ) where
11 ) where
12
12
13import Control.Monad (unless, mapM)
13import Control.Monad (unless, mapM)
14+import Control.Monad.Reader (liftIO)
14
15
15import System.Directory (copyFile)
16import System.Directory (copyFile)
16import System.IO
17import System.IO
17
18
19+import Text.Hakyll.Hakyll (Hakyll)
18import Text.Hakyll.Context (ContextManipulation)
20import Text.Hakyll.Context (ContextManipulation)
19import Text.Hakyll.Page
21import Text.Hakyll.Page
20import Text.Hakyll.Renderable
22import Text.Hakyll.Renderable
@@ -26,17 +28,17 @@ import Text.Hakyll.Render.Internal
26-- | Execute an IO action only when the cache is invalid.
28-- | Execute an IO action only when the cache is invalid.
27depends :: FilePath -- ^ File to be rendered or created.
29depends :: FilePath -- ^ File to be rendered or created.
28 -> [FilePath] -- ^ Files the render depends on.
30 -> [FilePath] -- ^ Files the render depends on.
29− -> IO () -- ^ IO action to execute when the file is out of date.
31+ -> Hakyll () -- ^ IO action to execute when the file is out of date.
30− -> IO ()
32+ -> Hakyll ()
31depends file dependencies action = do
33depends file dependencies action = do
32− valid <- isCacheValid (toDestination file) dependencies
34+ valid <- liftIO $ isCacheValid (toDestination file) dependencies
33 unless valid action
35 unless valid action
34
36
35-- | Render to a Page.
37-- | Render to a Page.
36render :: Renderable a
38render :: Renderable a
37 => FilePath -- ^ Template to use for rendering.
39 => FilePath -- ^ Template to use for rendering.
38 -> a -- ^ Renderable object to render with given template.
40 -> a -- ^ Renderable object to render with given template.
39− -> IO Page -- ^ The body of the result will contain the render.
41+ -> Hakyll Page -- ^ The body of the result will contain the render.
40render = renderWith id
42render = renderWith id
41
43
42-- | Render to a Page. This function allows you to manipulate the context
44-- | Render to a Page. This function allows you to manipulate the context
@@ -45,15 +47,15 @@ renderWith :: Renderable a
45 => ContextManipulation -- ^ Manipulation to apply on the context.
47 => ContextManipulation -- ^ Manipulation to apply on the context.
46 -> FilePath -- ^ Template to use for rendering.
48 -> FilePath -- ^ Template to use for rendering.
47 -> a -- ^ Renderable object to render with given template.
49 -> a -- ^ Renderable object to render with given template.
48− -> IO Page -- ^ The body of the result will contain the render.
50+ -> Hakyll Page -- ^ The body of the result will contain the render.
49renderWith manipulation templatePath renderable = do
51renderWith manipulation templatePath renderable = do
50− template <- readFile templatePath
52+ template <- liftIO $ readFile templatePath
51 context <- toContext renderable
53 context <- toContext renderable
52 return $ fromContext $ pureRenderWith manipulation template context
54 return $ fromContext $ pureRenderWith manipulation template context
53
55
54-- | Render each renderable with the given template, then concatenate the
56-- | Render each renderable with the given template, then concatenate the
55-- result.
57-- result.
56−renderAndConcat :: Renderable a => FilePath -> [a] -> IO String
58+renderAndConcat :: Renderable a => FilePath -> [a] -> Hakyll String
57renderAndConcat = renderAndConcatWith id
59renderAndConcat = renderAndConcatWith id
58
60
59-- | Render each renderable with the given template, then concatenate the
61-- | Render each renderable with the given template, then concatenate the
@@ -63,41 +65,43 @@ renderAndConcatWith :: Renderable a
63 => ContextManipulation
65 => ContextManipulation
64 -> FilePath
66 -> FilePath
65 -> [a]
67 -> [a]
66− -> IO String
68+ -> Hakyll String
67renderAndConcatWith manipulation templatePath renderables = do
69renderAndConcatWith manipulation templatePath renderables = do
68− template <- readFile templatePath
70+ template <- liftIO $ readFile templatePath
69 contexts <- mapM toContext renderables
71 contexts <- mapM toContext renderables
70 return $ pureRenderAndConcatWith manipulation template contexts
72 return $ pureRenderAndConcatWith manipulation template contexts
71
73
72-- | Chain a render action for a page with a number of templates. This will
74-- | Chain a render action for a page with a number of templates. This will
73-- also write the result to the site destination. This is the preferred way
75-- also write the result to the site destination. This is the preferred way
74-- to do general rendering.
76-- to do general rendering.
75−renderChain :: Renderable a => [FilePath] -> a -> IO ()
77+renderChain :: Renderable a => [FilePath] -> a -> Hakyll ()
76renderChain = renderChainWith id
78renderChain = renderChainWith id
77
79
78-- | A more custom render chain that allows you to specify a
80-- | A more custom render chain that allows you to specify a
79-- "ContextManipulation" which to apply on the context when it is read first.
81-- "ContextManipulation" which to apply on the context when it is read first.
80renderChainWith :: Renderable a
82renderChainWith :: Renderable a
81− => ContextManipulation -> [FilePath] -> a -> IO ()
83+ => ContextManipulation -> [FilePath] -> a -> Hakyll ()
82renderChainWith manipulation templatePaths renderable =
84renderChainWith manipulation templatePaths renderable =
85+ depends (getURL renderable) dependencies render'
86+ where
83− depends (getURL renderable) (getDependencies renderable ++ templatePaths) $
87+ dependencies = (getDependencies renderable) ++ templatePaths
84− do templates <- mapM readFile templatePaths
88+ render' = do templates <- liftIO $ mapM readFile templatePaths
85− context <- toContext renderable
89+ context <- toContext renderable
86− let result = pureRenderChainWith manipulation templates context
90+ let result = pureRenderChainWith manipulation templates context
87− writePage $ fromContext result
91+ writePage $ fromContext result
88
92
89-- | Mark a certain file as static, so it will just be copied when the site is
93-- | Mark a certain file as static, so it will just be copied when the site is
90-- generated.
94-- generated.
91−static :: FilePath -> IO ()
95+static :: FilePath -> Hakyll ()
92−static source = depends destination [source] action
96+static source = depends destination [source] (liftIO action)
93 where
97 where
94 destination = toDestination source
98 destination = toDestination source
95 action = do makeDirectories destination
99 action = do makeDirectories destination
96 copyFile source destination
100 copyFile source destination
97
101
98-- | Render a css file, compressing it.
102-- | Render a css file, compressing it.
99−css :: FilePath -> IO ()
103+css :: FilePath -> Hakyll ()
100−css source = depends destination [source] css'
104+css source = depends destination [source] (liftIO css')
101 where
105 where
102 destination = toDestination source
106 destination = toDestination source
103 css' = do contents <- readFile source
107 css' = do contents <- readFile source
src/Text/Hakyll/Render/Internal.hs+9−6
@@ -11,6 +11,8 @@ module Text.Hakyll.Render.Internal
11
11
12import qualified Data.Map as M
12import qualified Data.Map as M
13import Text.Hakyll.Context (Context, ContextManipulation)
13import Text.Hakyll.Context (Context, ContextManipulation)
14+import Control.Monad.Reader (ask, liftIO)
15+import Control.Monad (liftM)
14import Data.List (isPrefixOf, foldl')
16import Data.List (isPrefixOf, foldl')
15import Data.Char (isAlpha)
17import Data.Char (isAlpha)
16import Data.Maybe (fromMaybe)
18import Data.Maybe (fromMaybe)
@@ -18,6 +20,7 @@ import Control.Parallel.Strategies (rnf, ($|))
18import Text.Hakyll.Renderable
20import Text.Hakyll.Renderable
19import Text.Hakyll.Page
21import Text.Hakyll.Page
20import Text.Hakyll.File
22import Text.Hakyll.File
23+import Text.Hakyll.Hakyll (Hakyll, hakyllGlobalContext)
21
24
22-- | Substitutes `$identifiers` in the given string by values from the given
25-- | Substitutes `$identifiers` in the given string by values from the given
23-- "Context". When a key is not found, it is left as it is. You can here
26-- "Context". When a key is not found, it is left as it is. You can here
@@ -79,13 +82,13 @@ pureRenderChainWith manipulation templates context =
79
82
80-- | Write a page to the site destination. Final action after render
83-- | Write a page to the site destination. Final action after render
81-- chains and such.
84-- chains and such.
82−writePage :: Page -> IO ()
85+writePage :: Page -> Hakyll ()
83writePage page = do
86writePage page = do
87+ globalContext <- liftM hakyllGlobalContext ask
84 let destination = toDestination url
88 let destination = toDestination url
89+ context = (M.singleton "root" $ toRoot url) `M.union` globalContext
85− makeDirectories destination
90+ liftIO $ makeDirectories destination
91+    -- Substitute $root here, just before writing.
86− writeFile destination body
92+ liftIO $ writeFile destination $ finalSubstitute (getBody page) context
87 where
93 where
88 url = getURL page
94 url = getURL page
89−    -- Substitute $root here, just before writing.
90−    body = finalSubstitute (getBody page)
91−                           (M.singleton "root" $ toRoot url)
src/Text/Hakyll/Renderable.hs+2−1
@@ -2,13 +2,14 @@ module Text.Hakyll.Renderable
2 ( Renderable(toContext, getDependencies, getURL)
2 ( Renderable(toContext, getDependencies, getURL)
3 ) where
3 ) where
4
4
5+import Text.Hakyll.Hakyll (Hakyll)
5import System.FilePath (FilePath)
6import System.FilePath (FilePath)
6import Text.Hakyll.Context (Context)
7import Text.Hakyll.Context (Context)
7
8
8-- | A class for datatypes that can be rendered to pages.
9-- | A class for datatypes that can be rendered to pages.
9class Renderable a where
10class Renderable a where
10 -- | Get a context to do substitutions with.
11 -- | Get a context to do substitutions with.
11− toContext :: a -> IO Context
12+ toContext :: a -> Hakyll Context
12
13
13 -- | Get the dependencies for the renderable. This is used for cache
14 -- | Get the dependencies for the renderable. This is used for cache
14 -- invalidation.
15 -- invalidation.
src/Text/Hakyll/Renderables.hs+4−2
@@ -5,6 +5,7 @@ module Text.Hakyll.Renderables
5 , createPagePath
5 , createPagePath
6 ) where
6 ) where
7
7
8+import Text.Hakyll.Hakyll (Hakyll)
8import System.FilePath (FilePath)
9import System.FilePath (FilePath)
9import qualified Data.Map as M
10import qualified Data.Map as M
10import Text.Hakyll.Page
11import Text.Hakyll.Page
@@ -15,13 +16,14 @@ import Text.Hakyll.File
15data CustomPage = CustomPage
16data CustomPage = CustomPage
16 { url :: String,
17 { url :: String,
17 dependencies :: [FilePath],
18 dependencies :: [FilePath],
18− mapping :: [(String, Either String (IO String))]
19+ mapping :: [(String, Either String (Hakyll String))]
19 }
20 }
20
21
21-- | Create a custom page.
22-- | Create a custom page.
22createCustomPage :: String -- ^ Destination of the page, relative to _site.
23createCustomPage :: String -- ^ Destination of the page, relative to _site.
23 -> [FilePath] -- ^ Dependencies of the page.
24 -> [FilePath] -- ^ Dependencies of the page.
24− -> [(String, Either String (IO String))] -- ^ Key - value mapping for rendering.
25+ -> [(String, Either String (Hakyll String))] -- ^ Key - value
26+ -- mapping.
25 -> CustomPage
27 -> CustomPage
26createCustomPage = CustomPage
28createCustomPage = CustomPage
27
29
src/Text/Hakyll/Tags.hs+2−1
@@ -9,6 +9,7 @@ module Text.Hakyll.Tags
9import qualified Data.Map as M
9import qualified Data.Map as M
10import Data.List (intercalate)
10import Data.List (intercalate)
11import Control.Monad (foldM)
11import Control.Monad (foldM)
12+import Text.Hakyll.Hakyll (Hakyll)
12
13
13import Text.Hakyll.Context (ContextManipulation, renderValue)
14import Text.Hakyll.Context (ContextManipulation, renderValue)
14import Text.Hakyll.Regex
15import Text.Hakyll.Regex
@@ -19,7 +20,7 @@ import Control.Arrow (second)
19-- | Read a tag map. This creates a map from tags to page paths. This function
20-- | Read a tag map. This creates a map from tags to page paths. This function
20-- assumes the tags are located in the `tags` metadata field, separated by
21-- assumes the tags are located in the `tags` metadata field, separated by
21-- commas.
22-- commas.
22−readTagMap :: [FilePath] -> IO (M.Map String [FilePath])
23+readTagMap :: [FilePath] -> Hakyll (M.Map String [FilePath])
23readTagMap paths = foldM addPaths M.empty paths
24readTagMap paths = foldM addPaths M.empty paths
24 where
25 where
25 addPaths current path = do
26 addPaths current path = do