git.iko.soy/hakyll
on master help sign in
Moved some more functions from the IO monad to the Hakyll monad stack.
62330ceJasper Van der Jeugt
src/Text/Hakyll/File.hs+18−14
compare with master
unifiedsplit
@@ -63,20 +63,20 @@ removeSpaces = map swap
63
63
64-- | Given a path to a file, try to make the path writable by making
64-- | Given a path to a file, try to make the path writable by making
65-- all directories on the path.
65-- all directories on the path.
66−makeDirectories :: FilePath -> IO ()
66+makeDirectories :: FilePath -> Hakyll ()
67−makeDirectories path = createDirectoryIfMissing True dir
67+makeDirectories path = liftIO $ createDirectoryIfMissing True dir
68 where
68 where
69 dir = takeDirectory path
69 dir = takeDirectory path
70
70
71-- | Get all contents of a directory. Note that files starting with a dot (.)
71-- | Get all contents of a directory. Note that files starting with a dot (.)
72-- will be ignored.
72-- will be ignored.
73−getRecursiveContents :: FilePath -> IO [FilePath]
73+getRecursiveContents :: FilePath -> Hakyll [FilePath]
74getRecursiveContents topdir = do
74getRecursiveContents topdir = do
75− names <- getDirectoryContents topdir
75+ names <- liftIO $ getDirectoryContents topdir
76 let properNames = filter isProper names
76 let properNames = filter isProper names
77 paths <- forM properNames $ \name -> do
77 paths <- forM properNames $ \name -> do
78 let path = topdir </> name
78 let path = topdir </> name
79− isDirectory <- doesDirectoryExist path
79+ isDirectory <- liftIO $ doesDirectoryExist path
80 if isDirectory
80 if isDirectory
81 then getRecursiveContents path
81 then getRecursiveContents path
82 else return [path]
82 else return [path]
@@ -87,20 +87,24 @@ getRecursiveContents topdir = do
87-- | A filter that takes all file names with a given extension. Prefix the
87-- | A filter that takes all file names with a given extension. Prefix the
88-- extension with a dot:
88-- extension with a dot:
89--
89--
90−-- > havingExtension ".markdown" ["index.markdown", "style.css"] == ["index.markdown"]
90+-- > havingExtension ".markdown" [ "index.markdown"
91+-- > , "style.css"
92+-- > ] == ["index.markdown"]
91havingExtension :: String -> [FilePath] -> [FilePath]
93havingExtension :: String -> [FilePath] -> [FilePath]
92havingExtension extension = filter ((==) extension . takeExtension)
94havingExtension extension = filter ((==) extension . takeExtension)
93
95
94−-- | Perform an IO action on every file in a given directory.
96+-- | Perform a Hakyll action on every file in a given directory.
95directory :: (FilePath -> Hakyll ()) -> FilePath -> Hakyll ()
97directory :: (FilePath -> Hakyll ()) -> FilePath -> Hakyll ()
96directory action dir = do
98directory action dir = do
97− contents <- liftIO $ getRecursiveContents dir
99+ contents <- getRecursiveContents dir
98 mapM_ action contents
100 mapM_ action contents
99
101
100-- | Check if a cache file is still valid.
102-- | Check if a cache file is still valid.
101−isCacheValid :: FilePath -> [FilePath] -> IO Bool
103+isCacheValid :: FilePath -> [FilePath] -> Hakyll Bool
102−isCacheValid cache depends = doesFileExist cache >>= \exists ->
104+isCacheValid cache depends = do
105+ exists <- liftIO $ doesFileExist cache
106+ if not exists
103− if not exists then return False
107+ then return False
104− else do dependsModified <- (mapM getModificationTime depends) >>= return . maximum
108+ else do dependsModified <- liftIO $ mapM getModificationTime depends
105− cacheModified <- getModificationTime cache
109+ cacheModified <- liftIO $ getModificationTime cache
106− return (cacheModified >= dependsModified)
110+ return (cacheModified >= maximum dependsModified)
src/Text/Hakyll/Page.hs+13−9
@@ -84,26 +84,30 @@ isDelimiter = L.isPrefixOf "---"
84
84
85-- | Used for caching of files.
85-- | Used for caching of files.
86cachePage :: Page -> Hakyll ()
86cachePage :: Page -> Hakyll ()
87−cachePage page@(Page mapping) = liftIO $ do
87+cachePage page@(Page mapping) = do
88− let destination = toCache $ getURL page
89 makeDirectories destination
88 makeDirectories destination
90− handle <- openFile destination WriteMode
89+ liftIO writePageToCache
91− hPutStrLn handle "---"
92− mapM_ (writePair handle) $ M.toList $ M.delete "body" mapping
93− hPutStrLn handle "---"
94− hPutStr handle $ getBody page
95− hClose handle
96 where
90 where
91+ writePageToCache = do
92+ handle <- openFile destination WriteMode
93+ hPutStrLn handle "---"
94+ mapM_ (writePair handle) $ M.toList $ M.delete "body" mapping
95+ hPutStrLn handle "---"
96+ hPutStr handle $ getBody page
97+ hClose handle
98+
97 writePair h (k, v) = do hPutStr h $ k ++ ": " ++ v
99 writePair h (k, v) = do hPutStr h $ k ++ ": " ++ v
98 hPutStrLn h ""
100 hPutStrLn h ""
99
101
102+ destination = toCache $ getURL page
103+
100-- | Read a page from a file. Metadata is supported, and if the filename
104-- | Read a page from a file. Metadata is supported, and if the filename
101-- has a .markdown extension, it will be rendered using pandoc. Note that
105-- has a .markdown extension, it will be rendered using pandoc. Note that
102-- pages are not templates, so they should not contain $identifiers.
106-- pages are not templates, so they should not contain $identifiers.
103readPage :: FilePath -> Hakyll Page
107readPage :: FilePath -> Hakyll Page
104readPage pagePath = do
108readPage pagePath = do
105 -- Check cache.
109 -- Check cache.
106− getFromCache <- liftIO $ isCacheValid cacheFile [pagePath]
110+ getFromCache <- isCacheValid cacheFile [pagePath]
107 let path = if getFromCache then cacheFile else pagePath
111 let path = if getFromCache then cacheFile else pagePath
108
112
109 -- Read file.
113 -- Read file.
src/Text/Hakyll/Render.hs+6−6
@@ -31,7 +31,7 @@ depends :: FilePath -- ^ File to be rendered or created.
31 -> Hakyll () -- ^ IO action to execute when the file is out of date.
31 -> Hakyll () -- ^ IO action to execute when the file is out of date.
32 -> Hakyll ()
32 -> Hakyll ()
33depends file dependencies action = do
33depends file dependencies action = do
34− valid <- liftIO $ isCacheValid (toDestination file) dependencies
34+ valid <- isCacheValid (toDestination file) dependencies
35 unless valid action
35 unless valid action
36
36
37-- | Render to a Page.
37-- | Render to a Page.
@@ -93,17 +93,17 @@ renderChainWith manipulation templatePaths renderable =
93-- | 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
94-- generated.
94-- generated.
95static :: FilePath -> Hakyll ()
95static :: FilePath -> Hakyll ()
96−static source = depends destination [source] (liftIO action)
96+static source = depends destination [source] action
97 where
97 where
98 destination = toDestination source
98 destination = toDestination source
99 action = do makeDirectories destination
99 action = do makeDirectories destination
100− copyFile source destination
100+ liftIO $ copyFile source destination
101
101
102-- | Render a css file, compressing it.
102-- | Render a css file, compressing it.
103css :: FilePath -> Hakyll ()
103css :: FilePath -> Hakyll ()
104−css source = depends destination [source] (liftIO css')
104+css source = depends destination [source] css'
105 where
105 where
106 destination = toDestination source
106 destination = toDestination source
107− css' = do contents <- readFile source
107+ css' = do contents <- liftIO $ readFile source
108 makeDirectories destination
108 makeDirectories destination
109− writeFile destination (compressCSS contents)
109+ liftIO $ writeFile destination (compressCSS contents)
src/Text/Hakyll/Render/Internal.hs+1−1
@@ -87,7 +87,7 @@ writePage page = do
87 globalContext <- liftM hakyllGlobalContext ask
87 globalContext <- liftM hakyllGlobalContext ask
88 let destination = toDestination url
88 let destination = toDestination url
89 context = (M.singleton "root" $ toRoot url) `M.union` globalContext
89 context = (M.singleton "root" $ toRoot url) `M.union` globalContext
90− liftIO $ makeDirectories destination
90+ makeDirectories destination
91    -- Substitute $root here, just before writing.
91    -- Substitute $root here, just before writing.
92 liftIO $ writeFile destination $ finalSubstitute (getBody page) context
92 liftIO $ writeFile destination $ finalSubstitute (getBody page) context
93 where
93 where