-- | A module containing various function for manipulating and examinating -- files and directories. module Text.Hakyll.File ( toDestination , toCache , toURL , toRoot , removeSpaces , makeDirectories , getRecursiveContents , havingExtension , isCacheValid , directory ) where import System.Directory import System.FilePath import Control.Monad import Data.List (isPrefixOf) -- | Auxiliary function to remove pathSeparators form the start. We don't deal -- with absolute paths here. We also remove $root from the start. removeLeadingSeparator :: FilePath -> FilePath removeLeadingSeparator [] = [] removeLeadingSeparator path | (head path') `elem` pathSeparators = (tail path') | otherwise = path' where path' = if "$root" `isPrefixOf` path then drop 5 path else path -- | Convert a relative filepath to a filepath in the destination (_site). toDestination :: FilePath -> FilePath toDestination path = "_site" (removeLeadingSeparator path) -- | Convert a relative filepath to a filepath in the cache (_cache). toCache :: FilePath -> FilePath toCache path = "_cache" (removeLeadingSeparator path) -- | Get the url for a given page. toURL :: FilePath -> FilePath toURL path = if takeExtension path `elem` [".markdown", ".md", ".tex"] then flip addExtension ".html" $ dropExtension path else path -- | Get the relative url to the site root, for a given (absolute) url toRoot :: FilePath -> FilePath toRoot = emptyException . joinPath . map parent . splitPath . takeDirectory . removeLeadingSeparator where parent = const ".." emptyException [] = "." emptyException x = x -- | Swaps spaces for '-'. removeSpaces :: FilePath -> FilePath removeSpaces = map swap where swap ' ' = '-' swap x = x -- | Given a path to a file, try to make the path writable by making -- all directories on the path. makeDirectories :: FilePath -> IO () makeDirectories path = createDirectoryIfMissing True dir where dir = takeDirectory path -- | Get all contents of a directory. Note that files starting with a dot (.) -- will be ignored. getRecursiveContents :: FilePath -> IO [FilePath] getRecursiveContents topdir = do names <- getDirectoryContents topdir let properNames = filter isProper names paths <- forM properNames $ \name -> do let path = topdir name isDirectory <- doesDirectoryExist path if isDirectory then getRecursiveContents path else return [path] return (concat paths) where isProper = not . (== '.') . head -- | A filter that takes all file names with a given extension. Prefix the -- extension with a dot: -- -- > havingExtension ".markdown" ["index.markdown", "style.css"] == ["index.markdown"] havingExtension :: String -> [FilePath] -> [FilePath] havingExtension extension = filter ((==) extension . takeExtension) -- | Perform an IO action on every file in a given directory. directory :: (FilePath -> IO ()) -> FilePath -> IO () directory action dir = getRecursiveContents dir >>= mapM_ action -- | Check if a cache file is still valid. isCacheValid :: FilePath -> [FilePath] -> IO Bool isCacheValid cache depends = doesFileExist cache >>= \exists -> if not exists then return False else do dependsModified <- (mapM getModificationTime depends) >>= return . maximum cacheModified <- getModificationTime cache return (cacheModified >= dependsModified)