reflex-dom-th 0.1.0.0 → 0.2.0.0

raw patch · 5 files changed

+117/−72 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +10/−1
• README.md +33/−19
• reflex-dom-th.cabal +3/−3
• src/Reflex/Dom/TH.hs +58/−41
• src/Reflex/Dom/TH/Parser.hs +13/−8

@@ -1,5 +1,14 @@ # Revision history for reflex-dom-th -## 0.1.0.0 -- YYYY-mm-dd+## 0.2.0.0 -- 2022-02-18++* specialization to el-variants+* parse widgets inside texts+* allow refs to widgets+* dash '-' is now valid in attribute names+	+++## 0.1.0.0 -- 2022-02-18  * First version. Released on an unsuspecting world.

@@ -8,37 +8,51 @@  The basic example -    [dom|<div>hello</div>|]+```+[dom|<div>hello</div>|]+```  is equivalent to -    el "div" $ text "hello"+```+el "div" $ text "hello"+```  You can also put the html in a external file and include it with -    $(domFile "template.html")+```+$(domFile "template.html")+```  It it possible to have multiple elements and attributes -    [dom|<ul class="list">-          <li>Item1</div>-	  <li>Item1</div>-	</ul> |]+```+[dom|<ul class="list">+       <li>Item1</div>+       <li>Item1</div>+     </ul> |]+```      -Dynamic content can be injected two curly braces+Dynamic content can be injected between two curly braces. It will reference an unbound variable. It is not a haskell expression. Keeping haskell out of the template will give you better error messages. -        [dom|<ul class="list">-          <li>{{item1}}</div>-	  <li>{{item2}}</div>-	</ul> |]-	   where item1, item2 :: MonadWidget t m =>  m ()-	         item1 = text "Item1"-		 item2 = text "Item2"+```+[dom|<ul class="list">+      <li>{{item1}}</div>+      <li>{{item2}}</div>+    </ul> |]+  where item1, item2 :: MonadWidget t m =>  m ()+        item1 = text "Item1"+        item2 = text "Item2"+```           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. -    (li1, li2, ul) <- [dom|<ul #2 class="list">-    	       	             <li #0>Item1</div>-	  		     <li #1>Item1</div>-			   </ul> |]+```+(li1, li2, ul, w) <- [dom|<ul #2 class="list">+                           <li #0>Item1</div>+                           <li #1>Item1</div>+	                   <li>{{widget #3}}</div>+                          </ul> |]+```		       +

@@ -1,9 +1,9 @@ cabal-version:      2.4 name:               reflex-dom-th-version:            0.1.0.0+version:            0.2.0.0  -- A short (one-line) description of the package.-synopsis: reflex-dom-th transpiles HTML templates to haskell code for @reflex-dom@+synopsis: reflex-dom-th transpiles HTML templates to haskell code for reflex-dom  -- A longer description of the package. description:@@ -16,7 +16,7 @@ Stability: Experimental -- A URL where users can report bugs. bug-reports: https://github.com/chrbauer/reflex-dom-th/issues-+homepage:  https://github.com/chrbauer/reflex-dom-th license: BSD-3-Clause author:             Christoph Bauer maintainer:         mail@christoph-bauer.net

@@ -1,7 +1,7 @@ -- |   module Reflex.Dom.TH-  (dom, domFile, merge)+  (dom, domFile) where  @@ -14,24 +14,30 @@ import Reflex.Dom.TH.Parser import Reflex.Dom.Widget.Basic  import qualified Data.Map as M-import Data.Map (Map)---import Data.Maybe import Data.List (insert)-import Data.Text (Text)-import qualified Data.Text as T import Data.Array  type Ref = Int++data ChildResult =+   CREmpty+ | CRSimple Ref+ | CRTuple (Maybe Ref) [Ref]+ deriving Show++data Chain = CBind CElement ChildResult Chain | CResult [Ref]+  deriving Show+ data CElement = CElement { cTag :: String                          , cSiblingsRefs :: [Ref]                          , cChildRefs :: [Ref]                          , cOutRefs :: [Ref]                          , cMyRef :: Maybe Ref                          , cAttrs :: [(String, String)]-                         , cChilds :: [CElement] }+                         , cChilds :: Chain }                | CText String                | CComment String-               | CWidget String+               | CWidget String (Maybe Ref)                deriving Show  merge :: Ord a => [a] -> [a] -> [a]@@ -42,61 +48,72 @@   | otherwise = ah : merge at b  ---  do (r1, (r1a, r1b)) <- el1 $ el1a >>= \ r1a -> el1b >>= \r1b -> return (r1a, r1b)----compile :: [TElement] -> [CElement] -> [Ref] -> ([CElement], [Ref])-compile [] acc inRefs = (reverse acc, inRefs)-compile ((TElement {..}):etail) acc inRefs =-      compile etail (elem':acc) expRefs+compile :: [TElement] -> [Ref] -> Chain+compile [] inRefs = CResult inRefs+compile ((TElement {..}):etail) inRefs =+      CBind elem' (CRTuple tRef childRefs) (compile etail expRefs)   where-    elem' = CElement tTag inRefs childRefs outRefs tRef attrs childs-    (childs, childRefs) = compile tChilds [] []-    outRefs = maybe id insert tRef childRefs+    elem' = CElement tTag inRefs childRefs outRefs tRef attrs 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 (elem:etail) acc inRefs =-      compile etail (toC elem : acc) inRefs++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 =+      CBind (toC e) CREmpty (compile etail inRefs)   where-    toC (TText text) = CText text-    toC (TComment comment) = CComment comment-    toC (TWidget widget) = CWidget widget-    toC _ = undefined+    toC (TText t) = CText t+    toC (TComment c) = CComment c+    toC _ = error "internal"                               opt :: (Ref -> Name) -> Maybe Ref -> Q Pat opt var = maybe (runQ [p| () |]) $ varP . var -clambda var Nothing crefs   =  lamE [tupP $ map (varP . var) crefs ]-clambda var mref crefs =  lamE [tupP [ opt var mref-                           , tupP $ map (varP . var) crefs]]+clambda :: (Ref -> Name) -> ChildResult -> ExpQ -> ExpQ+clambda _    CREmpty       =  lamE [wildP]+clambda var (CRSimple v)  =  lamE [tupP [varP $ var v]]+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) |] -cnodes :: (Ref -> Name) -> [CElement] ->  ExpQ-cnodes _ []  = [| blank |]-cnodes var [elem@(CElement _ _ crefs orefs mref _ _)]  -    | null orefs = [| $(cnode var elem) |]-    | otherwise = [| $(cnode var elem) >>=  $(clambda var mref crefs                                                                                        (appE (varE 'return) (tupE $ map (varE . var) orefs))) |]-cnodes var (elem@(CElement _ _ crefs orefs mref _ _):rest)  = [| $(cnode var elem) >>=  $(clambda var mref crefs (cnodes var rest)) |]-                                                         -cnodes  var [elem] = cnode var elem-cnodes var (h:t)  = [|  $(cnode var h) >> $(cnodes var t) |] +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) = [|  elAttr tag (M.fromList attr) $(cnodes var childs)|]-cnode var (CElement tag _ _ _ (Just _) attr childs) = [|  elAttr' tag (M.fromList attr) $(cnodes var childs) |]+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 _ (CText "") = [| blank |] cnode _ (CText txt) = [| text txt |]-cnode _ (CWidget x) = unboundVarE $ mkName x+cnode _ (CWidget x _) = unboundVarE $ mkName x cnode _ (CComment txt) = [| comment txt |] +chainOut :: Chain -> [Ref] +chainOut (CBind _ _ next) = chainOut next+chainOut (CResult out) = out+ domExp :: [TElement] -> Q Exp domExp result =-  let (cns, out) = compile result [] [] in do+  let refchain = compile result []+      out = chainOut refchain+  in do     varNames <-  listArray (0, length out) <$> mapM (\ r -> newName ("r" ++ show r)) out-    cnodes (varNames !) cns+    cchain (varNames !) refchain  dom :: QuasiQuoter dom = QuasiQuoter

@@ -29,24 +29,27 @@                          , tChilds :: [TElement] }                | TText String                | TComment String-               | TWidget String+               | TWidget String (Maybe Ref)                deriving Show +refOpt :: Parser (Maybe Int)+refOpt = optional . try $ do+      space1+      void $ char '#'+      L.decimal <* space  openTag :: Parser (String, Maybe Int, [Attribute]) openTag =        between (char '<') (char '>') $ do        tag <- many (alphaNumChar <|> char '-')+       ref <- refOpt        space-       ref <-  optional $ do-         void $ char '#'-         L.decimal <* space        attrs <- attributes        space        return (tag, ref, attrs)  closeTag :: String -> Parser ()-closeTag tag = void $ between (string "</") (space >> char '>') (string tag)+closeTag tag = void $ between (string "</" >> space) (char '>') (string tag >> space)  comment :: Parser TElement comment = TComment <$> ((string "<!--") *> (manyTill anySingle (string "-->")))@@ -56,7 +59,7 @@ stringLiteral = char '\"' *> manyTill L.charLiteral (char '\"')  attribute :: Parser Attribute-attribute = (Static,,) <$>  (some alphaNumChar <* char '=') <*> stringLiteral+attribute = (Static,,) <$>  (some (alphaNumChar <|> char '-') <* char '=') <*> stringLiteral   attributes :: Parser [Attribute]@@ -70,12 +73,14 @@   childs <- manyTill element (closeTag tag)   return $ TElement tag ref attrs childs +varName :: Parser String+varName = (:) <$> lowerChar <*> many alphaNumChar  widget :: Parser TElement-widget =  TWidget <$> (string "{{" *> manyTill anySingle (string "}}"))+widget =  TWidget <$> (string "{{" *> space *> varName) <*> (refOpt <* (string "}}"))  text :: Parser TElement-text =  TText <$>  dropWhileEnd isSpace <$> some (satisfy (/= '<'))+text =  TText <$>  dropWhileEnd isSpace <$>  someTill anySingle (lookAhead (char '<' *> return () <|> string "{{" *> return () ))  element :: Parser TElement      element = (comment <|>  node <|> widget <|> text) <* space