git.iko.soy/hakyll
on aaa7771 help sign in
hakyll/src/Text/Hakyll/File.hs
125 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 ]
60 then flip addExtension ".html" $ dropExtension path
61 else path
63-- | Get the relative url to the site root, for a given (absolute) url
64toRoot :: FilePath -> FilePath
65toRoot = emptyException . joinPath . map parent . splitPath
66 . takeDirectory . removeLeadingSeparator
67 where
68 parent = const ".."
69 emptyException [] = "."
70 emptyException x = x
72-- | Swaps spaces for '-'.
73removeSpaces :: FilePath -> FilePath
74removeSpaces = map swap
75 where
76 swap ' ' = '-'
77 swap x = x
79-- | Given a path to a file, try to make the path writable by making
80-- all directories on the path.
81makeDirectories :: FilePath -> Hakyll ()
82makeDirectories path = liftIO $ createDirectoryIfMissing True dir
83 where
84 dir = takeDirectory path
86-- | Get all contents of a directory. Note that files starting with a dot (.)
87-- will be ignored.
88getRecursiveContents :: FilePath -> Hakyll [FilePath]
89getRecursiveContents topdir = do
90 names <- liftIO $ getDirectoryContents topdir
91 let properNames = filter isProper names
92 paths <- forM properNames $ \name -> do
93 let path = topdir </> name
94 isDirectory <- liftIO $ doesDirectoryExist path
95 if isDirectory
96 then getRecursiveContents path
97 else return [path]
98 return (concat paths)
99 where
100 isProper = not . (== '.') . head
102-- | A filter that takes all file names with a given extension. Prefix the
103-- extension with a dot:
104--
105-- > havingExtension ".markdown" [ "index.markdown"
106-- > , "style.css"
107-- > ] == ["index.markdown"]
108havingExtension :: String -> [FilePath] -> [FilePath]
109havingExtension extension = filter ((==) extension . takeExtension)
111-- | Perform a Hakyll action on every file in a given directory.
112directory :: (FilePath -> Hakyll ()) -> FilePath -> Hakyll ()
113directory action dir = getRecursiveContents dir >>= mapM_ action
115-- | Check if a file is newer then a number of given files.
116isMoreRecent :: FilePath -- ^ The cached file.
117 -> [FilePath] -- ^ Dependencies of the cached file.
118 -> Hakyll Bool
119isMoreRecent file depends = do
120 exists <- liftIO $ doesFileExist file
121 if not exists
122 then return False
123 else do dependsModified <- liftIO $ mapM getModificationTime depends
124 fileModified <- liftIO $ getModificationTime file
125 return (fileModified >= maximum dependsModified)