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