[Haskell-cafe] Deriving with generics without values
Roman Cheplyaka
roma at ro-che.info
Sun Jul 14 17:25:18 CEST 2013
Forgot to mention — a good explanation of GHC Generics is the paper
"A Generic Deriving Mechanism for Haskell".
Roman
* Roman Cheplyaka <roma at ro-che.info> [2013-07-14 18:21:58+0300]
> Hi,
>
> (Redirecting this back to cafe to keep it discoverable — hope you don't
> mind.)
>
> * JP Moresmau <jpmoresmau at gmail.com> [2013-07-14 16:02:56+0200]
> > Hello, sorry to bother you after you've been kind enough to answer me on
> > the list! I've looked a the smallcheck code but I don't see how to apply it
> > to my issue. First of all, I can't find the definition of >>- that you use
> > for example in <~>. I suppose I'm doing something silly...
>
> That comes from LogicT. >>- is almost the same as >>=, and <~> is almost
> the same as <*>. Byt that's not relevant to the generic aspect of the
> code.
>
> > But then, if I understand the code, the instances for GSerial rebuild
> > a type definition that mimicks the one passed as type argument, using
> > the final values (under the K1s) to generate a series. But in my case,
> > I want to be able to extract information from the original type, I'm
> > not just interested in the final value. What I want to be able is to
> > extract for example the constructor name and do something with it. I
> > don't see how to achieve that with your system.
>
> Yes, it doesn't do everything that you want to do, but it shows the
> idea.
>
> The information you need is all there — for example, to get the
> constructor name, you need to get hold of the C1 type (which is a
> synonym for M1 C), and then call the conName method.
>
> Lest you get lost in all this, it is useful to visualize the generic
> representation by running your code through -ddump-deriv. Here's an
> example:
>
> % ghci -XDeriveGeneric -ddump-deriv -dsuppress-module-prefixes
> Prelude GHC.Generics> data T a = A { a :: a } | B | C deriving Generic
>
> ==================== Derived instances ====================
> Derived instances:
> instance Generic (T a_ao7) where
> from (A g1_aph) = M1 (L1 (M1 (M1 (K1 g1_aph))))
> from B = M1 (R1 (L1 (M1 U1)))
> from C = M1 (R1 (R1 (M1 U1)))
> to (M1 (L1 (M1 (M1 (K1 g1_api))))) = A g1_api
> to (M1 (R1 (L1 (M1 U1)))) = B
> to (M1 (R1 (R1 (M1 U1)))) = C
>
> instance Datatype D1T where
> datatypeName _ = "T"
> moduleName _ = ":Interactive"
>
> instance Constructor C1_0T where
> conName _ = "A"
> conIsRecord _ = True
>
> instance Constructor C1_1T where conName _ = "B"
>
> instance Constructor C1_2T where conName _ = "C"
>
> instance Selector S1_0_0T where selName _ = "a"
>
>
> Generic representation:
>
> Generated datatypes for meta-information:
> D1T
> C1_0T
> C1_1T
> C1_2T
> S1_0_0T
>
> Representation types:
> type Rep (T a_ao7) = D1
> D1T
> (C1 C1_0T (S1 S1_0_0T (Rec0 a_ao7))
> :+: (C1 C1_1T U1 :+: C1 C1_2T U1))
>
> This should give you an idea about how the structure you're dealing with
> looks like, and where the important information resides.
>
> > I've also look at Aeson with the generic JSON parsing, but that's
> > using SYB which is again different, and SYB doesn't seem to provide
> > the types of the constructor fields, which I would need too...
>
> It provides the types of the constructor fields through the Typeable
> class, which may or may not be sufficient for your needs... Anyway,
> you're right in that it is a completely different approach.
>
> Roman
>
> > On Fri, Jul 12, 2013 at 10:57 AM, Roman Cheplyaka <roma at ro-che.info> wrote:
> >
> > > Well, in your case, you need not 'from', but 'to', in order to convert
> > > from a generic representation to yours.
> > >
> > > Take a look at how a similar task is done in SmallCheck:
> > >
> > > https://github.com/feuerbach/smallcheck/blob/master/Test/SmallCheck/Series.hs#L180
> > >
> > > https://github.com/feuerbach/smallcheck/blob/master/Test/SmallCheck/Series.hs#L352
> > >
> > > Roman
> > >
> > > * JP Moresmau <jpmoresmau at gmail.com> [2013-07-12 10:45:39+0200]
> > > > Hello all,
> > > > My problem is the following: I have my own data types, and I'd like to
> > > > derive automatically instances of some type class from them. I've started
> > > > looking at GHC.Generics, which offer tools to do exactly that. However,
> > > > some functions of my typeclass do not take my data type as a parameter,
> > > but
> > > > as a result. Basically:
> > > > class MyClass where
> > > > fromString :: String -> a
> > > >
> > > > data MyData=MkMyData {
> > > > myField ::Int
> > > > } deriving (Generic)
> > > >
> > > > and I want to automatically generate the instance instance MyClass
> > > MyData,
> > > > using default methods, etc.
> > > > The GHC Generic class does say that it uses a from function that convert
> > > > from the datatype to its representation: from :: a ->
> > > > Rep<
> > > http://www.haskell.org/ghc/docs/7.4.1/html/libraries/ghc-prim-0.2.0.0/GHC-Generics.html#t:Rep
> > > >
> > > > a
> > > > xfrom :: a -> Rep<
> > > http://www.haskell.org/ghc/docs/7.4.1/html/libraries/ghc-prim-0.2.0.0/GHC-Generics.html#t:Rep
> > > >
> > > > a
> > > > x
> > > > But I don't have a "a" to start from! I see from the related papers that
> > > > the automatically generated code from from actually does pattern matches
> > > on
> > > > constructors, so I need a value, undefined won't work. However I see the
> > > > GHC.Generics also provide :+: (Sums: encode choice between constructors).
> > > > If I have to provide an value, then the choice between constructor has
> > > been
> > > > done! The examples about generics on
> > > > http://www.haskell.org/haskellwiki/GHC.Generics do provide an example of
> > > > defining the instance for :+: but I don't understand how we can get
> > > there.
> > > > If I have a class method that takes a value as a parameter, and I pass
> > > > undefined to it, the code will crash, since it can't pattern match on
> > > > undefined.
> > > >
> > > > Can somebody shed some light on this? Am I using the wrong tool for the
> > > > job? How can I achieve what I want? I want the full type representation
> > > > with sums, but without a value to start from.
> > > >
> > > > Thanks a million!
> > > >
> > > > JP
> > > > --
> > > > JP Moresmau
> > > > http://jpmoresmau.blogspot.com/
> > >
> > > > _______________________________________________
> > > > Haskell-Cafe mailing list
> > > > Haskell-Cafe at haskell.org
> > > > http://www.haskell.org/mailman/listinfo/haskell-cafe
> > >
> > >
> >
> >
> > --
> > JP Moresmau
> > http://jpmoresmau.blogspot.com/
More information about the Haskell-Cafe
mailing list