git.iko.soy/hakyll
on bc71d54 help sign in
hakyll/src/Text/Hakyll/File.hs
89 lines 3.2 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 , isCacheValid
13 , directory
14 ) where
16import System.Directory
17import System.FilePath
18import Control.Monad
20-- | Auxiliary function to remove pathSeparators form the start. We don't deal
21-- with absolute paths here.
22removeLeadingSeparator :: FilePath -> FilePath
23removeLeadingSeparator [] = []
24removeLeadingSeparator p@(x:xs) | x `elem` pathSeparators = xs
25 | otherwise = p
27-- | Convert a relative filepath to a filepath in the destination (_site).
28toDestination :: FilePath -> FilePath
29toDestination path = "_site" </> (removeLeadingSeparator path)
31-- | Convert a relative filepath to a filepath in the cache (_cache).
32toCache :: FilePath -> FilePath
33toCache path = "_cache" </> (removeLeadingSeparator path)
35-- | Get the url for a given page.
36toURL :: FilePath -> FilePath
37toURL = flip addExtension ".html" . dropExtension
39-- | Get the relative url to the site root, for a given (absolute) url
40toRoot :: FilePath -> FilePath
41toRoot = joinPath . map parent . splitPath
42 . takeDirectory . removeLeadingSeparator
43 where parent = const ".."
45-- | Swaps spaces for '-'.
46removeSpaces :: FilePath -> FilePath
47removeSpaces = map swap
48 where swap ' ' = '-'
49 swap x = x
51-- | Given a path to a file, try to make the path writable by making
52-- all directories on the path.
53makeDirectories :: FilePath -> IO ()
54makeDirectories path = createDirectoryIfMissing True dir
55 where dir = takeDirectory path
57-- | Get all contents of a directory. Note that files starting with a dot (.)
58-- will be ignored.
59getRecursiveContents :: FilePath -> IO [FilePath]
60getRecursiveContents topdir = do
61 names <- getDirectoryContents topdir
62 let properNames = filter isProper names
63 paths <- forM properNames $ \name -> do
64 let path = topdir </> name
65 isDirectory <- doesDirectoryExist path
66 if isDirectory
67 then getRecursiveContents path
68 else return [path]
69 return (concat paths)
70 where isProper = not . (== '.') . head
72-- | A filter that takes all file names with a given extension. Prefix the
73-- extension with a dot:
74--
75-- > havingExtension ".markdown" ["index.markdown", "style.css"] == ["index.markdown"]
76havingExtension :: String -> [FilePath] -> [FilePath]
77havingExtension extension = filter ((==) extension . takeExtension)
79-- | Perform an IO action on every file in a given directory.
80directory :: (FilePath -> IO ()) -> FilePath -> IO ()
81directory action dir = getRecursiveContents dir >>= mapM_ action
83-- | Check if a cache file is still valid.
84isCacheValid :: FilePath -> [FilePath] -> IO Bool
85isCacheValid cache depends = doesFileExist cache >>= \exists ->
86 if not exists then return False
87 else do dependsModified <- (mapM getModificationTime depends) >>= return . maximum
88 cacheModified <- getModificationTime cache
89 return (cacheModified >= dependsModified)