git.iko.soy/hakyll
on fbd9ff9 help sign in
hakyll/src/Text/Hakyll/File.hs
135 lines 5.0 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 path = do dir <- askHakyll siteDirectory
40 return $ dir </> removeLeadingSeparator path
42-- | Convert a relative filepath to a filepath in the cache
43-- (default: @_cache@).
44toCache :: FilePath -> Hakyll FilePath
45toCache path = do dir <- askHakyll cacheDirectory
46 return $ dir </> removeLeadingSeparator path
48-- | Get the url for a given page. For most extensions, this would be the path
49-- itself. It's only for rendered extensions (@.markdown@, @.rst@, @.lhs@ this
50-- function returns a path with a @.html@ extension instead.
51toUrl :: FilePath -> FilePath
52toUrl path = if takeExtension path `elem` [ ".markdown"
53 , ".md"
54 , ".mdn"
55 , ".mdwn"
56 , ".mkd"
57 , ".mkdn"
58 , ".mkdwn"
59 , ".rst"
60 , ".text"
61 , ".tex"
62 , ".lhs"
63 ]
64 then flip addExtension ".html" $ dropExtension path
65 else path
67-- | Get the relative url to the site root, for a given (absolute) url
68toRoot :: FilePath -> FilePath
69toRoot = emptyException . joinPath . map parent . splitPath
70 . takeDirectory . removeLeadingSeparator
71 where
72 parent = const ".."
73 emptyException [] = "."
74 emptyException x = x
76-- | Swaps spaces for '-'.
77removeSpaces :: FilePath -> FilePath
78removeSpaces = map swap
79 where
80 swap ' ' = '-'
81 swap x = x
83-- | Given a path to a file, try to make the path writable by making
84-- all directories on the path.
85makeDirectories :: FilePath -> Hakyll ()
86makeDirectories path = liftIO $ createDirectoryIfMissing True dir
87 where
88 dir = takeDirectory path
90-- | Get all contents of a directory. Note that files starting with a dot (.)
91-- will be ignored.
92getRecursiveContents :: FilePath -> Hakyll [FilePath]
93getRecursiveContents topdir = do
94 names <- liftIO $ getDirectoryContents topdir
95 let properNames = filter isProper names
96 paths <- forM properNames $ \name -> do
97 let path = topdir </> name
98 isDirectory <- liftIO $ doesDirectoryExist path
99 if isDirectory
100 then getRecursiveContents path
101 else return [path]
102 return (concat paths)
103 where
104 isProper = not . (== '.') . head
106-- | Sort a list of filenames on the basename.
107sortByBaseName :: [FilePath] -> [FilePath]
108sortByBaseName = sortBy compareBaseName
109 where
110 compareBaseName f1 f2 = compare (takeFileName f1) (takeFileName f2)
112-- | A filter that takes all file names with a given extension. Prefix the
113-- extension with a dot:
114--
115-- > havingExtension ".markdown" [ "index.markdown"
116-- > , "style.css"
117-- > ] == ["index.markdown"]
118havingExtension :: String -> [FilePath] -> [FilePath]
119havingExtension extension = filter ((==) extension . takeExtension)
121-- | Perform a Hakyll action on every file in a given directory.
122directory :: (FilePath -> Hakyll ()) -> FilePath -> Hakyll ()
123directory action dir = getRecursiveContents dir >>= mapM_ action
125-- | Check if a file is newer then a number of given files.
126isMoreRecent :: FilePath -- ^ The cached file.
127 -> [FilePath] -- ^ Dependencies of the cached file.
128 -> Hakyll Bool
129isMoreRecent file depends = do
130 exists <- liftIO $ doesFileExist file
131 if not exists
132 then return False
133 else do dependsModified <- liftIO $ mapM getModificationTime depends
134 fileModified <- liftIO $ getModificationTime file
135 return (fileModified >= maximum dependsModified)