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
|
From 0509d4383c328c20be61cf3e3bbc98a0a1161588 Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Thu, 16 Oct 2014 02:21:17 +0000
Subject: [PATCH] hack TH
---
Text/Hamlet.hs | 86 +++++++++++++++++-----------------------------------
Text/Hamlet/Parse.hs | 3 +-
2 files changed, 29 insertions(+), 60 deletions(-)
diff --git a/Text/Hamlet.hs b/Text/Hamlet.hs
index 9500ecb..ec8471a 100644
--- a/Text/Hamlet.hs
+++ b/Text/Hamlet.hs
@@ -11,36 +11,36 @@
module Text.Hamlet
( -- * Plain HTML
Html
- , shamlet
- , shamletFile
- , xshamlet
- , xshamletFile
+ --, shamlet
+ --, shamletFile
+ --, xshamlet
+ --, xshamletFile
-- * Hamlet
, HtmlUrl
- , hamlet
- , hamletFile
- , hamletFileReload
- , ihamletFileReload
- , xhamlet
- , xhamletFile
+ --, hamlet
+ --, hamletFile
+ --, hamletFileReload
+ --, ihamletFileReload
+ --, xhamlet
+ --, xhamletFile
-- * I18N Hamlet
, HtmlUrlI18n
- , ihamlet
- , ihamletFile
+ --, ihamlet
+ --, ihamletFile
-- * Type classes
, ToAttributes (..)
-- * Internal, for making more
, HamletSettings (..)
, NewlineStyle (..)
- , hamletWithSettings
- , hamletFileWithSettings
+ --, hamletWithSettings
+ --, hamletFileWithSettings
, defaultHamletSettings
, xhtmlHamletSettings
- , Env (..)
- , HamletRules (..)
- , hamletRules
- , ihamletRules
- , htmlRules
+ --, Env (..)
+ --, HamletRules (..)
+ --, hamletRules
+ --, ihamletRules
+ --, htmlRules
, CloseStyle (..)
-- * Used by generated code
, condH
@@ -110,47 +110,9 @@ type HtmlUrl url = Render url -> Html
-- | A function generating an 'Html' given a message translator and a URL rendering function.
type HtmlUrlI18n msg url = Translate msg -> Render url -> Html
-docsToExp :: Env -> HamletRules -> Scope -> [Doc] -> Q Exp
-docsToExp env hr scope docs = do
- exps <- mapM (docToExp env hr scope) docs
- case exps of
- [] -> [|return ()|]
- [x] -> return x
- _ -> return $ DoE $ map NoBindS exps
-
unIdent :: Ident -> String
unIdent (Ident s) = s
-bindingPattern :: Binding -> Q (Pat, [(Ident, Exp)])
-bindingPattern (BindAs i@(Ident s) b) = do
- name <- newName s
- (pattern, scope) <- bindingPattern b
- return (AsP name pattern, (i, VarE name):scope)
-bindingPattern (BindVar i@(Ident s))
- | all isDigit s = do
- return (LitP $ IntegerL $ read s, [])
- | otherwise = do
- name <- newName s
- return (VarP name, [(i, VarE name)])
-bindingPattern (BindTuple is) = do
- (patterns, scopes) <- fmap unzip $ mapM bindingPattern is
- return (TupP patterns, concat scopes)
-bindingPattern (BindList is) = do
- (patterns, scopes) <- fmap unzip $ mapM bindingPattern is
- return (ListP patterns, concat scopes)
-bindingPattern (BindConstr con is) = do
- (patterns, scopes) <- fmap unzip $ mapM bindingPattern is
- return (ConP (mkConName con) patterns, concat scopes)
-bindingPattern (BindRecord con fields wild) = do
- let f (Ident field,b) =
- do (p,s) <- bindingPattern b
- return ((mkName field,p),s)
- (patterns, scopes) <- fmap unzip $ mapM f fields
- (patterns1, scopes1) <- if wild
- then bindWildFields con $ map fst fields
- else return ([],[])
- return (RecP (mkConName con) (patterns++patterns1), concat scopes ++ scopes1)
-
mkConName :: DataConstr -> Name
mkConName = mkName . conToStr
@@ -158,6 +120,7 @@ conToStr :: DataConstr -> String
conToStr (DCUnqualified (Ident x)) = x
conToStr (DCQualified (Module xs) (Ident x)) = intercalate "." $ xs ++ [x]
+{-
-- Wildcards bind all of the unbound fields to variables whose name
-- matches the field name.
--
@@ -296,10 +259,12 @@ hamlet = hamletWithSettings hamletRules defaultHamletSettings
xhamlet :: QuasiQuoter
xhamlet = hamletWithSettings hamletRules xhtmlHamletSettings
+-}
asHtmlUrl :: HtmlUrl url -> HtmlUrl url
asHtmlUrl = id
+{-
hamletRules :: Q HamletRules
hamletRules = do
i <- [|id|]
@@ -360,6 +325,7 @@ hamletFromString :: Q HamletRules -> HamletSettings -> String -> Q Exp
hamletFromString qhr set s = do
hr <- qhr
hrWithEnv hr $ \env -> docsToExp env hr [] $ docFromString set s
+-}
docFromString :: HamletSettings -> String -> [Doc]
docFromString set s =
@@ -367,6 +333,7 @@ docFromString set s =
Error s' -> error s'
Ok (_, d) -> d
+{-
hamletFileWithSettings :: Q HamletRules -> HamletSettings -> FilePath -> Q Exp
hamletFileWithSettings qhr set fp = do
#ifdef GHC_7_4
@@ -408,6 +375,7 @@ strToExp s@(c:_)
| isUpper c = ConE $ mkName s
| otherwise = VarE $ mkName s
strToExp "" = error "strToExp on empty string"
+-}
-- | Checks for truth in the left value in each pair in the first argument. If
-- a true exists, then the corresponding right action is performed. Only the
@@ -452,7 +420,7 @@ hamletUsedIdentifiers settings =
data HamletRuntimeRules = HamletRuntimeRules {
hrrI18n :: Bool
}
-
+{-
hamletFileReloadWithSettings :: HamletRuntimeRules
-> HamletSettings -> FilePath -> Q Exp
hamletFileReloadWithSettings hrr settings fp = do
@@ -479,7 +447,7 @@ hamletFileReloadWithSettings hrr settings fp = do
c VTUrlParam = [|EUrlParam|]
c VTMixin = [|\r -> EMixin $ \c -> r c|]
c VTMsg = [|EMsg|]
-
+-}
-- move to Shakespeare.Base?
readFileUtf8 :: FilePath -> IO String
readFileUtf8 fp = fmap TL.unpack $ readUtf8File fp
diff --git a/Text/Hamlet/Parse.hs b/Text/Hamlet/Parse.hs
index b7e2954..1f14946 100644
--- a/Text/Hamlet/Parse.hs
+++ b/Text/Hamlet/Parse.hs
@@ -616,6 +616,7 @@ data NewlineStyle = NoNewlines -- ^ never add newlines
| DefaultNewlineStyle
deriving Show
+{-
instance Lift NewlineStyle where
lift NoNewlines = [|NoNewlines|]
lift NewlinesText = [|NewlinesText|]
@@ -627,7 +628,7 @@ instance Lift (String -> CloseStyle) where
instance Lift HamletSettings where
lift (HamletSettings a b c d) = [|HamletSettings $(lift a) $(lift b) $(lift c) $(lift d)|]
-
+-}
htmlEmptyTags :: Set String
htmlEmptyTags = Set.fromAscList
--
2.1.1
|
