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
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
|
{-|
Module : $Header$
Description : Basic functions for dealing with mustache templates.
Copyright : (c) Justus Adam, 2015
License : BSD3
Maintainer : dev@justus.science
Stability : experimental
Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-missing-fields #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module Text.Mustache.Compile
( automaticCompile, localAutomaticCompile, TemplateCache, compileTemplateWithCache
, compileTemplate, cacheFromList, getPartials, mustache, embedTemplate, embedSingleTemplate
) where
import Control.Arrow ((&&&))
import Control.Monad
import Control.Monad.Except
import Control.Monad.State
import Data.Bool
import Data.HashMap.Strict as HM
import Data.Text hiding (concat, find, map, uncons)
import qualified Data.Text.IO as TIO
import Language.Haskell.TH (Exp, Loc, Q, loc_filename,
loc_start, location)
import Language.Haskell.TH.Quote (QuasiQuoter (QuasiQuoter),
quoteExp)
import qualified Language.Haskell.TH.Syntax as THS
import System.Directory
import System.FilePath
import Text.Mustache.Parser
import Text.Mustache.Types
import Text.Parsec.Error
import Text.Parsec.Pos
import Text.Printf
{-|
Compiles a mustache template provided by name including the mentioned partials.
The same can be done manually using 'getFile', 'mustacheParser' and 'getPartials'.
This function also ensures each partial is only compiled once even though it may
be included by other partials including itself.
A reference to the included template will be found in each including templates
'partials' section.
-}
automaticCompile :: [FilePath] -> FilePath -> IO (Either ParseError Template)
automaticCompile searchSpace = compileTemplateWithCache searchSpace mempty
-- | Compile the template with the search space set to only the current directory
localAutomaticCompile :: FilePath -> IO (Either ParseError Template)
localAutomaticCompile = automaticCompile ["."]
{-|
Compile a mustache template providing a list of precompiled templates that do
not have to be recompiled.
-}
compileTemplateWithCache :: [FilePath]
-> TemplateCache
-> FilePath
-> IO (Either ParseError Template)
compileTemplateWithCache searchSpace templates initName =
runExceptT $ evalStateT (compile' initName) $ flattenPartials templates
where
compile' :: FilePath
-> StateT
(HM.HashMap String Template)
(ExceptT ParseError IO)
Template
compile' name' = do
templates' <- get
case HM.lookup name' templates' of
Just template -> return template
Nothing -> do
rawSource <- lift $ getFile searchSpace name'
compiled@(Template { ast = mSTree }) <-
lift $ ExceptT . pure $ compileTemplate name' rawSource
foldM
(\st@(Template { partials = p }) partialName -> do
nt <- compile' partialName
modify (HM.insert partialName nt)
return (st { partials = HM.insert partialName nt p })
)
compiled
(getPartials mSTree)
-- | Flatten a list of Templates into a single 'TemplateCache'
cacheFromList :: [Template] -> TemplateCache
cacheFromList = flattenPartials . fromList . fmap (name &&& id)
-- | Compiles a 'Template' directly from 'Text' without checking for missing partials.
-- the result will be a 'Template' with an empty 'partials' cache.
compileTemplate :: String -> Text -> Either ParseError Template
compileTemplate name' = fmap (flip (Template name') mempty) . parse name'
{-|
Find the names of all included partials in a mustache STree.
Same as @join . fmap getPartials'@
-}
getPartials :: STree -> [FilePath]
getPartials = join . fmap getPartials'
{-|
Find partials in a single Node
-}
getPartials' :: Node Text -> [FilePath]
getPartials' (Partial _ p) = return p
getPartials' (Section _ n) = getPartials n
getPartials' (InvertedSection _ n) = getPartials n
getPartials' _ = mempty
flattenPartials :: TemplateCache -> TemplateCache
flattenPartials m = foldrWithKey (insertWith (\_ b -> b)) m m
{-|
@getFile searchSpace file@ iteratively searches all directories in
@searchSpace@ for a @file@ returning it if found or raising an error if none
of the directories contain the file.
This trows 'ParseError's to be compatible with the internal Either Monad of
'compileTemplateWithCache'.
-}
getFile :: [FilePath] -> FilePath -> ExceptT ParseError IO Text
getFile [] fp = throwError $ fileNotFound fp
getFile (templateDir : xs) fp =
lift (doesFileExist filePath) >>=
bool
(getFile xs fp)
(lift $ TIO.readFile filePath)
where
filePath = templateDir </> fp
-- |
-- Compile a mustache 'Template' at compile time. Usage:
--
-- > {-# LANGUAGE QuasiQuotes #-}
-- > import Text.Mustache.Compile (mustache)
-- >
-- > foo :: Template
-- > foo = [mustache|This is my inline {{ template }} created at compile time|]
--
-- Partials are not supported in the QuasiQuoter
mustache :: QuasiQuoter
mustache = QuasiQuoter {quoteExp = \unprocessedTemplate -> do
l <- location
compileTemplateTH (fileAndLine l) unprocessedTemplate }
-- |
-- Compile a mustache 'Template' at compile time providing a search space for any partials. Usage:
--
-- > {-# LANGUAGE TemplateHaskell #-}
-- > import Text.Mustache.Compile (embedTemplate)
-- >
-- > foo :: Template
-- > foo = $(embedTemplate ["dir", "dir/partials"] "file.mustache")
--
embedTemplate :: [FilePath] -> FilePath -> Q Exp
embedTemplate searchSpace filename = do
template <- either (fail . ("Parse error in mustache template: " ++) . show) pure =<< THS.runIO (automaticCompile searchSpace filename)
let possiblePaths = do
fname <- (filename:) . HM.keys . partials $ template
path <- searchSpace
pure $ path </> fname
mapM_ addDependentRelativeFile =<< THS.runIO (filterM doesFileExist possiblePaths)
THS.lift template
-- |
-- Compile a mustache 'Template' at compile time. Usage:
--
-- > {-# LANGUAGE TemplateHaskell #-}
-- > import Text.Mustache.Compile (embedSingleTemplate)
-- >
-- > foo :: Template
-- > foo = $(embedSingleTemplate "dir/file.mustache")
--
-- Partials are not supported in embedSingleTemplate
embedSingleTemplate :: FilePath -> Q Exp
embedSingleTemplate filePath = do
addDependentRelativeFile filePath
compileTemplateTH filePath =<< THS.runIO (readFile filePath)
fileAndLine :: Loc -> String
fileAndLine loc = loc_filename loc ++ ":" ++ (show . fst . loc_start $ loc)
compileTemplateTH :: String -> String -> Q Exp
compileTemplateTH filename unprocessed =
either (fail . ("Parse error in mustache template: " ++) . show) THS.lift $ compileTemplate filename (pack unprocessed)
addDependentRelativeFile :: FilePath -> Q ()
addDependentRelativeFile = THS.qAddDependentFile <=< THS.runIO . makeAbsolute
-- ERRORS
fileNotFound :: FilePath -> ParseError
fileNotFound fp = newErrorMessage (Message $ printf "Template file '%s' not found" fp) (initialPos fp)
|
