Skip to content

Commit ba7e0e8

Browse files
committed
Curly braces initial rendering #4
1 parent 420e54a commit ba7e0e8

13 files changed

+100
-28
lines changed

src/Hemmet/Dom/Rendering.hs

+15-3
Original file line numberDiff line numberDiff line change
@@ -24,7 +24,7 @@ renderHtmlM :: Renderer DomPayload
2424
renderHtmlM = run renderHtmlM'
2525

2626
renderHtmlM' :: NodeRenderer
27-
renderHtmlM' (Node name (DomPayload mbId classes childs)) = do
27+
renderHtmlM' (Node name (DomTag mbId classes childs)) = do
2828
let tagName = if name == "" then "div" else name
2929
pad
3030
out $ "<" <> tagName
@@ -39,6 +39,10 @@ renderHtmlM' (Node name (DomPayload mbId classes childs)) = do
3939
pad
4040
out ("</" <> tagName <> ">")
4141
nl
42+
renderHtmlM' (Node _ (DomPlainText text)) = do
43+
pad
44+
out text
45+
nl
4246

4347
renderCssM :: Renderer DomPayload
4448
renderCssM = run renderCssM'
@@ -60,7 +64,7 @@ renderElmM :: Renderer DomPayload
6064
renderElmM = run $ renderElmM' pad
6165

6266
renderElmM' :: RendererM -> NodeRenderer
63-
renderElmM' fstPad (Node name (DomPayload mbId classes childs)) = do
67+
renderElmM' fstPad (Node name (DomTag mbId classes childs)) = do
6468
let tagName = if name == "" then "div" else name
6569
fstPad >> out (tagName <> " " <> tagAttrs)
6670
case childs of
@@ -81,12 +85,16 @@ renderElmM' fstPad (Node name (DomPayload mbId classes childs)) = do
8185
tagAttrs = case tagId <> tagClasses of
8286
[] -> "[]"
8387
as -> "[ " <> T.intercalate ", " as <> " ]"
88+
renderElmM' fstPad (Node _ (DomPlainText text)) = do
89+
fstPad
90+
out $ "text \"" <> text <> "\""
91+
nl
8492

8593
renderLucidM :: Renderer DomPayload
8694
renderLucidM = run renderLucidM'
8795

8896
renderLucidM' :: NodeRenderer
89-
renderLucidM' (Node name (DomPayload mbId classes childs)) = do
97+
renderLucidM' (Node name (DomTag mbId classes childs)) = do
9098
let tagName = if name == "" then "div_" else name <> "_"
9199
pad
92100
out tagName
@@ -107,3 +115,7 @@ renderLucidM' (Node name (DomPayload mbId classes childs)) = do
107115
[x] -> ["class_ " <> quoted x]
108116
xs -> ["classes_ " <> listish (L.map quoted xs)]
109117
)
118+
renderLucidM' (Node _ (DomPlainText text)) = do
119+
pad
120+
out $ "\"" <> text <> "\""
121+
nl

src/Hemmet/Dom/Rendering/Common.hs

+2-1
Original file line numberDiff line numberDiff line change
@@ -20,8 +20,9 @@ run :: NodeRenderer -> Renderer DomPayload
2020
run r = traverse_ r . _dpChilds
2121

2222
allClasses :: Node DomPayload -> [Text]
23-
allClasses (Node _ (DomPayload _ classes childs)) =
23+
allClasses (Node _ (DomTag _ classes childs)) =
2424
L.nub $ classes <> L.concatMap allClasses childs
25+
allClasses (Node _ (DomPlainText _)) = []
2526

2627
annotateLast :: [a] -> [(a, Bool)]
2728
annotateLast xs = L.zip xs $ L.map (const False) (L.tail xs) <> [True]

src/Hemmet/Dom/Rendering/KotlinxHtml.hs

