add syntax for variables

README.md

@@ -41,6 +41,14 @@ divc_ "foo" $ do
 divc_ "foo theme-ocean" $ pure ()
 ```
 
+### Variables
+
+`echo ":foo\$bar^baz" | hemmet`
+
+```haskell
+divc_ ("foo baz" <> bar) $ pure ()
+```
+
 ### Root node stripping
 
 `$ echo "<:foo>.bar+.baz" | hemmet`

app/Main.hs

@@ -1,6 +1,7 @@
 module Main where
 
 import Control.Monad
+import Data.List
 import Lib
 import System.Exit
 import System.IO
@@ -22,7 +23,8 @@ main = do
 
 renderHtml :: String -> [Node] -> IO ()
 renderHtml _ [] = return ()
-renderHtml pad ((Node name classes elems):ns) = do
+renderHtml pad ((Node name classes _ elems):ns) -- TODO: add vars support
+ = do
     putStr $ pad ++ "<" ++ tagName ++ " \"" ++ unwords classes ++ "\">"
     unless (null elems) $ do
         putStrLn ""
@@ -38,18 +40,15 @@ renderHtml pad ((Node name classes elems):ns) = do
 
 renderHaskell :: String -> [Node] -> IO ()
 renderHaskell _ [] = return ()
-renderHaskell pad ((Node name classes elems):ns) = do
+renderHaskell pad ((Node name classes vars elems):ns) = do
     putStr $ pad ++ tagName ++ " "
-    putStr . show . unwords $ classes
-    {- TODO: move to syntax
-    let cs = map show classes
-    case cs of
-        [c] -> putStr c
-        _ -> putStr $ "(" ++ intercalate " <> " cs ++ ")"
-    -}
-    case elems of
-        [] -> putStrLn " $ pure ()"
-        _ -> do
+    let cs = show . unwords $ classes
+    if null vars
+        then putStr cs
+        else putStr $ "(" ++ intercalate " <> " (cs : vars) ++ ")"
+    if null elems
+        then putStrLn " $ pure ()"
+        else do
             putStrLn " $ do"
             renderHaskell (pad ++ "  ") elems
     renderHaskell pad ns
@@ -64,4 +63,4 @@ type Preprocessor = [Node] -> [Node]
 
 stripTop :: Preprocessor
 stripTop [] = []
-stripTop ((Node _ _ es):_) = es
+stripTop ((Node _ _ _ es):_) = es

hemmet.cabal

@@ -19,6 +19,7 @@ library
   build-depends:       base >= 4.7 && < 5
                      , parsec
   default-language:    Haskell2010
+  ghc-options:         -Werror -Wall
 
 executable hemmet
   hs-source-dirs:      app

src/Lib.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE RecordWildCards #-}
 
 module Lib
@@ -6,8 +7,7 @@ module Lib
     , Params(..)
     , Block(..)
     , Element(..)
-    , Mix(..)
-    , Modifier(..)
+    , Addon(..)
     , template
     , transform
       -- reexports
@@ -17,19 +17,17 @@ module Lib
 import Data.Char
 import Data.Maybe
 import Text.Parsec
-import Text.Parsec.Char
 import Text.Parsec.String
 
 newtype Template =
     Template [Block]
     deriving (Show, Eq)
 
 data Params = Params
-    { _tagName :: String
-    , _name :: String
-    , _mods :: [Modifier]
-    , _mixes :: [Mix]
-    , _childs :: [Either Element Block]
+    { _pTagName :: String
+    , _pName :: String
+    , _pAddons :: [Addon]
+    , _pChilds :: [Either Element Block]
     } deriving (Show, Eq)
 
 newtype Block = Block
@@ -40,37 +38,47 @@ newtype Element = Element
     { unElement :: Params
     } deriving (Show, Eq)
 
-newtype Mix = Mix
-    { unMix :: String
-    } deriving (Show, Eq)
+data Addon
+    = Mod String
+    | Mix String
+    | Var String
+    deriving (Show, Eq)
 
-newtype Modifier = Modifier
-    { unModifier :: String
+data Node = Node
+    { _nTagName :: String
+    , _nClasses :: [String]
+    , _nVars :: [String]
+    , _nChilds :: [Node]
     } deriving (Show, Eq)
 
-data Node =
-    Node String
-         [String]
-         [Node]
-    deriving (Show, Eq)
-
 -- transformation
 transform :: Template -> [Node]
 transform (Template bs) = map (transformBlock "") bs
 
 transformBlock :: String -> Block -> Node
-transformBlock _ (Block p) = transform' (flip const) (_name p) p
+transformBlock _ (Block p) = transform' (flip const) (_pName p) p
 
 transformElement :: String -> Element -> Node
 transformElement parent = transform' (prefix "__") parent . unElement
 
-transform' use parent (Params tagName name mods mixes childs) =
-    let n = use parent name
-    in Node
-           tagName
-           (n : map (prefix "_" n . unModifier) mods ++ map unMix mixes) $
-       map (either (transformElement parent) (transformBlock parent)) childs
-
+transform' :: (String -> String -> String) -> String -> Params -> Node
+transform' use parent (Params _nTagName name addons childs) = Node {..}
+  where
+    n = use parent name
+    _nClasses =
+        (n :) $
+        flip mapMaybe addons $ \case
+            Var _ -> Nothing
+            Mix m -> Just m
+            Mod m -> Just $ prefix "_" n m
+    _nVars =
+        flip mapMaybe addons $ \case
+            Var v -> Just v
+            _ -> Nothing
+    _nChilds =
+        map (either (transformElement parent) (transformBlock parent)) childs
+
+prefix :: String -> String -> String -> String
 prefix sep p n = p ++ sep ++ n
 
 -- template parsing
@@ -81,19 +89,19 @@ template = Template <$> many_ (part (always blockName) $ const Block) <* eof
 
 part :: Parser (Bool, String) -> (Bool -> Params -> a) -> Parser a
 part nameParser wrap = do
-    _tagName <- try_ identifier
-    (isBlock, _name) <- nameParser
-    _mods <- many $ Modifier <$> (char '~' *> modName)
-    _mixes <- many $ Mix <$> (char '^' *> kebabCasedName)
-    _childs <- try_ $ char '>' *> many_ (part both wrap')
+    _pTagName <- try_ identifier
+    (isBlock, _pName) <- nameParser
+    _pAddons <- many addon
+    _pChilds <- try_ $ char '>' *> many_ (part both wrap')
     return $ wrap isBlock Params {..}
   where
     both = ((,) True) <$> blockName <|> ((,) False) <$> elemName
     wrap' True = Right . Block
     wrap' False = Left . Element
 
 identifier :: Parser String
-identifier = (:) <$> letter' <*> many (char '_' <|> digit <|> letter')
+identifier =
+    (:) <$> (letter' <|> char '_') <*> many (char '_' <|> digit <|> letter')
   where
     letter' = satisfy isAsciiLower <|> satisfy isAsciiUpper
 
@@ -103,6 +111,13 @@ blockName = string ":" *> kebabCasedName
 elemName :: Parser String
 elemName = string "." *> kebabCasedName
 
+addon :: Parser Addon
+addon = mod_ <|> mix <|> var
+  where
+    mod_ = Mod <$> (char '~' *> modName)
+    mix = Mix <$> (char '^' *> kebabCasedName)
+    var = Var <$> (char '$' *> identifier)
+
 kebabCasedName :: Parser String
 kebabCasedName = (:) <$> lascii <*> many (char '-' <|> lascii <|> digit)
   where
@@ -117,4 +132,5 @@ many_ p = ps <* eof <|> between (char '(') (char ')') ps
   where
     ps = p `sepBy` char '+'
 
+try_ :: Parser [a] -> Parser [a]
 try_ = (<|> pure [])

test/Spec.hs

@@ -11,19 +11,22 @@ testParser :: Spec
 testParser =
     describe "Lib.parse" $ do
         it "parses single block" $ do
-            "div:foo" `shouldMean` tb "div" "foo" [] [] []
-            ":foo" `shouldMean` tb "" "foo" [] [] []
+            "div:foo" `shouldMean` tb "div" "foo" [] []
+            ":foo" `shouldMean` tb "" "foo" [] []
         it "parses single element" $ do
-            ":b>span.xyz" `shouldMean` te "span" "xyz" [] [] []
-            ":b>.xyz" `shouldMean` te "" "xyz" [] [] []
+            ":b>span.xyz" `shouldMean` te "span" "xyz" [] []
+            ":b>.xyz" `shouldMean` te "" "xyz" [] []
         it "parses block/element modifiers" $ do
-            ":b~m1~m2" `shouldMean` tb "" "b" ["m1", "m2"] [] []
-            ":b>.e~m1~m2" `shouldMean` te "" "e" ["m1", "m2"] [] []
+            ":b~m1~m2" `shouldMean` tb "" "b" [Mod "m1", Mod "m2"] []
+            ":b>.e~m1~m2" `shouldMean` te "" "e" [Mod "m1", Mod "m2"] []
         it "parses block/element mixes" $ do
-            ":b^m1^m2" `shouldMean` tb "" "b" [] ["m1", "m2"] []
-            ":b>.e^m1^m2" `shouldMean` te "" "e" [] ["m1", "m2"] []
+            ":b^m1^m2" `shouldMean` tb "" "b" [Mix "m1", Mix "m2"] []
+            ":b>.e^m1^m2" `shouldMean` te "" "e" [Mix "m1", Mix "m2"] []
+        it "parses block/element vars" $ do
+            ":b$m1$m2" `shouldMean` tb "" "b" [Var "m1", Var "m2"] []
+            ":b>.e$m1$m2" `shouldMean` te "" "e" [Var "m1", Var "m2"] []
         it "ensures proper naming" $ do
-            shouldFail "_badStart:x"
+            shouldMean "_underscored:x" $ tb "_underscored" "x" [] []
             shouldFail "1leadingDigit:x"
             -- block names
             shouldFail ":snake_case"
@@ -34,34 +37,37 @@ testParser =
             shouldFail ":b>uPPercase"
             shouldFail ":b>1leading-digit"
             -- modifier names
-            shouldMean ":b~snake_case" $ tb "" "b" ["snake_case"] [] []
+            shouldMean ":b~snake_case" $ tb "" "b" [Mod "snake_case"] []
             shouldFail ":b~uPPer_case"
             shouldFail ":b~1leading-digit"
             -- mix names
             shouldFail ":b^snake_case"
             shouldFail ":b^uPPer_case"
             shouldFail ":b^1leading-digit"
+            -- var names
+            shouldFail ":b$kebab-case"
+            shouldMean ":b$_underscored" $ tb "" "b" [Var "_underscored"] []
+            shouldMean ":b$uPPer_case" $ tb "" "b" [Var "uPPer_case"] []
+            shouldFail ":b$1leading-digit"
         it "parses a chains of items" $ do
-            ":a+:b" `shouldMean` (tb "" "a" [] [] [] ++ tb "" "b" [] [] [])
-            "(:a+:b)" `shouldMean` (tb "" "a" [] [] [] ++ tb "" "b" [] [] [])
+            ":a+:b" `shouldMean` (tb "" "a" [] [] ++ tb "" "b" [] [])
+            "(:a+:b)" `shouldMean` (tb "" "a" [] [] ++ tb "" "b" [] [])
             ":a>.e1+.e2" `shouldMean`
-                tb "" "a" [] [] [elem "" "e1" [] [] [], elem "" "e2" [] [] []]
+                tb "" "a" [] [el "" "e1" [] [], el "" "e2" [] []]
             ":a>(.e1+.e2)" `shouldMean`
-                tb "" "a" [] [] [elem "" "e1" [] [] [], elem "" "e2" [] [] []]
+                tb "" "a" [] [el "" "e1" [] [], el "" "e2" [] []]
             ":a>(.e1)+:b" `shouldMean`
-                (tb "" "a" [] [] [elem "" "e1" [] [] []] ++ tb "" "b" [] [] [])
+                (tb "" "a" [] [el "" "e1" [] []] ++ tb "" "b" [] [])
         it "parses a complex example" $
             q exampleQuery `shouldBe` Just exampleTemplate
   where
     shouldFail s = q s `shouldBe` Nothing
     shouldMean s bs = q s `shouldBe` Just (Template bs)
     q = either (const Nothing) Just . parse template "foo"
     -- shortcuts
-    block t n ms mxs es = Right . Block $ params t n ms mxs es
-    elem t n ms mxs es = Left . Element $ params t n ms mxs es
-    tb t n ms mxs es = [Block $ params t n ms mxs es]
-    te t n ms mxs es = tb "" "b" [] [] [elem t n ms mxs es]
-    params t n ms mxs = Params t n (map Modifier ms) (map Mix mxs)
+    el t n as cs = Left . Element $ Params t n as cs
+    tb t n as cs = [Block $ Params t n as cs]
+    te t n as cs = tb "" "b" [] [el t n as cs]
 
 -- "transform" spec
 testTransformer :: Spec
@@ -73,7 +79,7 @@ testTransformer =
 -- complex examples
 exampleQuery :: String
 exampleQuery =
-    "form:search-form>\
+    "form:search-form$theme>\
        \input.query^red-text>\
          \(div.hint~hidden_t)\
        \+\
@@ -86,20 +92,15 @@ exampleTemplate =
           Params
               "form"
               "search-form"
-              []
-              []
+              [Var "theme"]
               [ Left $
                 Element $
                 Params
                     "input"
                     "query"
-                    []
                     [Mix "red-text"]
-                    [ Left $
-                      Element $ Params "div" "hint" [Modifier "hidden_t"] [] []
-                    ]
-              , Right $
-                Block $ Params "input" "button" [Modifier "text_small"] [] []
+                    [Left $ Element $ Params "div" "hint" [Mod "hidden_t"] []]
+              , Right $ Block $ Params "input" "button" [Mod "text_small"] []
               ]
         ]
 
@@ -108,14 +109,17 @@ exampleNodes =
     [ Node
           "form"
           ["search-form"]
+          ["theme"]
           [ Node
                 "input"
                 ["search-form__query", "red-text"]
+                []
                 [ Node
                       "div"
                       ["search-form__hint", "search-form__hint_hidden_t"]
                       []
+                      []
                 ]
-          , Node "input" ["button", "button_text_small"] []
+          , Node "input" ["button", "button_text_small"] [] []
           ]
     ]