diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,11 @@ # Revision history for reflex-dom-th -## 0.2.0.0 -- 2022-02-18 +## 0.3.00 -- 2022-03-02 + +* support for dynamic attributes +* parser accepts space between last attribute and > + +## 0.2.0.0 -- 2022-02-20 * specialization to el-variants * parse widgets inside texts diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -43,7 +43,14 @@ where item1, item2 :: MonadWidget t m => m () item1 = text "Item1" item2 = text "Item2" -``` +``` + +It is also possible to bind additionally a `Dynamic t (Map Text Text)' to the attributes + +``` +divWithAttrs :: MonadWidget t m => Dynamic t (Map Text Text) -> m () +divWithAttrs dynAttrs = [dom|
|] +``` To bind events to the elements it is possible to extract get the elements as a result. The reference number is the position in the result tuple. diff --git a/reflex-dom-th.cabal b/reflex-dom-th.cabal --- a/reflex-dom-th.cabal +++ b/reflex-dom-th.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: reflex-dom-th -version: 0.2.0.0 +version: 0.3.0.0 -- A short (one-line) description of the package. synopsis: reflex-dom-th transpiles HTML templates to haskell code for reflex-dom diff --git a/src/Reflex/Dom/TH.hs b/src/Reflex/Dom/TH.hs --- a/src/Reflex/Dom/TH.hs +++ b/src/Reflex/Dom/TH.hs @@ -34,6 +34,7 @@ , cOutRefs :: [Ref] , cMyRef :: Maybe Ref , cAttrs :: [(String, String)] + , cDynAttrs :: Maybe String , cChilds :: Chain } | CText String | CComment String @@ -53,13 +54,13 @@ compile ((TElement {..}):etail) inRefs = CBind elem' (CRTuple tRef childRefs) (compile etail expRefs) where - elem' = CElement tTag inRefs childRefs outRefs tRef attrs childChain + elem' = CElement tTag inRefs childRefs outRefs tRef tAttrs tDynAttrs childChain childChain = compile tChilds [] childRefs = chainOut childChain outRefs = maybe id insert tRef childRefs expRefs = merge inRefs outRefs - attrs = [ (k, v) | (Static, k, v) <- tAttrs ] + compile (TWidget w r:etail) inRefs = CBind (CWidget w r) (maybe CREmpty CRSimple r) (compile etail expRefs) where expRefs = maybe id insert r inRefs compile (e:etail) inRefs = @@ -80,24 +81,30 @@ clambda var (CRTuple Nothing crefs) = lamE [tupP $ map (varP . var) crefs] clambda var (CRTuple mref crefs) = lamE [tupP [ opt var mref , tupP $ map (varP . var) crefs]] -elWithAttr :: String -> [(String, String)] -> ExpQ -elWithAttr tag [] = [| el tag |] -elWithAttr tag [("class", cl)] = [| elClass tag cl |] -elWithAttr tag attr = [| elAttr tag (M.fromList attr) |] -el'WithAttr :: String -> [(String, String)] -> ExpQ -el'WithAttr tag [] = [| el' tag |] -el'WithAttr tag [("class", cl)] = [| elClass' tag cl |] -el'WithAttr tag attr = [| elAttr' tag (M.fromList attr) |] + +elWithAttr :: String -> [(String, String)] -> Maybe String -> ExpQ +elWithAttr tag [] Nothing = [| el tag |] +elWithAttr tag [] (Just dynAttr) = [| elDynAttr tag $(unboundVarE $ mkName dynAttr) |] +elWithAttr tag [("class", cl)] Nothing = [| elClass tag cl |] +elWithAttr tag attr Nothing = [| elAttr tag (M.fromList attr) |] +elWithAttr tag attr (Just dynAttr) = [| elDynAttr tag (flip M.union (M.fromList attr) <$> $(unboundVarE $ mkName dynAttr)) |] +el'WithAttr :: String -> [(String, String)] -> Maybe String -> ExpQ +el'WithAttr tag [] Nothing = [| el' tag |] +el'WithAttr tag [] (Just dynAttr) = [| elDynAttr' tag $(unboundVarE $ mkName dynAttr) |] +el'WithAttr tag [("class", cl)] Nothing = [| elClass' tag cl |] +el'WithAttr tag attr Nothing = [| elAttr' tag (M.fromList attr) |] +el'WithAttr tag attr (Just dynAttr) = [| elDynAttr' tag (flip M.union (M.fromList attr) <$> $(unboundVarE $ mkName dynAttr)) |] + cchain :: (Ref -> Name) -> Chain -> ExpQ cchain var (CResult orefs) = (appE (varE 'return) (tupE $ map (varE . var) orefs)) cchain var (CBind ce cres rest) = [| $(cnode var ce) >>= $(clambda var cres (cchain var rest)) |] cnode :: (Ref -> Name) -> CElement -> ExpQ -cnode var (CElement tag _ _ _ Nothing attr childs) = [| $(elWithAttr tag attr) $(cchain var childs)|] -cnode var (CElement tag _ _ _ (Just _) attr childs) = [| $(el'WithAttr tag attr) $(cchain var childs) |] +cnode var (CElement tag _ _ _ Nothing attr tDynAttrs childs) = [| $(elWithAttr tag attr tDynAttrs) $(cchain var childs)|] +cnode var (CElement tag _ _ _ (Just _) attr tDynAttrs childs) = [| $(el'WithAttr tag attr tDynAttrs) $(cchain var childs) |] cnode _ (CText "") = [| blank |] cnode _ (CText txt) = [| text txt |] cnode _ (CWidget x _) = unboundVarE $ mkName x diff --git a/src/Reflex/Dom/TH/Parser.hs b/src/Reflex/Dom/TH/Parser.hs --- a/src/Reflex/Dom/TH/Parser.hs +++ b/src/Reflex/Dom/TH/Parser.hs @@ -2,7 +2,6 @@ module Reflex.Dom.TH.Parser ( TElement(..), - AttributeType(..), parseTemplate ) where @@ -20,12 +19,12 @@ type Parser = Parsec Void String type TTag = String -data AttributeType = Static | Dynamic deriving (Show, Lift) -type Attribute = (AttributeType, String, String) +type Attribute = (String, String) type Ref = Int data TElement = TElement { tTag :: TTag , tRef :: Maybe Ref , tAttrs :: [Attribute] + , tDynAttrs :: Maybe String , tChilds :: [TElement] } | TText String | TComment String @@ -38,7 +37,7 @@ void $ char '#' L.decimal <* space -openTag :: Parser (String, Maybe Int, [Attribute]) +openTag :: Parser (String, [TElement] -> TElement) openTag = between (char '<') (char '>') $ do tag <- many (alphaNumChar <|> char '-') @@ -46,7 +45,8 @@ space attrs <- attributes space - return (tag, ref, attrs) + dynAttr <- optional varRef + return $ (tag, TElement tag ref attrs dynAttr) closeTag :: String -> Parser () closeTag tag = void $ between (string "> space) (char '>') (string tag >> space) @@ -59,22 +59,25 @@ stringLiteral = char '\"' *> manyTill L.charLiteral (char '\"') attribute :: Parser Attribute -attribute = (Static,,) <$> (some (alphaNumChar <|> char '-') <* char '=') <*> stringLiteral +attribute = (,) <$> (some (alphaNumChar <|> char '-') <* char '=') <*> stringLiteral attributes :: Parser [Attribute] -attributes = sepBy attribute space1 <* space +attributes = sepEndBy attribute space1 <* space node :: Parser TElement node = do - (tag, ref, attrs) <- openTag + (tag, mkElem) <- openTag space childs <- manyTill element (closeTag tag) - return $ TElement tag ref attrs childs + return $ mkElem childs varName :: Parser String varName = (:) <$> lowerChar <*> many alphaNumChar + +varRef :: Parser String +varRef = string "{{" *> space *> varName <* string "}}" <* space widget :: Parser TElement widget = TWidget <$> (string "{{" *> space *> varName) <*> (refOpt <* (string "}}"))