diff options
Diffstat (limited to 'src/Text')
-rw-r--r-- | src/Text/Hakyll/File.hs | 32 | ||||
-rw-r--r-- | src/Text/Hakyll/Page.hs | 22 | ||||
-rw-r--r-- | src/Text/Hakyll/Render.hs | 12 | ||||
-rw-r--r-- | src/Text/Hakyll/Render/Internal.hs | 2 |
4 files changed, 38 insertions, 30 deletions
diff --git a/src/Text/Hakyll/File.hs b/src/Text/Hakyll/File.hs index 3dd2538..ed2bbea 100644 --- a/src/Text/Hakyll/File.hs +++ b/src/Text/Hakyll/File.hs @@ -63,20 +63,20 @@ removeSpaces = map swap -- | Given a path to a file, try to make the path writable by making -- all directories on the path. -makeDirectories :: FilePath -> IO () -makeDirectories path = createDirectoryIfMissing True dir +makeDirectories :: FilePath -> Hakyll () +makeDirectories path = liftIO $ createDirectoryIfMissing True dir where dir = takeDirectory path -- | Get all contents of a directory. Note that files starting with a dot (.) -- will be ignored. -getRecursiveContents :: FilePath -> IO [FilePath] +getRecursiveContents :: FilePath -> Hakyll [FilePath] getRecursiveContents topdir = do - names <- getDirectoryContents topdir + names <- liftIO $ getDirectoryContents topdir let properNames = filter isProper names paths <- forM properNames $ \name -> do let path = topdir </> name - isDirectory <- doesDirectoryExist path + isDirectory <- liftIO $ doesDirectoryExist path if isDirectory then getRecursiveContents path else return [path] @@ -87,20 +87,24 @@ getRecursiveContents topdir = do -- | A filter that takes all file names with a given extension. Prefix the -- extension with a dot: -- --- > havingExtension ".markdown" ["index.markdown", "style.css"] == ["index.markdown"] +-- > havingExtension ".markdown" [ "index.markdown" +-- > , "style.css" +-- > ] == ["index.markdown"] havingExtension :: String -> [FilePath] -> [FilePath] havingExtension extension = filter ((==) extension . takeExtension) --- | Perform an IO action on every file in a given directory. +-- | Perform a Hakyll action on every file in a given directory. directory :: (FilePath -> Hakyll ()) -> FilePath -> Hakyll () directory action dir = do - contents <- liftIO $ getRecursiveContents dir + contents <- getRecursiveContents dir mapM_ action contents -- | Check if a cache file is still valid. -isCacheValid :: FilePath -> [FilePath] -> IO Bool -isCacheValid cache depends = doesFileExist cache >>= \exists -> - if not exists then return False - else do dependsModified <- (mapM getModificationTime depends) >>= return . maximum - cacheModified <- getModificationTime cache - return (cacheModified >= dependsModified) +isCacheValid :: FilePath -> [FilePath] -> Hakyll Bool +isCacheValid cache depends = do + exists <- liftIO $ doesFileExist cache + if not exists + then return False + else do dependsModified <- liftIO $ mapM getModificationTime depends + cacheModified <- liftIO $ getModificationTime cache + return (cacheModified >= maximum dependsModified) diff --git a/src/Text/Hakyll/Page.hs b/src/Text/Hakyll/Page.hs index 6c73ff3..652a1c6 100644 --- a/src/Text/Hakyll/Page.hs +++ b/src/Text/Hakyll/Page.hs @@ -84,26 +84,30 @@ isDelimiter = L.isPrefixOf "---" -- | Used for caching of files. cachePage :: Page -> Hakyll () -cachePage page@(Page mapping) = liftIO $ do - let destination = toCache $ getURL page +cachePage page@(Page mapping) = do makeDirectories destination - handle <- openFile destination WriteMode - hPutStrLn handle "---" - mapM_ (writePair handle) $ M.toList $ M.delete "body" mapping - hPutStrLn handle "---" - hPutStr handle $ getBody page - hClose handle + liftIO writePageToCache where + writePageToCache = do + handle <- openFile destination WriteMode + hPutStrLn handle "---" + mapM_ (writePair handle) $ M.toList $ M.delete "body" mapping + hPutStrLn handle "---" + hPutStr handle $ getBody page + hClose handle + writePair h (k, v) = do hPutStr h $ k ++ ": " ++ v hPutStrLn h "" + destination = toCache $ getURL page + -- | 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 -> Hakyll Page readPage pagePath = do -- Check cache. - getFromCache <- liftIO $ isCacheValid cacheFile [pagePath] + getFromCache <- isCacheValid cacheFile [pagePath] let path = if getFromCache then cacheFile else pagePath -- Read file. diff --git a/src/Text/Hakyll/Render.hs b/src/Text/Hakyll/Render.hs index 4b22836..870c953 100644 --- a/src/Text/Hakyll/Render.hs +++ b/src/Text/Hakyll/Render.hs @@ -31,7 +31,7 @@ depends :: FilePath -- ^ File to be rendered or created. -> Hakyll () -- ^ IO action to execute when the file is out of date. -> Hakyll () depends file dependencies action = do - valid <- liftIO $ isCacheValid (toDestination file) dependencies + valid <- isCacheValid (toDestination file) dependencies unless valid action -- | Render to a Page. @@ -93,17 +93,17 @@ renderChainWith manipulation templatePaths renderable = -- | Mark a certain file as static, so it will just be copied when the site is -- generated. static :: FilePath -> Hakyll () -static source = depends destination [source] (liftIO action) +static source = depends destination [source] action where destination = toDestination source action = do makeDirectories destination - copyFile source destination + liftIO $ copyFile source destination -- | Render a css file, compressing it. css :: FilePath -> Hakyll () -css source = depends destination [source] (liftIO css') +css source = depends destination [source] css' where destination = toDestination source - css' = do contents <- readFile source + css' = do contents <- liftIO $ readFile source makeDirectories destination - writeFile destination (compressCSS contents) + liftIO $ writeFile destination (compressCSS contents) diff --git a/src/Text/Hakyll/Render/Internal.hs b/src/Text/Hakyll/Render/Internal.hs index e6379bd..e296dd2 100644 --- a/src/Text/Hakyll/Render/Internal.hs +++ b/src/Text/Hakyll/Render/Internal.hs @@ -87,7 +87,7 @@ writePage page = do globalContext <- liftM hakyllGlobalContext ask let destination = toDestination url context = (M.singleton "root" $ toRoot url) `M.union` globalContext - liftIO $ makeDirectories destination + makeDirectories destination -- Substitute $root here, just before writing. liftIO $ writeFile destination $ finalSubstitute (getBody page) context where |