+8-4
Original file line numberDiff line numberDiff line change
@@ -13,13 +13,13 @@ import Hemmet.Dom.Tree
1313
renderKotlinxHtmlM :: Renderer DomPayload
1414
renderKotlinxHtmlM = run render
1515
where
16-
render (Node name payload) = do
16+
render (Node name (DomTag mbId classes childs)) = do
1717
let tagName = if name == "" then "div" else name
1818
pad
1919
out $ tagName <> " {"
20-
case payload of
21-
DomPayload Nothing [] [] -> pure ()
22-
DomPayload mbId classes childs -> do
20+
case (mbId, classes, childs) of
21+
(Nothing, [], []) -> pure ()
22+
_ -> do
2323
nl
2424
withOffset 4 $ do
2525
case mbId of
@@ -39,3 +39,7 @@ renderKotlinxHtmlM = run render
3939
pad
4040
out "}"
4141
nl
42+
render (Node _ (DomPlainText text)) = do
43+
pad
44+
out $ "+\"" <> text <> "\""
45+
nl

src/Hemmet/Dom/Rendering/Shakespeare.hs

+10-1
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@ module Hemmet.Dom.Rendering.Shakespeare where
33
import Control.Monad
44
import Data.Foldable
55
import qualified Data.List as L
6+
import qualified Data.Text as T
67

78
import Hemmet.Rendering
89
import Hemmet.Tree
@@ -13,7 +14,7 @@ import Hemmet.Dom.Tree
1314
renderHamletM :: Renderer DomPayload
1415
renderHamletM = run render
1516
where
16-
render (Node name (DomPayload mbId classes childs)) = do
17+
render (Node name (DomTag mbId classes childs)) = do
1718
let tagName = if name == "" then "div" else name
1819
pad
1920
out $ "<" <> tagName
@@ -26,6 +27,14 @@ renderHamletM = run render
2627
nl
2728
unless (L.null childs) $ do
2829
withOffset 2 $ traverse_ render childs
30+
render (Node _ (DomPlainText text)) = do
31+
pad
32+
out $ escaping text
33+
nl
34+
escaping text = suffix <> text <> postfix
35+
where
36+
suffix = if T.head text == ' ' then "\\" else ""
37+
postfix = if T.last text == ' ' then "#" else ""
2938

3039
renderCassiusM :: Renderer DomPayload
3140
renderCassiusM = run (render . annotateLast . L.sort . allClasses)

src/Hemmet/Dom/Template.hs

+39-13
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,10 @@
1+
{-# LANGUAGE BlockArguments #-}
2+
13
module Hemmet.Dom.Template where
24

35
import Data.Char
46
import Data.Text hiding (map)
7+
import Data.Maybe (isJust)
58

69
import Hemmet.Megaparsec
710
import Hemmet.Tree
@@ -10,37 +13,59 @@ import Text.Megaparsec.Char.Lexer (decimal)
1013
import Hemmet.Dom.Tree
1114

1215
newtype Template =
13-
Template [Tag]
16+
Template [Element]
1417
deriving (Show, Eq)
1518

1619
instance ToTree Template DomPayload where
1720
toTree = toTree'
1821

19-
data Tag =
22+
data Element =
2023
Tag
2124
{ _tName :: !Text
2225
, _tId :: !(Maybe Text)
2326
, _tClasses :: ![Text]
24-
, _tChilds :: [Tag]
25-
} deriving (Show, Eq)
27+
, _tChilds :: [Element]
28+
}
29+
| PlainText !Text
30+
deriving (Show, Eq)
2631

27-
template :: Parser Template
28-
template = Template <$> (Prelude.concat <$> many_ tag) <* eof
2932

33+
template :: Parser Template
34+
template = Template <$> (Prelude.concat <$> many_ element) <* eof
3035

36+
element :: Parser [Element]
37+
element = try tag <|> plainText
3138

32-
tag :: Parser [Tag]
39+
tag :: Parser [Element]
3340
tag = do
3441
-- Order of attributes to parse is fixed, not arbitrary, like in Emmet.
3542
-- This is design decision.
3643
_tName <- try_ identifier
3744
_tId <- try_ (Just <$> (char '#' *> kebabCasedName)) <|> pure Nothing
3845
_tClasses <- many $ char '.' *> kebabCasedName
3946
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 '{' '}'
4267
where
43-
childs = char '>' *> many_ tag
68+
textBetween a b = between (char a) (char b) (takeWhileP Nothing (/= b))
4469

