1
+ {-# LANGUAGE BlockArguments #-}
2
+
1
3
module Hemmet.Dom.Template where
2
4
3
5
import Data.Char
4
6
import Data.Text hiding (map )
7
+ import Data.Maybe (isJust )
5
8
6
9
import Hemmet.Megaparsec
7
10
import Hemmet.Tree
@@ -10,37 +13,59 @@ import Text.Megaparsec.Char.Lexer (decimal)
10
13
import Hemmet.Dom.Tree
11
14
12
15
newtype Template =
13
- Template [Tag ]
16
+ Template [Element ]
14
17
deriving (Show , Eq )
15
18
16
19
instance ToTree Template DomPayload where
17
20
toTree = toTree'
18
21
19
- data Tag =
22
+ data Element =
20
23
Tag
21
24
{ _tName :: ! Text
22
25
, _tId :: ! (Maybe Text )
23
26
, _tClasses :: ! [Text ]
24
- , _tChilds :: [Tag ]
25
- } deriving (Show , Eq )
27
+ , _tChilds :: [Element ]
28
+ }
29
+ | PlainText ! Text
30
+ deriving (Show , Eq )
26
31
27
- template :: Parser Template
28
- template = Template <$> (Prelude. concat <$> many_ tag) <* eof
29
32
33
+ template :: Parser Template
34
+ template = Template <$> (Prelude. concat <$> many_ element) <* eof
30
35
36
+ element :: Parser [Element ]
37
+ element = try tag <|> plainText
31
38
32
- tag :: Parser [Tag ]
39
+ tag :: Parser [Element ]
33
40
tag = do
34
41
-- Order of attributes to parse is fixed, not arbitrary, like in Emmet.
35
42
-- This is design decision.
36
43
_tName <- try_ identifier
37
44
_tId <- try_ (Just <$> (char ' #' *> kebabCasedName)) <|> pure Nothing
38
45
_tClasses <- many $ char ' .' *> kebabCasedName
39
46
multiplicity <- char ' *' *> decimal <|> pure 1
40
- _tChilds <- Prelude. concat <$> try_ childs
41
- return $ Prelude. replicate multiplicity $ Tag {.. }
47
+ text <- optional curlyBraces
48
+ childs <- Prelude. concat <$> try_ childsParser
49
+ -- Text in curly braces is interpreted as the first child (as in Emmet)
50
+ let _tChilds = case text of
51
+ Just t -> PlainText t: childs
52
+ Nothing -> childs
53
+ let notEmpty = not (Data.Text. null _tName)
54
+ || isJust _tId
55
+ || not (Prelude. null _tClasses)
56
+ if notEmpty
57
+ then return $ Prelude. replicate multiplicity $ Tag {.. }
58
+ else fail " Tag is empty!"
59
+ where
60
+ childsParser = char ' >' *> many_ element
61
+
62
+ plainText :: Parser [Element ]
63
+ plainText = (: [] ) . PlainText <$> curlyBraces
64
+
65
+ curlyBraces :: Parser Text
66
+ curlyBraces = textBetween ' {' ' }'
42
67
where
43
- childs = char ' > ' *> many_ tag
68
+ textBetween a b = between ( char a) (char b) (takeWhileP Nothing ( /= b))
44
69
45
70
identifier :: Parser Text
46
71
identifier = cons <$> firstChar <*> (pack <$> many restChar)
@@ -64,7 +89,8 @@ try_ = (<|> pure mempty)
64
89
65
90
-- transrormation to Tree
66
91
toTree' :: Template -> Tree DomPayload
67
- toTree' (Template bs) = DomPayload Nothing [] $ map fromTag bs
92
+ toTree' (Template bs) = DomTag Nothing [] $ map fromElement bs
68
93
69
- fromTag :: Tag -> Node DomPayload
70
- fromTag (Tag n i cls cs) = Node n $ DomPayload i cls $ map fromTag cs
94
+ fromElement :: Element -> Node DomPayload
95
+ fromElement (Tag n i cls cs) = Node n $ DomTag i cls $ map fromElement cs
96
+ fromElement (PlainText text) = Node " " $ DomPlainText text
0 commit comments