@@ -23,13 +23,20 @@ tyVar name = do
2323 let thType = TH.varT thName
2424 return (TH.PlainTV thName, thType)
2525
26+proxySimple :: TH.Name -> TH.TypeQ -> TH.Q (TH.Dec, TH.Dec)
27+proxySimple name ty = do
28+ sig <- TH.sigD name [t| Proxy $ty |]
29+ val <- funSimple name [e| Proxy |]
30+ return (sig, val)
31+
2632data EtherealConfig
27− = EtherealReaderConfig String String String String String String
33+ = EtherealReaderConfig String String String String String String String
2834
2935defaultEtherealReaderConfig :: String -> EtherealConfig
3036defaultEtherealReaderConfig name = EtherealReaderConfig
3137 ("Monad" ++ name)
3238 ("Tag" ++ name)
39+ ("tag" ++ name)
3340 ("run" ++ name ++ "T")
3441 ("run" ++ name)
3542 ("ask" ++ name)
@@ -38,17 +45,20 @@ defaultEtherealReaderConfig name = EtherealReaderConfig
3845ethereal :: EtherealConfig -> TH.DecsQ
3946
4047ethereal (EtherealReaderConfig
41− strEffName strTagName strRunTransName
42− strRunName strAskName strLocalName) = do
48+ strEffName strTagName strTagProxyName
49+ strRunTransName strRunName strAskName
50+ strLocalName) = do
4351 let effName = TH.mkName strEffName
4452 tagName = TH.mkName strTagName
4553 tag = TH.conT tagName
54+ tagProxyName = TH.mkName strTagProxyName
4655 runTransName = TH.mkName strRunTransName
4756 runName = TH.mkName strRunName
4857 askName = TH.mkName strAskName
4958 localName = TH.mkName strLocalName
5059 effDecl <- TH.tySynD effName [] [t| MonadEtherReader $tag |]
5160 tagDecl <- emptyDataDecl tagName
61+ (tagProxySig, tagProxyVal) <- proxySimple tagProxyName tag
5262 runTransFunSig <- do
5363 (mBndr, m) <- tyVar "m"
5464 (aBndr, a) <- tyVar "a"
@@ -84,6 +94,7 @@ ethereal (EtherealReaderConfig
8494 [t| ($r -> $r) -> $m $a -> $m $a |]
8595 localFunBody <- funSimple localName [e| etherLocal (Proxy :: Proxy $tag) |]
8696 return [ effDecl, tagDecl
97+ , tagProxySig, tagProxyVal
8798 , runTransFunSig, runTransFunBody
8899 , runFunSig, runFunBody
89100 , askFunSig, askFunBody