Hi, Am Donnerstag, den 03.12.2009, 22:39 +0100 schrieb Joachim Breitner: > Nice, and close. It seems it does not handle the datatype in arbitrary > positions in the type (as in Foo -> ( a -> Either Foo ())) -> (Foo, > ())). But thanks for the pointer. Maybe I should give it a shot.
I started to write a module. My (incomplete!) code looks like this:
=====================================================
{-# LANGUAGE PatternGuards #-}
module OpenNewtype (openNewType) where
import Debug.Trace
import Language.Haskell.TH
import Data.Monoid
import qualified Data.Map as M
openNewtype typeName declsQ = do
info <- reify typeName
decls <- declsQ
tmpName1 <- newName "x"
tmpName2 <- newName "x"
-- Check if the given type is really a simple newtype
case info of
TyConI (NewtypeD _ _ _ (NormalC constr [(NotStrict,ConT
realType)]) _)
-> let types = getTypeMap decls
in return $ map (go constr tmpName2 tmpName2
realType types) decls
_ -> error $ "openNewType can only handle siple newtype
defined types\nArgument was: " ++ pprint info
where go constr tmpName1 tmpName2 realType types d = case d of
(ValD (VarP name) _ _) -> FunD name [Clause [] (NormalB (wrap
name types)) [d]]
(FunD name _) -> FunD name [Clause [] (NormalB (wrap
name types)) [d]]
_ -> d
where wrap name types | Just t <- M.lookup name types = wrapCo (VarE
name) t
| otherwise = (VarE name)
wrapCo exp (ConT t) | t == typeName =
inject exp
| otherwise =
exp
wrapCo exp (ForallT _ _ t) =
wrapCo exp t
wrapCo exp (VarT _) =
exp
wrapCo exp (TupleT _) =
exp
wrapCo exp (ArrowT) =
exp
wrapCo exp (ListT) =
exp
wrapCo exp (AppT (AppT ArrowT t1) t2) =
LamE [VarP tmpName1] (wrapCo (AppE exp (wrapCon (VarE
tmpName1) t1)) t2)
wrapCon exp (ConT t) | t == typeName =
unwrap exp
| otherwise =
exp
wrapCon exp (ForallT _ _ t) =
wrapCo exp t
wrapCon exp (VarT _) =
exp
wrapCon exp (TupleT _) =
exp
wrapCon exp (ArrowT) =
exp
wrapCon exp (ListT) =
exp
wrapCon exp (AppT (AppT ArrowT t1) t2) =
LamE [VarP tmpName1] (wrapCon (AppE exp (wrapCo (VarE
tmpName1) t1)) t2)
inject :: Exp -> Exp
inject e = AppE (ConE constr) e
unwrap :: Exp -> Exp
unwrap e = LetE [ValD (ConP constr [VarP tmpName2]) (NormalB e)
[]] (VarE tmpName2)
getTypeMap :: [Dec] -> M.Map Name Type
getTypeMap = mconcat . map go
where go (SigD name t) = M.singleton name t
go _ = mempty
=====================================================
And the intended usage would be
=====================================================
{-# LANGUAGE TemplateHaskell #-}
import OpenNewtype
newtype Foo = Foo Int deriving Show
$(openNewtype ''Foo [d|
nullFoo :: Foo
nullFoo = 0
{-
toFoo :: Int -> Foo
toFoo = id
fromFoo :: Foo -> Int
fromFoo = id
-}
succFoo :: Foo -> Foo
succFoo = succ
addFoo :: Foo -> Foo -> Foo
addFoo a b = a + b
|] )
main = do
print (succFoo (Foo 1))
=====================================================
And indeed, it works for null, succFoo, addFoo. The generated code looks
like this, for example for succfoo:
succFoo :: Main.Foo -> Main.Foo
succFoo = \ x[a28u]
-> Main.Foo (succFoo (let Main.Foo x[a28v] = x[a28u] in
x[a28v]))
where
succFoo = GHC.Enum.succ
But when I uncommented the definition of toFoo and fromfoo, I got:
Demo.hs:11:9:
Couldn't match expected type `Foo' against inferred type `Int'
In the expression: id
In the definition of `toFoo': toFoo = id
In the second argument of `openNewtype', namely
`[d| nullFoo :: Foo
nullFoo = 0
toFoo :: Int -> Foo
toFoo = id
.... |]'
And just now, after writing half the code, I find out that $( fun
[d|...|] ) runs the type checker on the declarations before passing them
to fun, which of course kills my whole approach here, as only having the
declarations pass through openNewType will make them type check.
Is there any way to pass declarations to a TH function so that their
names are resolved, but their type is not checked (or, alternatively,
type errors are ignored).
If not, what would be a sane work-around?
Greetings,
Joachim
--
Joachim Breitner
e-Mail: m...@joachim-breitner.de
Homepage: http://www.joachim-breitner.de
ICQ#: 74513189
Jabber-ID: nome...@joachim-breitner.de
signature.asc
Description: Dies ist ein digital signierter Nachrichtenteil
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
