reflex-dom-th 0.3.0.1 → 0.3.2
raw patch · 4 files changed
+49/−26 lines, 4 filesdep +mtldep ~stmPVP ok
version bump matches the API change (PVP)
Dependencies added: mtl
Dependency ranges changed: stm
API changes (from Hackage documentation)
Files
- CHANGELOG.md +4/−0
- reflex-dom-th.cabal +4/−5
- src/Reflex/Dom/TH.hs +40/−20
- src/Reflex/Dom/TH/Parser.hs +1/−1
CHANGELOG.md view
@@ -1,5 +1,9 @@ # Revision history for reflex-dom-th +## 0.3.2+* ghc 8.10 support ++ ## 0.3.01 * pre sorting and packing of attribute maps to text ** this solves a problem with empty attributes like in <tag attr="">
reflex-dom-th.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: reflex-dom-th-version: 0.3.0.1+version: 0.3.2 -- A short (one-line) description of the package. synopsis: reflex-dom-th transpiles HTML templates to haskell code for reflex-dom@@ -33,12 +33,13 @@ exposed-modules: Reflex.Dom.TH.Parser , Reflex.Dom.TH- default-extensions: TemplateHaskell, TupleSections, DeriveLift, RecordWildCards, QuasiQuotes, OverloadedStrings+ default-extensions: TemplateHaskell, TupleSections, DeriveLift, RecordWildCards, QuasiQuotes, OverloadedStrings, FlexibleContexts build-depends: base >= 4 && < 5 , array , containers , megaparsec+ , mtl , reflex-dom-core , template-haskell , th-lift-instances@@ -64,7 +65,7 @@ , megaparsec , hspec , reflex-dom-th- , stm >= 2.5.0.2+ , stm , tasty , tasty-golden , tasty-hspec@@ -79,5 +80,3 @@ -- build-depends: -- base >= 4 && < 5 -- , reflex-dom--
src/Reflex/Dom/TH.hs view
@@ -19,7 +19,8 @@ import Data.Text (Text) import qualified Data.Text as T import Data.Function (on)-import Instances.TH.Lift+import Instances.TH.Lift()+import Control.Monad.Reader type Ref = Int @@ -29,6 +30,8 @@ | CRTuple (Maybe Ref) [Ref] deriving Show +type VarEnv a = Reader (Ref -> Name) a+ data Chain = CBind CElement ChildResult Chain | CResult [Ref] deriving Show @@ -75,18 +78,23 @@ toC (TComment c) = CComment c toC _ = error "internal" -+withVarF :: MonadReader t m => (t -> b) -> m b+withVarF f = ask >>= \ var -> return (f var) opt :: (Ref -> Name) -> Maybe Ref -> Q Pat-opt var = maybe (runQ [p| () |]) $ varP . var+opt var = maybe wildP $ varP . var -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]]+tupArg :: (t -> Name) -> [t] -> PatQ+tupArg var [x] = varP $ var x+tupArg var args = tupP $ map (varP . var) args +clambda :: ChildResult -> ExpQ -> VarEnv ExpQ+clambda CREmpty e = return $ lamE [wildP] e+clambda (CRSimple v) e = withVarF $ \ var -> lamE [varP $ var v] e+clambda (CRTuple Nothing crefs) e = withVarF $ \ var -> lamE [tupArg var crefs] e+clambda (CRTuple mref crefs) e = withVarF $ \ var -> lamE [tupP [ opt var mref+ , tupArg var crefs]] e+ elWithAttr :: String -> [(Text, Text)] -> Maybe String -> ExpQ elWithAttr tag [] Nothing = [| el tag |]@@ -102,19 +110,31 @@ el'WithAttr tag attr Nothing = [| elAttr' tag (M.fromAscList attr) |] el'WithAttr tag attr (Just dynAttr) = [| elDynAttr' tag (flip M.union (M.fromAscList attr) <$> $(unboundVarE $ mkName dynAttr)) |] +tupRes :: (t -> Name) -> [t] -> ExpQ+tupRes var [a] = varE $ var a+tupRes var l = tupE $ map (varE . var) l -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)) |]+cchain :: Chain -> VarEnv ExpQ+cchain (CResult orefs) = do+ var <- ask+ return (appE (varE 'return) (tupRes var orefs))+cchain (CBind ce cres rest) = do+ n <- cnode ce+ r <- cchain rest+ l <- clambda cres r+ return [| $(n) >>= $(l) |] -cnode :: (Ref -> Name) -> CElement -> ExpQ-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-cnode _ (CComment txt) = [| comment txt |] +cnode :: CElement -> VarEnv ExpQ+cnode (CElement tag _ _ _ Nothing attr tDynAttrs childs) = cchain childs >>= \ cs ->+ return [| $(elWithAttr tag attr tDynAttrs) $(cs) |]+cnode (CElement tag _ _ _ (Just _) attr tDynAttrs childs) = cchain childs >>= \ cs ->+ return [| $(el'WithAttr tag attr tDynAttrs) $(cs) |]+cnode (CText "") = return $ [| blank |]+cnode (CText txt) = return $ [| text txt |]+cnode (CWidget x _) = return $ unboundVarE $ mkName x+cnode (CComment txt) = return [| comment txt |]+ chainOut :: Chain -> [Ref] chainOut (CBind _ _ next) = chainOut next chainOut (CResult out) = out@@ -125,7 +145,7 @@ out = chainOut refchain in do varNames <- listArray (0, length out) <$> mapM (\ r -> newName ("r" ++ show r)) out- cchain (varNames !) refchain+ runReader (cchain refchain) (varNames !) dom :: QuasiQuoter dom = QuasiQuoter
src/Reflex/Dom/TH/Parser.hs view
@@ -15,7 +15,7 @@ import qualified Text.Megaparsec.Char.Lexer as L import Data.Void import Control.Monad-import Language.Haskell.TH.Syntax+--import Language.Haskell.TH.Syntax type Parser = Parsec Void String type TTag = String