Curly braces initial rendering astynax#4

src/Hemmet/Dom/Rendering.hs

@@ -24,7 +24,7 @@ renderHtmlM :: Renderer DomPayload
 renderHtmlM = run renderHtmlM'
 
 renderHtmlM' :: NodeRenderer
-renderHtmlM' (Node name (DomPayload mbId classes childs)) = do
+renderHtmlM' (Node name (DomTag mbId classes childs)) = do
   let tagName = if name == "" then "div" else name
   pad
   out $ "<" <> tagName
@@ -39,6 +39,10 @@ renderHtmlM' (Node name (DomPayload mbId classes childs)) = do
     pad
   out ("</" <> tagName <> ">")
   nl
+renderHtmlM' (Node _ (DomPlainText text)) = do
+  pad
+  out text
+  nl
 
 renderCssM :: Renderer DomPayload
 renderCssM = run renderCssM'
@@ -60,7 +64,7 @@ renderElmM :: Renderer DomPayload
 renderElmM = run $ renderElmM' pad
 
 renderElmM' :: RendererM -> NodeRenderer
-renderElmM' fstPad (Node name (DomPayload mbId classes childs)) = do
+renderElmM' fstPad (Node name (DomTag mbId classes childs)) = do
   let tagName = if name == "" then "div" else name
   fstPad >> out (tagName <> " " <> tagAttrs)
   case childs of
@@ -81,12 +85,16 @@ renderElmM' fstPad (Node name (DomPayload mbId classes childs)) = do
     tagAttrs = case tagId <> tagClasses of
       [] -> "[]"
       as -> "[ " <> T.intercalate ", " as <> " ]"
+renderElmM' fstPad (Node _ (DomPlainText text)) = do
+  fstPad
+  out $ "text \"" <> text <> "\""
+  nl
 
 renderLucidM :: Renderer DomPayload
 renderLucidM = run renderLucidM'
 
 renderLucidM' :: NodeRenderer
-renderLucidM' (Node name (DomPayload mbId classes childs)) = do
+renderLucidM' (Node name (DomTag mbId classes childs)) = do
   let tagName = if name == "" then "div_" else name <> "_"
   pad
   out tagName
@@ -107,3 +115,7 @@ renderLucidM' (Node name (DomPayload mbId classes childs)) = do
           [x] -> ["class_ " <> quoted x]
           xs  -> ["classes_ " <> listish (L.map quoted xs)]
         )
+renderLucidM' (Node _ (DomPlainText text)) = do
+  pad
+  out $ "\"" <> text <> "\""
+  nl

src/Hemmet/Dom/Rendering/Common.hs

@@ -20,8 +20,9 @@ run :: NodeRenderer -> Renderer DomPayload
 run r = traverse_ r . _dpChilds
 
 allClasses :: Node DomPayload -> [Text]
-allClasses (Node _ (DomPayload _ classes childs)) =
+allClasses (Node _ (DomTag _ classes childs)) =
   L.nub $ classes <> L.concatMap allClasses childs
+allClasses (Node _ (DomPlainText _)) = []
 
 annotateLast :: [a] -> [(a, Bool)]
 annotateLast xs = L.zip xs $ L.map (const False) (L.tail xs) <> [True]

src/Hemmet/Dom/Rendering/KotlinxHtml.hs

@@ -13,13 +13,13 @@ import Hemmet.Dom.Tree
 renderKotlinxHtmlM :: Renderer DomPayload
 renderKotlinxHtmlM = run render
   where
-    render (Node name payload) = do
+    render (Node name (DomTag mbId classes childs)) = do
       let tagName = if name == "" then "div" else name
       pad
       out $ tagName <> " {"
-      case payload of
-        DomPayload Nothing [] []       -> pure ()
-        DomPayload mbId classes childs -> do
+      case (mbId, classes, childs) of
+        (Nothing, [], []) -> pure ()
+        _                 -> do
           nl
           withOffset 4 $ do
             case mbId of
@@ -39,3 +39,7 @@ renderKotlinxHtmlM = run render
           pad
       out "}"
       nl
