I would be surprised if GHC could derive a Data instance for a GADT. Deriving generally tends to fall down for GADTs. I also suspect Data doesn't work for GADTs at all. Generic mechanisms for GADTs in Haskell seem a bit researchy still.
How can I make a Data instance of Foo??It would compile only if I comment the B constructor.That's great, it works, thanks.Now I am blocked on this one:
data Foo a where
A :: Foo a
B :: Foo [a]
deriving instance Typeable Foo
deriving instance (Data a) => Data (Foo a)
Could not deduce (a ~ [a0])
from the context (Typeable (Foo a), Data a)On Thu, Jul 21, 2016 at 11:26 AM, Jonas Scholl <anselm.scholl@tu-harburg.de> wrote:With "just Typeable" I mean using only the Typeable class. As already
mentioned by Michael, it is also possible to achieve the same effect
with the Data class:
data SomeData = forall e. (Data e, Eq e) => SomeData e
isNothing'' :: SomeData -> Bool
isNothing'' (SomeData a) = toConstr a == toConstr (Nothing :: Maybe ())
Depending on your use-case, this may be simpler and it avoids using
unsafeCoerce, which may make one feel a little bit uneasy. On the other
hand, it adds an additional constraint. Additionally, a programmer can
write his own Data instance while Typeable instances are always
generated by the compiler (in newer versions of GHC).
On 07/21/2016 10:48 AM, Corentin Dupont wrote:
> That's great, exactly what I need.
> What do you mean by "just Typeable"?
> Do you have another idea in mind?
>
> On Thu, Jul 21, 2016 at 10:23 AM, Jonas Scholl
> <mailto:ivan.miljenovic@gmail.com> <anselm.scholl@tu-harburg.de <mailto:anselm.scholl@tu-harburg.de>> wrote:
>
> If you want to use just Typeable, you can implement your own cast:
> Extract the TypeRep of the thing in SomeData, get the TyCon, which is
> the top-level constructor, i.e. Maybe without arguments, and compare it
> with the TyCon from Maybe. If they match, you coerce the value to Maybe
> () and use isNothing. While this is not completely safe, we do not
> evaluate the thing we just coerced to (), and thus are safe, as Maybe
> should have identical representation regardless of the type parameter.
>
> isNothing' :: SomeData -> Bool
> isNothing' (SomeData a) = tyCon == maybeTyCon
> && isNothing (unsafeCoerce a :: Maybe ())
> where
> tyCon = typeRepTyCon (typeRep (mkProxy a))
> maybeTyCon = typeRepTyCon $ typeRep (Proxy :: Proxy (Maybe ()))
> mkProxy :: a -> Proxy a
> mkProxy = const Proxy
>
>
> On 07/21/2016 09:51 AM, Corentin Dupont wrote:
> > Hi Ivan,
> > I could use isNothing, but the data is forall'ed...
> > I tried but it doesn't work:
> >
> > data SomeData = forall e. (Typeable e, Eq e) => SomeData e
> >
> > isNothing' :: SomeData -> Bool
> > isNothing' (SomeData a) = case (cast a) of
> > (a :: Maybe a) -> isNothing a
> >
> > Could not deduce (Typeable a) arising from a use of ‘cast’
> >
> > On Wed, Jul 20, 2016 at 11:21 PM, Ivan Lazar Miljenovic
> > <ivan.miljenovic@gmail.com <mailto:ivan.miljenovic@gmail.com>
> <mailto:ivan.miljenovic@gmail.com>>> wrote:
> >
> > On 21 July 2016 at 02:30, Corentin Dupont <corentin.dupont@gmail.com <mailto:corentin.dupont@gmail.com>
> > <mailto:corentin.dupont@gmail.com <mailto:corentin.dupont@gmail.com>>> wrote:
> > > I see....
> > > The think is, I am interested to know if "e" is "Nothing", whatever the type
> > > of Nothing is!
> >
> > Data.Maybe.isNothing ?
> >
> > >
> > >
> > >
> > > On Wed, Jul 20, 2016 at 5:44 PM, Patrick Chilton
> > <chpatrick@gmail.com <mailto:chpatrick@gmail.com>
> <mailto:chpatrick@gmail.com <mailto:chpatrick@gmail.com>>>
> > > wrote:
> > >>
> > >> It's because you're doing === Nothing and the type of the Nothing is
> > >> ambiguous (Maybe a1).
> > >>
> > >> On Wed, Jul 20, 2016 at 5:18 PM, Corentin Dupont
> > >> <corentin.dupont@gmail.com
> <mailto:corentin.dupont@gmail.com> <mailto:corentin.dupont@gmail.com
> <mailto:Ivan.Miljenovic@gmail.com <mailto:Ivan.Miljenovic@gmail.com>>> <mailto:corentin.dupont@gmail.com>>> wrote:
> > >>>
> > >>> Hi all,
> > >>> I'm surprised this doesn't work:
> > >>>
> > >>> data SomeData = forall e. (Typeable e, Eq e) => SomeData e
> > >>>
> > >>> (===) :: (Typeable a, Typeable b, Eq a, Eq b) => a -> b
> -> Bool
> > >>> (===) x y = cast x == Just y
> > >>>
> > >>> test :: SomeData' -> Bool
> > >>> test (SomeData' e) | e === Nothing = True
> > >>> test _ = False
> > >>>
> > >>> It says
> > >>> Could not deduce (Eq a1) arising from a use of ‘===’
> > >>>
> > >>> How can I achieve something of the same effect?
> > >>>
> > >>> Thanks
> > >>> Corentin
> > >>>
> > >>> _______________________________________________
> > >>> Haskell-Cafe mailing list
> > >>> To (un)subscribe, modify options or view archives go to:
> > >>> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
> > >>> Only members subscribed via the mailman list are allowed
> to post.
> > >>
> > >>
> > >
> > >
> > > _______________________________________________
> > > Haskell-Cafe mailing list
> > > To (un)subscribe, modify options or view archives go to:
> > > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
> > > Only members subscribed via the mailman list are allowed to
> post.
> >
> >
> >
> > --
> > Ivan Lazar Miljenovic
> > Ivan.Miljenovic@gmail.com <mailto:Ivan.Miljenovic@gmail.com>
> > http://IvanMiljenovic.wordpress.com
> >
> >
> >
> >
> > _______________________________________________
> > Haskell-Cafe mailing list
> > To (un)subscribe, modify options or view archives go to:
> > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
> > Only members subscribed via the mailman list are allowed to post.
> >
>
>
>
> _______________________________________________
> Haskell-Cafe mailing list
> To (un)subscribe, modify options or view archives go to:
> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
> Only members subscribed via the mailman list are allowed to post.
>
>
_______________________________________________
Haskell-Cafe mailing list
To (un)subscribe, modify options or view archives go to:
http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
Only members subscribed via the mailman list are allowed to post.
_______________________________________________
Haskell-Cafe mailing list
To (un)subscribe, modify options or view archives go to:
http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
Only members subscribed via the mailman list are allowed to post.