问题
I'd like to use DSum for something. To work with DSum
, you need to have a 'tag' type which takes one type argument, e.g.
data Tag a where
AFirst :: Tag Int
ASecond :: Tag String
However, I'd like to use this internally in a library. I want the interface that I expose to users to take any old datatype, e.g.
data SomeUserType1 = Foo Int | Bar String
it's clearly quite mechanical to go from this to the Tag a
type given above. So, is it possible to do this in code, with some sort of generic programming techniques?
Here's another example to be clear about the type of mapping I want to produce.
data SomeUserType2 = Foo Int | Bar Char | Baz Bool String
should become
data Tag2 a where
AFirst :: Tag2 Int
ASecond :: Tag2 Char
AThird :: Tag2 (Bool, String)
Is this a job for Template Haskell? Something else? I don't even really know what the options are here.
回答1:
Template Haskell is what you want since you are trying to generate declarations. Here is something that works. Put the following in one file called Tag.hs
:
{-# LANGUAGE TemplateHaskell #-}
module Tag where
import Language.Haskell.TH
makeTag :: Name -> DecsQ
makeTag name = do
-- Reify the data declaration to get the constructors.
-- Note we are forcing there to be no type variables...
(TyConI (DataD _ _ [] _ cons _)) <- reify name
pure [ DataD [] tagTyName [PlainTV (mkName "a")] Nothing (fmap tagCon cons) [] ]
where
-- Generate the name for the new tag GADT type constructor.
tagTyName :: Name
tagTyName = mkName ("Tag" ++ nameBase name)
-- Given a constructor, construct the corresponding constructor for the GADT.
tagCon :: Con -> Con
tagCon (NormalC conName args) =
let tys = fmap snd args
tagType = foldl AppT (TupleT (length tys)) tys
in GadtC [mkName ("Tag" ++ nameBase conName)] []
(AppT (ConT tagTyName) tagType)
Then you can test it out in another file:
{-# LANGUAGE TemplateHaskell, GADTs #-}
import Tag
data SomeUserType1 = Foo Int | Bar String
data SomeUserType2 = Fooo Int | Baar Char | Baaz Bool String
makeTag ''SomeUserType1
makeTag ''SomeUserType2
If you inspect the second file in GHCi (or look at the generated code by passing -ddump-splices
to either ghci
or ghc
) you'll see that the following is generated:
data TagSomeUserType1 a where
TagFoo :: TagSomeUserType1 Int
TagBar :: TagSomeUserType1 String
data TagSomeUserType3 a where
TagFooo :: TagSomeUserType2 Int
TagBaar :: TagSomeUserType2 Char
TagBaaz :: TagSomeUserType2 (Bool, String)
I have to use mkName
and not newName
because, if you are ever expected to use these generated GADTs, you'll need them to have predictable names you can write. As should be clear from the examples, my convention is to prepend Tag
to both the type and data constructors.
来源:https://stackoverflow.com/questions/40582270/how-can-i-programatically-produce-this-datatype-from-the-other