1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
|
-- | A module containing various function for manipulating and examinating
-- files and directories.
module Text.Hakyll.File
( toDestination
, toCache
, toURL
, toRoot
, removeSpaces
, makeDirectories
, getRecursiveContents
, sortByBaseName
, havingExtension
, isMoreRecent
, directory
) where
import System.Directory
import System.FilePath
import Control.Monad
import Data.List (isPrefixOf, sortBy)
import Control.Monad.Reader (liftIO)
import Text.Hakyll.Hakyll
-- | 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
-- (default: @_site@).
toDestination :: FilePath -> Hakyll FilePath
toDestination path = do dir <- askHakyll siteDirectory
return $ dir </> removeLeadingSeparator path
-- | Convert a relative filepath to a filepath in the cache
-- (default: @_cache@).
toCache :: FilePath -> Hakyll FilePath
toCache path = do dir <- askHakyll cacheDirectory
return $ dir </> removeLeadingSeparator path
-- | Get the url for a given page.
toURL :: FilePath -> FilePath
toURL path = if takeExtension path `elem` [ ".markdown"
, ".md"
, ".mdn"
, ".mdwn"
, ".mkd"
, ".mkdn"
, ".mkdwn"
, ".rst"
, ".text"
, ".tex"
, ".lhs"
]
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 -> Hakyll ()
makeDirectories path = liftIO $ 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 -> Hakyll [FilePath]
getRecursiveContents topdir = do
names <- liftIO $ getDirectoryContents topdir
let properNames = filter isProper names
paths <- forM properNames $ \name -> do
let path = topdir </> name
isDirectory <- liftIO $ doesDirectoryExist path
if isDirectory
then getRecursiveContents path
else return [path]
return (concat paths)
where
isProper = not . (== '.') . head
-- | Sort a list of filenames on the basename.
sortByBaseName :: [FilePath] -> [FilePath]
sortByBaseName = sortBy compareBaseName
where
compareBaseName f1 f2 = compare (takeFileName f1) (takeFileName f2)
-- | 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 a Hakyll action on every file in a given directory.
directory :: (FilePath -> Hakyll ()) -> FilePath -> Hakyll ()
directory action dir = getRecursiveContents dir >>= mapM_ action
-- | Check if a file is newer then a number of given files.
isMoreRecent :: FilePath -- ^ The cached file.
-> [FilePath] -- ^ Dependencies of the cached file.
-> Hakyll Bool
isMoreRecent file depends = do
exists <- liftIO $ doesFileExist file
if not exists
then return False
else do dependsModified <- liftIO $ mapM getModificationTime depends
fileModified <- liftIO $ getModificationTime file
return (fileModified >= maximum dependsModified)
|
