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