git.iko.soy/hakyll
on ee682ab help sign in
hakyll/src/Text/Hakyll/File.hs
126 lines 4.6 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 , havingExtension
12 , isMoreRecent
13 , directory
14 ) where
16import System.Directory
17import System.FilePath
18import Control.Monad
19import Data.List (isPrefixOf)
20import Control.Monad.Reader (liftIO)
22import Text.Hakyll.Hakyll
24-- | Auxiliary function to remove pathSeparators form the start. We don't deal
25-- with absolute paths here. We also remove $root from the start.
26removeLeadingSeparator :: FilePath -> FilePath
27removeLeadingSeparator [] = []
28removeLeadingSeparator path
29 | head path' `elem` pathSeparators = tail path'
30 | otherwise = path'
31 where
32 path' = if "$root" `isPrefixOf` path then drop 5 path
33 else path
35-- | Convert a relative filepath to a filepath in the destination
36-- (default: @_site@).
37toDestination :: FilePath -> Hakyll FilePath
38toDestination path = do dir <- askHakyll siteDirectory
39 return $ dir </> removeLeadingSeparator path
41-- | Convert a relative filepath to a filepath in the cache
42-- (default: @_cache@).
43toCache :: FilePath -> Hakyll FilePath
44toCache path = do dir <- askHakyll cacheDirectory
45 return $ dir </> removeLeadingSeparator path
47-- | Get the url for a given page.
48toURL :: FilePath -> FilePath
49toURL path = if takeExtension path `elem` [ ".markdown"
50 , ".md"
51 , ".mdn"
52 , ".mdwn"
53 , ".mkd"
54 , ".mkdn"
55 , ".mkdwn"
56 , ".rst"
57 , ".text"
58 , ".tex"
59 , ".lhs"
60 ]
61 then flip addExtension ".html" $ dropExtension path
62 else path
64-- | Get the relative url to the site root, for a given (absolute) url
65toRoot :: FilePath -> FilePath
66toRoot = emptyException . joinPath . map parent . splitPath
67 . takeDirectory . removeLeadingSeparator
68 where
69 parent = const ".."
70 emptyException [] = "."
71 emptyException x = x
73-- | Swaps spaces for '-'.
74removeSpaces :: FilePath -> FilePath
75removeSpaces = map swap
76 where
77 swap ' ' = '-'
78 swap x = x
80-- | Given a path to a file, try to make the path writable by making
81-- all directories on the path.
82makeDirectories :: FilePath -> Hakyll ()
83makeDirectories path = liftIO $ createDirectoryIfMissing True dir
84 where
85 dir = takeDirectory path
87-- | Get all contents of a directory. Note that files starting with a dot (.)
88-- will be ignored.
89getRecursiveContents :: FilePath -> Hakyll [FilePath]
90getRecursiveContents topdir = do
91 names <- liftIO $ getDirectoryContents topdir
92 let properNames = filter isProper names
93 paths <- forM properNames $ \name -> do
94 let path = topdir </> name
95 isDirectory <- liftIO $ doesDirectoryExist path
96 if isDirectory
97 then getRecursiveContents path
98 else return [path]
99 return (concat paths)
100 where
101 isProper = not . (== '.') . head
103-- | A filter that takes all file names with a given extension. Prefix the
104-- extension with a dot:
105--
106-- > havingExtension ".markdown" [ "index.markdown"
107-- > , "style.css"
108-- > ] == ["index.markdown"]
109havingExtension :: String -> [FilePath] -> [FilePath]
110havingExtension extension = filter ((==) extension . takeExtension)
112-- | Perform a Hakyll action on every file in a given directory.
113directory :: (FilePath -> Hakyll ()) -> FilePath -> Hakyll ()
114directory action dir = getRecursiveContents dir >>= mapM_ action
116-- | Check if a file is newer then a number of given files.
117isMoreRecent :: FilePath -- ^ The cached file.
118 -> [FilePath] -- ^ Dependencies of the cached file.
119 -> Hakyll Bool
120isMoreRecent file depends = do
121 exists <- liftIO $ doesFileExist file
122 if not exists
123 then return False
124 else do dependsModified <- liftIO $ mapM getModificationTime depends
125 fileModified <- liftIO $ getModificationTime file
126 return (fileModified >= maximum dependsModified)