4570
identifier :: Parser Text
4671
identifier = cons <$> firstChar <*> (pack <$> many restChar)
@@ -64,7 +89,8 @@ try_ = (<|> pure mempty)
6489

6590
-- transrormation to Tree
6691
toTree' :: Template -> Tree DomPayload
67-
toTree' (Template bs) = DomPayload Nothing [] $ map fromTag bs
92+
toTree' (Template bs) = DomTag Nothing [] $ map fromElement bs
6893

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

src/Hemmet/Dom/Tree.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -8,11 +8,11 @@ import Hemmet.Tree
88

99
type DomTree = Tree DomPayload
1010

11-
data DomPayload a = DomPayload
11+
data DomPayload a = DomTag
1212
{ _dpId :: !(Maybe Text)
1313
, _dpClasses :: ![Text]
1414
, _dpChilds :: ![a]
15-
}
15+
} | DomPlainText !Text
1616

1717
deriving instance Eq a => Eq (DomPayload a)
1818

test/Spec.hs

+8
Original file line numberDiff line numberDiff line change
@@ -30,8 +30,16 @@ makeUnitTests =
3030
domParserSpec :: Spec
3131
domParserSpec =
3232
describe "parse BEM.template" $ do
33+
it "empty string" $ do
34+
"" `shouldMean` []
3335
it "parses multiplicity" $ do
3436
"a>b*2" `shouldMean` [tag "a" [tag "b" [], tag "b" []]]
37+
it "parses curly braces in tag" $ do
38+
"a>b{text}" `shouldMean` [tag "a" [tag "b" [Dom.PlainText "text"]]]
39+
it "parses curly braces in children" $ do
40+
"a>{text}+{text2}" `shouldMean` [
41+
tag "a" [Dom.PlainText "text", Dom.PlainText "text2"]
42+
]
3543
where
3644
shouldMean s bs = q s `shouldBe` Just (Dom.Template bs)
3745
q = either (const Nothing) Just . parse Dom.template "foo"

test/tests/dom/complex.elm.golden

+4-1
Original file line numberDiff line numberDiff line change
@@ -5,5 +5,8 @@ div [ id "container" ]
55
, li [ class "item" ] []
66
]
77
]
8-
, div [ id "content", class "width-800", class "selected" ] []
8+
, div [ id "content", class "width-800", class "selected" ]
9+
[ text "text with space after "
10+
, text " text with space before"
11+
]
912
]

test/tests/dom/complex.hamlet.golden

+2
Original file line numberDiff line numberDiff line change
@@ -4,3 +4,5 @@
44
<li.item>
55
<li.item>
66
<div#content.width-800.selected>
7+
text with space after #
8+
\ text with space before

test/tests/dom/complex.hemmet

+1-1
Original file line numberDiff line numberDiff line change
@@ -1 +1 @@
1-
#container>.nav>(ul.menu>li.item+li.item)+#content.width-800.selected
1+
#container>.nav>(ul.menu>li.item+li.item)+#content.width-800.selected>{text with space after }+{ text with space before}

test/tests/dom/complex.html.golden

+4-1
Original file line numberDiff line numberDiff line change
@@ -5,5 +5,8 @@
55
<li class="item"></li>
66
</ul>
77
</div>
8-
<div id="content" class="width-800 selected"></div>
8+
<div id="content" class="width-800 selected">
9+
text with space after
10+
text with space before
11+
</div>
912
</div>

test/tests/dom/complex.ktxhtml.golden

+2
Original file line numberDiff line numberDiff line change
@@ -15,5 +15,7 @@ div {
1515
div {
1616
id = "content"
1717
classes = setOf("width-800", "selected")
18+
+"text with space after "
19+
+" text with space before"
1820
}
1921
}

test/tests/dom/complex.lucid.golden

+3-1
Original file line numberDiff line numberDiff line change
@@ -3,4 +3,6 @@ div_ [id_ "container"] $ do
33
ul_ [class_ "menu"] $ do
44
li_ [class_ "item"]
55
li_ [class_ "item"]
6-
div_ [id_ "content", classes_ ["width-800", "selected"]]
6+
div_ [id_ "content", classes_ ["width-800", "selected"]] $ do
7+
"text with space after "
8+
" text with space before"

0 commit comments

Comments
 (0)