git.iko.soy/hakyll
on 0c41ea0 help sign in
hakyll/src/Text/Hakyll/File.hs
116 lines 4.2 kB history raw
1-- | A module containing various function for manipulating and examinating
2-- files and directories.
3module Text.Hakyll.File
4 ( toDestination
5 , toURL
6 , toRoot
7 , removeSpaces
8 , makeDirectories
9 , getRecursiveContents
10 , havingExtension
11 , isCacheValid
12 , directory
13 ) where
15import System.Directory
16import System.FilePath
17import Control.Monad
18import Data.List (isPrefixOf)
19import Control.Monad.Reader (liftIO)
21import Text.Hakyll.Hakyll (Hakyll)
23-- | Auxiliary function to remove pathSeparators form the start. We don't deal
24-- with absolute paths here. We also remove $root from the start.
25removeLeadingSeparator :: FilePath -> FilePath
26removeLeadingSeparator [] = []
27removeLeadingSeparator path
28 | head path' `elem` pathSeparators = tail path'
29 | otherwise = path'
30 where
31 path' = if "$root" `isPrefixOf` path then drop 5 path
32 else path
34-- | Convert a relative filepath to a filepath in the destination (@_site@).
35toDestination :: FilePath -> FilePath
36toDestination path = "_site" </> removeLeadingSeparator path
38-- | Get the url for a given page.
39toURL :: FilePath -> FilePath
40toURL path = if takeExtension path `elem` [ ".markdown"
41 , ".md"
42 , ".mdn"
43 , ".mdwn"
44 , ".mkd"
45 , ".mkdn"
46 , ".mkdwn"
47 , ".rst"
48 , ".text"
49 , ".tex"
50 ]
51 then flip addExtension ".html" $ dropExtension path
52 else path
54-- | Get the relative url to the site root, for a given (absolute) url
55toRoot :: FilePath -> FilePath
56toRoot = emptyException . joinPath . map parent . splitPath
57 . takeDirectory . removeLeadingSeparator
58 where
59 parent = const ".."
60 emptyException [] = "."
61 emptyException x = x
63-- | Swaps spaces for '-'.
64removeSpaces :: FilePath -> FilePath
65removeSpaces = map swap
66 where
67 swap ' ' = '-'
68 swap x = x
70-- | Given a path to a file, try to make the path writable by making
71-- all directories on the path.
72makeDirectories :: FilePath -> Hakyll ()
73makeDirectories path = liftIO $ createDirectoryIfMissing True dir
74 where
75 dir = takeDirectory path
77-- | Get all contents of a directory. Note that files starting with a dot (.)
78-- will be ignored.
79getRecursiveContents :: FilePath -> Hakyll [FilePath]
80getRecursiveContents topdir = do
81 names <- liftIO $ getDirectoryContents topdir
82 let properNames = filter isProper names
83 paths <- forM properNames $ \name -> do
84 let path = topdir </> name
85 isDirectory <- liftIO $ doesDirectoryExist path
86 if isDirectory
87 then getRecursiveContents path
88 else return [path]
89 return (concat paths)
90 where
91 isProper = not . (== '.') . head
93-- | A filter that takes all file names with a given extension. Prefix the
94-- extension with a dot:
95--
96-- > havingExtension ".markdown" [ "index.markdown"
97-- > , "style.css"
98-- > ] == ["index.markdown"]
99havingExtension :: String -> [FilePath] -> [FilePath]
100havingExtension extension = filter ((==) extension . takeExtension)
102-- | Perform a Hakyll action on every file in a given directory.
103directory :: (FilePath -> Hakyll ()) -> FilePath -> Hakyll ()
104directory action dir = getRecursiveContents dir >>= mapM_ action
106-- | Check if a cache file is still valid.
107isCacheValid :: FilePath -- ^ The cached file.
108 -> [FilePath] -- ^ Dependencies of the cached file.
109 -> Hakyll Bool
110isCacheValid cache depends = do
111 exists <- liftIO $ doesFileExist cache
112 if not exists
113 then return False
114 else do dependsModified <- liftIO $ mapM getModificationTime depends
115 cacheModified <- liftIO $ getModificationTime cache
116 return (cacheModified >= maximum dependsModified)