+    render (Node _ (DomPlainText text)) = do
+      pad
+      out $ "+\"" <> text <> "\""
+      nl

src/Hemmet/Dom/Rendering/Shakespeare.hs

@@ -3,6 +3,7 @@ module Hemmet.Dom.Rendering.Shakespeare where
 import Control.Monad
 import Data.Foldable
 import qualified Data.List as L
+import qualified Data.Text as T
 
 import Hemmet.Rendering
 import Hemmet.Tree
@@ -13,7 +14,7 @@ import Hemmet.Dom.Tree
 renderHamletM :: Renderer DomPayload
 renderHamletM = run render
   where
-    render (Node name (DomPayload mbId classes childs)) = do
+    render (Node name (DomTag mbId classes childs)) = do
       let tagName = if name == "" then "div" else name
       pad
       out $ "<" <> tagName
@@ -26,6 +27,14 @@ renderHamletM = run render
       nl
       unless (L.null childs) $ do
         withOffset 2 $ traverse_ render childs
+    render (Node _ (DomPlainText text)) = do
+      pad
+      out $ escaping text
+      nl
+    escaping text = suffix <> text <> postfix
+      where
+        suffix = if T.head text == ' ' then "\\" else ""
+        postfix = if T.last text == ' ' then "#" else ""
 
 renderCassiusM :: Renderer DomPayload
 renderCassiusM = run (render . annotateLast . L.sort . allClasses)

src/Hemmet/Dom/Template.hs

@@ -1,7 +1,10 @@
+{-# LANGUAGE BlockArguments #-}
+
 module Hemmet.Dom.Template where
 
 import Data.Char
 import Data.Text hiding (map)
+import Data.Maybe (isJust)
 
 import Hemmet.Megaparsec
 import Hemmet.Tree
@@ -10,37 +13,59 @@ import Text.Megaparsec.Char.Lexer (decimal)
 import Hemmet.Dom.Tree
 
 newtype Template =
-  Template [Tag]
+  Template [Element]
   deriving (Show, Eq)
 
 instance ToTree Template DomPayload where
   toTree = toTree'
 
-data Tag =
+data Element =
   Tag
   { _tName    :: !Text
   , _tId      :: !(Maybe Text)
   , _tClasses :: ![Text]
-  , _tChilds  :: [Tag]
-  } deriving (Show, Eq)
+  , _tChilds  :: [Element]
+  }
+  | PlainText !Text
+  deriving (Show, Eq)
 
-template :: Parser Template
-template = Template <$> (Prelude.concat <$> many_ tag) <* eof
 
+template :: Parser Template
+template = Template <$> (Prelude.concat <$> many_ element) <* eof
 
+element :: Parser [Element]
+element = try tag <|> plainText
 
-tag :: Parser [Tag]
+tag :: Parser [Element]
 tag = do
   -- Order of attributes to parse is fixed, not arbitrary, like in Emmet.
   -- This is design decision.
   _tName <- try_ identifier
   _tId <- try_ (Just <$> (char '#' *> kebabCasedName)) <|> pure Nothing
   _tClasses <- many $ char '.' *> kebabCasedName
   multiplicity <- char '*' *> decimal <|> pure 1
-  _tChilds <- Prelude.concat <$> try_ childs
-  return $ Prelude.replicate multiplicity $ Tag {..}
+  text <- optional curlyBraces
+  childs <- Prelude.concat <$> try_ childsParser
+  -- Text in curly braces is interpreted as the first child (as in Emmet)
+  let _tChilds = case text of
+                  Just t -> PlainText t:childs
+                  Nothing -> childs
+  let notEmpty = not (Data.Text.null _tName)
+                 || isJust _tId
+                 || not (Prelude.null _tClasses)
+  if notEmpty
+    then return $ Prelude.replicate multiplicity $ Tag {..}
+    else fail "Tag is empty!"
+  where
+    childsParser = char '>' *> many_ element
+
+plainText :: Parser [Element]
+plainText = (:[]) . PlainText <$> curlyBraces
+
+curlyBraces :: Parser Text
+curlyBraces = textBetween '{' '}'
   where
