git.iko.soy/hakyll
on 487d91c help sign in
hakyll/src/Text/Hakyll/File.hs
188 lines 6.9 kB history raw
1-- | A module containing various function for manipulating and examinating
2-- files and directories.
3module Text.Hakyll.File
4 ( toDestination
5 , toCache
6 , toUrl
7 , toRoot
8 , inDirectory
9 , inHakyllDirectory
10 , removeSpaces
11 , makeDirectories
12 , getRecursiveContents
13 , sortByBaseName
14 , havingExtension
15 , directory
16 , isMoreRecent
17 , isFileMoreRecent
18 ) where
20import System.Directory
21import Control.Applicative ((<$>))
22import System.FilePath
23import System.Time (ClockTime)
24import Control.Monad
25import Data.List (isPrefixOf, sortBy)
26import Data.Ord (comparing)
27import Control.Monad.Reader (liftIO)
29import Text.Hakyll.HakyllMonad
30import Text.Hakyll.Internal.FileType (isRenderableFile)
32-- | Auxiliary function to remove pathSeparators form the start. We don't deal
33-- with absolute paths here. We also remove $root from the start.
34removeLeadingSeparator :: FilePath -> FilePath
35removeLeadingSeparator [] = []
36removeLeadingSeparator path
37 | head path' `elem` pathSeparators = tail path'
38 | otherwise = path'
39 where
40 path' = if "$root" `isPrefixOf` path then drop 5 path
41 else path
43-- | Convert a relative filepath to a filepath in the destination
44-- (default: @_site@).
45toDestination :: FilePath -> Hakyll FilePath
46toDestination url = do dir <- askHakyll siteDirectory
47 enableIndexUrl' <- askHakyll enableIndexUrl
48 let destination = if enableIndexUrl' && separatorEnd
49 then dir </> noSeparator </> "index.html"
50 else dir </> noSeparator
51 return destination
52 where
53 noSeparator = removeLeadingSeparator url
54 separatorEnd = not (null url) && last url == '/'
56-- | Convert a relative filepath to a filepath in the cache
57-- (default: @_cache@).
58toCache :: FilePath -> Hakyll FilePath
59toCache path = do dir <- askHakyll cacheDirectory
60 return $ dir </> removeLeadingSeparator path
62-- | Get the url for a given page. For most extensions, this would be the path
63-- itself. It's only for rendered extensions (@.markdown@, @.rst@, @.lhs@ this
64-- function returns a path with a @.html@ extension instead.
65toUrl :: FilePath -> Hakyll FilePath
66toUrl path = do enableIndexUrl' <- askHakyll enableIndexUrl
67 -- If the file does not have a renderable extension, like for
68 -- example favicon.ico, we don't have to change it at all.
69 return $ if not (isRenderableFile path)
70 then path
71 -- If index url's are enabled, we create pick it
72 -- unless the page is an index already.
73 else if enableIndexUrl' && not isIndex
74 then indexUrl
75 else withSimpleHtmlExtension
76 where
77 isIndex = dropExtension (takeFileName path) == "index"
78 withSimpleHtmlExtension = flip addExtension ".html" $ dropExtension path
79 indexUrl = dropExtension path ++ "/"
82-- | Get the relative url to the site root, for a given (absolute) url
83toRoot :: FilePath -> FilePath
84toRoot = emptyException . joinPath . map parent . splitPath
85 . takeDirectory . removeLeadingSeparator
86 where
87 parent = const ".."
88 emptyException [] = "."
89 emptyException x = x
91-- | Check if a file is in a given directory.
92--
93inDirectory :: FilePath -- ^ File path
94 -> FilePath -- ^ Directory
95 -> Bool -- ^ Result
96inDirectory path dir = case splitDirectories path of
97 [] -> False
98 (x : _) -> x == dir
100-- | Check if a file is in a Hakyll directory. With a Hakyll directory, we mean
101-- a directory that should be "ignored" such as the @_site@ or @_cache@
102-- directory.
103--
104-- Example:
105--
106-- > inHakyllDirectory "_cache/pages/index.html"
107--
108-- Result:
109--
110-- > True
111--
112inHakyllDirectory :: FilePath -> Hakyll Bool
113inHakyllDirectory path =
114 or <$> mapM (liftM (inDirectory path) . askHakyll)
115 [siteDirectory, cacheDirectory]
117-- | Swaps spaces for '-'.
118removeSpaces :: FilePath -> FilePath
119removeSpaces = map swap
120 where
121 swap ' ' = '-'
122 swap x = x
124-- | Given a path to a file, try to make the path writable by making
125-- all directories on the path.
126makeDirectories :: FilePath -> Hakyll ()
127makeDirectories path = liftIO $ createDirectoryIfMissing True dir
128 where
129 dir = takeDirectory path
131-- | Get all contents of a directory. Note that files starting with a dot (.)
132-- will be ignored.
133--
134getRecursiveContents :: FilePath -> Hakyll [FilePath]
135getRecursiveContents topdir = do
136 topdirExists <- liftIO $ doesDirectoryExist topdir
137 if topdirExists
138 then do names <- liftIO $ getDirectoryContents topdir
139 let properNames = filter isProper names
140 paths <- forM properNames $ \name -> do
141 let path = topdir </> name
142 isDirectory <- liftIO $ doesDirectoryExist path
143 if isDirectory
144 then getRecursiveContents path
145 else return [normalise path]
146 return (concat paths)
147 else return []
148 where
149 isProper = not . (== '.') . head
151-- | Sort a list of filenames on the basename.
152sortByBaseName :: [FilePath] -> [FilePath]
153sortByBaseName = sortBy compareBaseName
154 where
155 compareBaseName = comparing takeFileName
157-- | A filter that takes all file names with a given extension. Prefix the
158-- extension with a dot:
159--
160-- > havingExtension ".markdown" [ "index.markdown"
161-- > , "style.css"
162-- > ] == ["index.markdown"]
163havingExtension :: String -> [FilePath] -> [FilePath]
164havingExtension extension = filter ((==) extension . takeExtension)
166-- | Perform a Hakyll action on every file in a given directory.
167directory :: (FilePath -> Hakyll ()) -> FilePath -> Hakyll ()
168directory action dir = getRecursiveContents dir >>= mapM_ action
170-- | Check if a timestamp is newer then a number of given files.
171isMoreRecent :: ClockTime -- ^ The time to check.
172 -> [FilePath] -- ^ Dependencies of the cached file.
173 -> Hakyll Bool
174isMoreRecent _ [] = return True
175isMoreRecent timeStamp depends = do
176 dependsModified <- liftIO $ mapM getModificationTime depends
177 return (timeStamp >= maximum dependsModified)
179-- | Check if a file is newer then a number of given files.
180isFileMoreRecent :: FilePath -- ^ The cached file.
181 -> [FilePath] -- ^ Dependencies of the cached file.
182 -> Hakyll Bool
183isFileMoreRecent file depends = do
184 exists <- liftIO $ doesFileExist file
185 if not exists
186 then return False
187 else do timeStamp <- liftIO $ getModificationTime file
188 isMoreRecent timeStamp depends