Support curly braces

hemmet.cabal

@@ -91,7 +91,7 @@ executable hemmeti
                   app/common
   other-modules: Hemmet.Cli
                , Hemmet.Tui
-  build-depends: brick ^>=1.0
+  build-depends: brick
                , microlens
                , megaparsec
                , mtl

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,40 +1,71 @@
+{-# 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
+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 <$> many_ tag <* eof
+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
-  _tChilds <- try_ childs
-  return Tag {..}
+  multiplicity <- char '*' *> decimal <|> pure 1
+  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)
@@ -58,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)
 

src/Hemmet/FileTree/Transformation.hs

@@ -1,11 +1,16 @@
+{-# LANGUAGE CPP #-}
+
 module Hemmet.FileTree.Transformation
    ( haskellify
    , pythonify
    ) where
 
 import Data.Char
+#if MIN_VERSION_GLASGOW_HASKELL(9,0,0,0)
 import Data.Text as T hiding (concatMap, elem, map)
-
+#else
+import Data.Text as T hiding (concatMap, map)
+#endif
 import Hemmet.Tree
 
 import Hemmet.FileTree.Tree

test/Spec.hs

@@ -4,6 +4,7 @@ import Test.Tasty
 import Test.Tasty.Hspec
 import Text.Megaparsec
 
+import qualified Hemmet.Dom.Template as Dom
 import Hemmet.BEM.Template as BEM
 import Hemmet.BEM.Tree
 import Hemmet.Tree
@@ -22,12 +23,34 @@ tests = do
 makeUnitTests :: IO [TestTree]
 makeUnitTests =
   testSpecs $ do
-    parserSpec
+    domParserSpec
+    bemParserSpec
     transformerSpec
 
-parserSpec :: Spec
-parserSpec =
-  describe "Lib.parse" $ do
+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"
+      tag name cs = Dom.Tag {
+        _tName = name, _tId = Nothing, _tClasses = [], _tChilds = cs
+      }
+
+
+bemParserSpec :: Spec
+bemParserSpec =
+  describe "parse BEM.template" $ do
     it "parses single block" $ do
       "div:foo" `shouldMean` tb "div" "foo" [] []
       ":foo" `shouldMean` tb "" "foo" [] []
@@ -75,7 +98,7 @@ parserSpec =
           [Left . ElementBlock "e" [Mod "em"] $
              Params "" "s" [Mod "sm"] []]
     it "parses a complex example" $
-      q exampleQuery `shouldBe` Just exampleTemplate
+      q bemExampleQuery `shouldBe` Just bemExampleTemplate
   where
     shouldFail s = q s `shouldBe` Nothing
     shouldMean s bs = q s `shouldBe` Just (Template bs)
@@ -92,20 +115,20 @@ transformerSpec :: Spec
 transformerSpec =
   describe "Hemmet.toTree" $
     it "transformes a complex example" $
-      toTree exampleTemplate `shouldBe` exampleNodes
+      toTree bemExampleTemplate `shouldBe` bemExampleNodes
 
 -- complex examples
-exampleQuery :: Text
-exampleQuery =
+bemExampleQuery :: Text
+bemExampleQuery =
   "form:search-form$theme>\
      \input.query>\
        \(div.help~hidden_t)\
      \+\
      \span.submit-button~disabled_t:button~text_small\
        \>.hint"
 
-exampleTemplate :: Template
-exampleTemplate =
+bemExampleTemplate :: Template
+bemExampleTemplate =
   Template
     [ Block
       $ Params "form" "search-form" [Var "theme"]
@@ -119,8 +142,8 @@ exampleTemplate =
         ]
     ]
 
-exampleNodes :: Tree BemPayload
-exampleNodes =
+bemExampleNodes :: Tree BemPayload
+bemExampleNodes =
   BemPayload [] []
     [ node "form" ["search-form"] ["theme"]
       [ node "input" ["search-form__query"] []

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"