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