git.iko.soy/hakyll
on 1199692 help sign in
hakyll/src/Text/Hakyll/File.hs
168 lines 6.8 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 , removeSpaces
9 , makeDirectories
10 , getRecursiveContents
11 , sortByBaseName
12 , havingExtension
13 , directory
14 , isMoreRecent
15 , isFileMoreRecent
16 ) where
18import System.Directory
19import System.FilePath
20import System.Time (ClockTime)
21import Control.Monad
22import Data.List (isPrefixOf, sortBy)
23import Data.Ord (comparing)
24import Control.Monad.Reader (liftIO)
26import Text.Hakyll.Hakyll
28-- | Auxiliary function to remove pathSeparators form the start. We don't deal
29-- with absolute paths here. We also remove $root from the start.
30removeLeadingSeparator :: FilePath -> FilePath
31removeLeadingSeparator [] = []
32removeLeadingSeparator path
33 | head path' `elem` pathSeparators = tail path'
34 | otherwise = path'
35 where
36 path' = if "$root" `isPrefixOf` path then drop 5 path
37 else path
39-- | Convert a relative filepath to a filepath in the destination
40-- (default: @_site@).
41toDestination :: FilePath -> Hakyll FilePath
42toDestination url = do dir <- askHakyll siteDirectory
43 enableIndexUrl' <- askHakyll enableIndexUrl
44 let destination = if enableIndexUrl' && separatorEnd
45 then dir </> noSeparator </> "index.html"
46 else dir </> noSeparator
47 return destination
48 where
49 noSeparator = removeLeadingSeparator url
50 separatorEnd = not (null url) && last url == '/'
52-- | Convert a relative filepath to a filepath in the cache
53-- (default: @_cache@).
54toCache :: FilePath -> Hakyll FilePath
55toCache path = do dir <- askHakyll cacheDirectory
56 return $ dir </> removeLeadingSeparator path
58-- | Get the url for a given page. For most extensions, this would be the path
59-- itself. It's only for rendered extensions (@.markdown@, @.rst@, @.lhs@ this
60-- function returns a path with a @.html@ extension instead.
61toUrl :: FilePath -> Hakyll FilePath
62toUrl path = do enableIndexUrl' <- askHakyll enableIndexUrl
63 -- If the file does not have a renderable extension, like for
64 -- example favicon.ico, we don't have to change it at all.
65 return $ if not hasRenderableExtension
66 then path
67 -- If index url's are enabled, we create pick it
68 -- unless the page is an index already.
69 else if enableIndexUrl' && not isIndex
70 then indexUrl
71 else withSimpleHtmlExtension
72 where
73 hasRenderableExtension = takeExtension path `elem` [ ".markdown"
74 , ".md"
75 , ".mdn"
76 , ".mdwn"
77 , ".mkd"
78 , ".mkdn"
79 , ".mkdwn"
80 , ".rst"
81 , ".text"
82 , ".tex"
83 , ".lhs"
84 , ".htm"
85 , ".html"
86 ]
87 isIndex = dropExtension (takeFileName path) == "index"
88 withSimpleHtmlExtension = flip addExtension ".html" $ dropExtension path
89 indexUrl = dropExtension path ++ "/"
92-- | Get the relative url to the site root, for a given (absolute) url
93toRoot :: FilePath -> FilePath
94toRoot = emptyException . joinPath . map parent . splitPath
95 . takeDirectory . removeLeadingSeparator
96 where
97 parent = const ".."
98 emptyException [] = "."
99 emptyException x = x
101-- | Swaps spaces for '-'.
102removeSpaces :: FilePath -> FilePath
103removeSpaces = map swap
104 where
105 swap ' ' = '-'
106 swap x = x
108-- | Given a path to a file, try to make the path writable by making
109-- all directories on the path.
110makeDirectories :: FilePath -> Hakyll ()
111makeDirectories path = liftIO $ createDirectoryIfMissing True dir
112 where
113 dir = takeDirectory path
115-- | Get all contents of a directory. Note that files starting with a dot (.)
116-- will be ignored.
117getRecursiveContents :: FilePath -> Hakyll [FilePath]
118getRecursiveContents topdir = do
119 names <- liftIO $ getDirectoryContents topdir
120 let properNames = filter isProper names
121 paths <- forM properNames $ \name -> do
122 let path = topdir </> name
123 isDirectory <- liftIO $ doesDirectoryExist path
124 if isDirectory
125 then getRecursiveContents path
126 else return [path]
127 return (concat paths)
128 where
129 isProper = not . (== '.') . head
131-- | Sort a list of filenames on the basename.
132sortByBaseName :: [FilePath] -> [FilePath]
133sortByBaseName = sortBy compareBaseName
134 where
135 compareBaseName = comparing takeFileName
137-- | A filter that takes all file names with a given extension. Prefix the
138-- extension with a dot:
139--
140-- > havingExtension ".markdown" [ "index.markdown"
141-- > , "style.css"
142-- > ] == ["index.markdown"]
143havingExtension :: String -> [FilePath] -> [FilePath]
144havingExtension extension = filter ((==) extension . takeExtension)
146-- | Perform a Hakyll action on every file in a given directory.
147directory :: (FilePath -> Hakyll ()) -> FilePath -> Hakyll ()
148directory action dir = getRecursiveContents dir >>= mapM_ action
150-- | Check if a timestamp is newer then a number of given files.
151isMoreRecent :: ClockTime -- ^ The time to check.
152 -> [FilePath] -- ^ Dependencies of the cached file.
153 -> Hakyll Bool
154isMoreRecent _ [] = return True
155isMoreRecent timeStamp depends = do
156 dependsModified <- liftIO $ mapM getModificationTime depends
157 return (timeStamp >= maximum dependsModified)
159-- | Check if a file is newer then a number of given files.
160isFileMoreRecent :: FilePath -- ^ The cached file.
161 -> [FilePath] -- ^ Dependencies of the cached file.
162 -> Hakyll Bool
163isFileMoreRecent file depends = do
164 exists <- liftIO $ doesFileExist file
165 if not exists
166 then return False
167 else do timeStamp <- liftIO $ getModificationTime file
168 isMoreRecent timeStamp depends