git.iko.soy/hakyll
on 4e3c26b help sign in
hakyll/src/Text/Hakyll/File.hs
93 lines 3.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 , 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 path = if takeExtension path `elem` [".markdown", ".md", ".tex"]
38 then flip addExtension ".html" $ dropExtension path
39 else path
41-- | Get the relative url to the site root, for a given (absolute) url
42toRoot :: FilePath -> FilePath
43toRoot = emptyException . joinPath . map parent . splitPath
44 . takeDirectory . removeLeadingSeparator
45 where parent = const ".."
46 emptyException [] = "."
47 emptyException x = x
49-- | Swaps spaces for '-'.
50removeSpaces :: FilePath -> FilePath
51removeSpaces = map swap
52 where swap ' ' = '-'
53 swap x = x
55-- | Given a path to a file, try to make the path writable by making
56-- all directories on the path.
57makeDirectories :: FilePath -> IO ()
58makeDirectories path = createDirectoryIfMissing True dir
59 where dir = takeDirectory path
61-- | Get all contents of a directory. Note that files starting with a dot (.)
62-- will be ignored.
63getRecursiveContents :: FilePath -> IO [FilePath]
64getRecursiveContents topdir = do
65 names <- getDirectoryContents topdir
66 let properNames = filter isProper names
67 paths <- forM properNames $ \name -> do
68 let path = topdir </> name
69 isDirectory <- doesDirectoryExist path
70 if isDirectory
71 then getRecursiveContents path
72 else return [path]
73 return (concat paths)
74 where isProper = not . (== '.') . head
76-- | A filter that takes all file names with a given extension. Prefix the
77-- extension with a dot:
78--
79-- > havingExtension ".markdown" ["index.markdown", "style.css"] == ["index.markdown"]
80havingExtension :: String -> [FilePath] -> [FilePath]
81havingExtension extension = filter ((==) extension . takeExtension)
83-- | Perform an IO action on every file in a given directory.
84directory :: (FilePath -> IO ()) -> FilePath -> IO ()
85directory action dir = getRecursiveContents dir >>= mapM_ action
87-- | Check if a cache file is still valid.
88isCacheValid :: FilePath -> [FilePath] -> IO Bool
89isCacheValid cache depends = doesFileExist cache >>= \exists ->
90 if not exists then return False
91 else do dependsModified <- (mapM getModificationTime depends) >>= return . maximum
92 cacheModified <- getModificationTime cache
93 return (cacheModified >= dependsModified)