on fef1172 help sign in
196 lines 7.1 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.Monad
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 = drop 1 path'
38 | otherwise = path'
39 where
40 path' = if "$root" `isPrefixOf` path then drop 5 path
41 else path
43-- | Convert a relative URL to a filepath in the destination
44-- (default: @_site@).
45toDestination :: FilePath -> Hakyll FilePath
46toDestination url = do dir <- askHakyll siteDirectory
47 toFilePath dir url
49-- | Convert a relative URL to a filepath in the cache
50-- (default: @_cache@).
51toCache :: FilePath -> Hakyll FilePath
52toCache path = do dir <- askHakyll cacheDirectory
53 toFilePath dir path
55-- | Implementation of toDestination/toCache
56--
57toFilePath :: String -- ^ Directory (site or cache)
58 -> String -- ^ URL
59 -> Hakyll FilePath -- ^ Resulting file path
60toFilePath dir url = do
61 enableIndexUrl' <- askHakyll enableIndexUrl
62 let destination = if enableIndexUrl' && separatorEnd
63 then dir </> noSeparator </> "index.html"
64 else dir </> noSeparator
65 return destination
66 where
67 noSeparator = removeLeadingSeparator url
68 separatorEnd = not (null url) && last url == '/'
70-- | Get the url for a given page. For most extensions, this would be the path
71-- itself. It's only for rendered extensions (@.markdown@, @.rst@, @.lhs@ this
72-- function returns a path with a @.html@ extension instead.
73toUrl :: FilePath -> Hakyll FilePath
74toUrl path = do enableIndexUrl' <- askHakyll enableIndexUrl
75 -- If the file does not have a renderable extension, like for
76 -- example favicon.ico, we don't have to change it at all.
77 return $ if not (isRenderableFile path)
78 then path
79 -- If index url's are enabled, we create pick it
80 -- unless the page is an index already.
81 else if enableIndexUrl' && not isIndex
82 then indexUrl
83 else withSimpleHtmlExtension
84 where
85 isIndex = dropExtension (takeFileName path) == "index"
86 withSimpleHtmlExtension = flip addExtension ".html" $ dropExtension path
87 indexUrl = dropExtension path ++ "/"
90-- | Get the relative url to the site root, for a given (absolute) url
91toRoot :: FilePath -> FilePath
92toRoot = emptyException . joinPath . map parent . splitPath
93 . takeDirectory . removeLeadingSeparator
94 where
95 parent = const ".."
96 emptyException [] = "."
97 emptyException x = x
99-- | Check if a file is in a given directory.
100--
101inDirectory :: FilePath -- ^ File path
102 -> FilePath -- ^ Directory
103 -> Bool -- ^ Result
104inDirectory path dir = case splitDirectories path of
105 [] -> False
106 (x : _) -> x == dir
108-- | Check if a file is in a Hakyll directory. With a Hakyll directory, we mean
109-- a directory that should be "ignored" such as the @_site@ or @_cache@
110-- directory.
111--
112-- Example:
113--
114-- > inHakyllDirectory "_cache/pages/index.html"
115--
116-- Result:
117--
118-- > True
119--
120inHakyllDirectory :: FilePath -> Hakyll Bool
121inHakyllDirectory path =
122 or <$> mapM (liftM (inDirectory path) . askHakyll)
123 [siteDirectory, cacheDirectory]
125-- | Swaps spaces for '-'.
126removeSpaces :: FilePath -> FilePath
127removeSpaces = map swap
128 where
129 swap ' ' = '-'
130 swap x = x
132-- | Given a path to a file, try to make the path writable by making
133-- all directories on the path.
134makeDirectories :: FilePath -> Hakyll ()
135makeDirectories path = liftIO $ createDirectoryIfMissing True dir
136 where
137 dir = takeDirectory path
139-- | Get all contents of a directory. Note that files starting with a dot (.)
140-- will be ignored.
141--
142getRecursiveContents :: FilePath -> Hakyll [FilePath]
143getRecursiveContents topdir = do
144 topdirExists <- liftIO $ doesDirectoryExist topdir
145 if topdirExists
146 then do names <- liftIO $ getDirectoryContents topdir
147 let properNames = filter isProper names
148 paths <- forM properNames $ \name -> do
149 let path = topdir </> name
150 isDirectory <- liftIO $ doesDirectoryExist path
151 if isDirectory
152 then getRecursiveContents path
153 else return [normalise path]
154 return (concat paths)
155 else return []
156 where
157 isProper = not . (== '.') . head
159-- | Sort a list of filenames on the basename.
160sortByBaseName :: [FilePath] -> [FilePath]
161sortByBaseName = sortBy compareBaseName
162 where
163 compareBaseName = comparing takeFileName
165-- | A filter that takes all file names with a given extension. Prefix the
166-- extension with a dot:
167--
168-- > havingExtension ".markdown" [ "index.markdown"
169-- > , "style.css"
170-- > ] == ["index.markdown"]
171havingExtension :: String -> [FilePath] -> [FilePath]
172havingExtension extension = filter ((==) extension . takeExtension)
174-- | Perform a Hakyll action on every file in a given directory.
175directory :: (FilePath -> Hakyll ()) -> FilePath -> Hakyll ()
176directory action dir = getRecursiveContents dir >>= mapM_ action
178-- | Check if a timestamp is newer then a number of given files.
179isMoreRecent :: ClockTime -- ^ The time to check.
180 -> [FilePath] -- ^ Dependencies of the cached file.
181 -> Hakyll Bool
182isMoreRecent _ [] = return True
183isMoreRecent timeStamp depends = do
184 dependsModified <- liftIO $ mapM getModificationTime depends
185 return (timeStamp >= maximum dependsModified)
187-- | Check if a file is newer then a number of given files.
188isFileMoreRecent :: FilePath -- ^ The cached file.
189 -> [FilePath] -- ^ Dependencies of the cached file.
190 -> Hakyll Bool
191isFileMoreRecent file depends = do
192 exists <- liftIO $ doesFileExist file
193 if not exists
194 then return False
195 else do timeStamp <- liftIO $ getModificationTime file
196 isMoreRecent timeStamp depends