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