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
|
-- | 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)
import Text.Hakyll.Hakyll (Hakyll)
import Control.Monad.Reader (liftIO)
-- | 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 -> 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
-- | 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 = do
contents <- getRecursiveContents dir
mapM_ action contents
-- | Check if a cache file is still valid.
isCacheValid :: FilePath -> [FilePath] -> Hakyll Bool
isCacheValid cache depends = do
exists <- liftIO $ doesFileExist cache
if not exists
then return False
else do dependsModified <- liftIO $ mapM getModificationTime depends
cacheModified <- liftIO $ getModificationTime cache
return (cacheModified >= maximum dependsModified)
|