-    childs = char '>' *> many_ tag
+    textBetween a b = between (char a) (char b) (takeWhileP Nothing (/= b))
 
 identifier :: Parser Text
 identifier = cons <$> firstChar <*> (pack <$> many restChar)
@@ -64,7 +89,8 @@ try_ = (<|> pure mempty)
 
 -- transrormation to Tree
 toTree' :: Template -> Tree DomPayload
-toTree' (Template bs) = DomPayload Nothing [] $ map fromTag bs
+toTree' (Template bs) = DomTag Nothing [] $ map fromElement bs
 
-fromTag :: Tag -> Node DomPayload
-fromTag (Tag n i cls cs) = Node n $ DomPayload i cls $ map fromTag cs
+fromElement :: Element -> Node DomPayload
+fromElement (Tag n i cls cs) = Node n $ DomTag i cls $ map fromElement cs
+fromElement (PlainText text) = Node "" $ DomPlainText text

src/Hemmet/Dom/Tree.hs

@@ -8,11 +8,11 @@ import Hemmet.Tree
 
 type DomTree = Tree DomPayload
 
-data DomPayload a = DomPayload
+data DomPayload a = DomTag
   { _dpId      :: !(Maybe Text)
   , _dpClasses :: ![Text]
   , _dpChilds  :: ![a]
-  }
+  } | DomPlainText !Text
 
 deriving instance Eq a => Eq (DomPayload a)
 

test/Spec.hs

@@ -30,8 +30,16 @@ makeUnitTests =
 domParserSpec :: Spec
 domParserSpec =
   describe "parse BEM.template" $ do
+    it "empty string" $ do
+      "" `shouldMean` []
     it "parses multiplicity" $ do
       "a>b*2" `shouldMean` [tag "a" [tag "b" [], tag "b" []]]
+    it "parses curly braces in tag" $ do
+      "a>b{text}" `shouldMean` [tag "a" [tag "b" [Dom.PlainText "text"]]]
+    it "parses curly braces in children" $ do
+      "a>{text}+{text2}" `shouldMean` [
+          tag "a" [Dom.PlainText "text", Dom.PlainText "text2"]
+        ]
     where
       shouldMean s bs = q s `shouldBe` Just (Dom.Template bs)
       q = either (const Nothing) Just . parse Dom.template "foo"

test/tests/dom/complex.elm.golden

@@ -5,5 +5,8 @@ div [ id "container" ]
             , li [ class "item" ] []
             ]
         ]
-    , div [ id "content", class "width-800", class "selected" ] []
+    , div [ id "content", class "width-800", class "selected" ]
+        [ text "text with space after "
+        , text " text with space before"
+        ]
     ]

test/tests/dom/complex.hamlet.golden

@@ -4,3 +4,5 @@
       <li.item>
       <li.item>
   <div#content.width-800.selected>
+    text with space after #
+    \ text with space before

test/tests/dom/complex.hemmet

@@ -1 +1 @@
-#container>.nav>(ul.menu>li.item+li.item)+#content.width-800.selected
+#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

@@ -5,5 +5,8 @@
       <li class="item"></li>
     </ul>
   </div>
-  <div id="content" class="width-800 selected"></div>
+  <div id="content" class="width-800 selected">
+    text with space after 
+     text with space before
+  </div>
 </div>

test/tests/dom/complex.ktxhtml.golden

@@ -15,5 +15,7 @@ div {
     div {
         id = "content"
         classes = setOf("width-800", "selected")
+        +"text with space after "
+        +" text with space before"
     }
 }

test/tests/dom/complex.lucid.golden

@@ -3,4 +3,6 @@ div_ [id_ "container"] $ do
     ul_ [class_ "menu"] $ do
       li_ [class_ "item"]
       li_ [class_ "item"]
-  div_ [id_ "content", classes_ ["width-800", "selected"]]
+  div_ [id_ "content", classes_ ["width-800", "selected"]] $ do
+    "text with space after "
+    " text with space before"