Re: [Haskell-cafe] Deriving instances with GADTs

2011-08-05 Thread Daniel Schüssler
Hi,

you can declare an instance 

instance Show (OrderType s o) where ...

this makes sense since it means for every type s and o, OrderType s o is 
showable, which is vacuously true if (s,o) isn't in {Buy,Sell} x {Market, 
Limit} (because in that case, there /is/ no non-bottom value of type 
'OrderType s o').

Obviously, this will make the newtype's 'deriving' clause work.

Furthermore, you can use {-# LANGUAGE StandaloneDeriving #-} and write

deriving instance Show (OrderType s o)

(Standalone deriving works differently from a 'deriving' clause; the former 
generates the code regardless of how weird the type is and lets the 
typechecker decide. For your GADT, this succeeds).

Cheers,
Daniel Schüssler

On 2011-August-04 Thursday 08:57:46 Tim Cowlishaw wrote:
 Hi all,
 
 I've been writing a DSL to describe securities orders, and after a lot
 of help from the kind folk of this list and #haskell have come up with
 the following implementation, using generalised algebraic data types:
 
 https://gist.github.com/1124621
 
 Elsewhere in my application, I make use of the order type defined
 therein in the following newtype declaration:
 
  newtype OrderListLevel s = OrderListLevel {orders :: [Order s Limit]}
 deriving (Eq, Show)
 
 However, the 'deriving' clause here fails:
 
 src/Simulation/OrderList.hs:9:82:
 No instance for (Eq (Order s Limit))
   arising from the 'deriving' clause of a data type declaration
at src/Simulation/OrderList.hs:9:82-83
 
 src/Simulation/OrderList.hs:9:86:
 No instance for (Show (Order s Limit))
   arising from the 'deriving' clause of a data type declaration
at src/Simulation/OrderList.hs:9:86-89
 
 
 
 I don't fully understand this - the error is correct that there is no
 instance of either Eq or Show for (Order s Limit), however, instances
 are defined for Order Buy Limit and Order Sell Limit, and since these
 are the only possible types that a value can be constructed with (the
 type constructor is 'closed' over these types in some sense I guess),
 it seems to me that this should provide enough information to derive
 the Eq and Show instances. Am I making unreasonable expectations of
 ghci's instance-deriving mechanism here, or missing something obvious?
 
 Many thanks in advance,
 
 Tim
 
 ___
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/mailman/listinfo/haskell-cafe

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Deriving instances with GADTs

2011-08-04 Thread Tim Cowlishaw
Hi all,

I've been writing a DSL to describe securities orders, and after a lot
of help from the kind folk of this list and #haskell have come up with
the following implementation, using generalised algebraic data types:

https://gist.github.com/1124621

Elsewhere in my application, I make use of the order type defined
therein in the following newtype declaration:

 newtype OrderListLevel s = OrderListLevel {orders :: [Order s Limit]}
deriving (Eq, Show)

However, the 'deriving' clause here fails:

src/Simulation/OrderList.hs:9:82:
No instance for (Eq (Order s Limit))
  arising from the 'deriving' clause of a data type declaration
   at src/Simulation/OrderList.hs:9:82-83

src/Simulation/OrderList.hs:9:86:
No instance for (Show (Order s Limit))
  arising from the 'deriving' clause of a data type declaration
   at src/Simulation/OrderList.hs:9:86-89



I don't fully understand this - the error is correct that there is no
instance of either Eq or Show for (Order s Limit), however, instances
are defined for Order Buy Limit and Order Sell Limit, and since these
are the only possible types that a value can be constructed with (the
type constructor is 'closed' over these types in some sense I guess),
it seems to me that this should provide enough information to derive
the Eq and Show instances. Am I making unreasonable expectations of
ghci's instance-deriving mechanism here, or missing something obvious?

Many thanks in advance,

Tim

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Deriving instances with GADTs

2011-08-04 Thread José Pedro Magalhães
Hi Tim,

On Thu, Aug 4, 2011 at 08:57, Tim Cowlishaw t...@timcowlishaw.co.uk wrote:

 Hi all,

 I've been writing a DSL to describe securities orders, and after a lot
 of help from the kind folk of this list and #haskell have come up with
 the following implementation, using generalised algebraic data types:

 https://gist.github.com/1124621

 Elsewhere in my application, I make use of the order type defined
 therein in the following newtype declaration:

  newtype OrderListLevel s = OrderListLevel {orders :: [Order s Limit]}
 deriving (Eq, Show)

 However, the 'deriving' clause here fails:

 src/Simulation/OrderList.hs:9:82:
No instance for (Eq (Order s Limit))
  arising from the 'deriving' clause of a data type declaration
   at src/Simulation/OrderList.hs:9:82-83

 src/Simulation/OrderList.hs:9:86:
No instance for (Show (Order s Limit))
  arising from the 'deriving' clause of a data type declaration
   at src/Simulation/OrderList.hs:9:86-89



 I don't fully understand this - the error is correct that there is no
 instance of either Eq or Show for (Order s Limit), however, instances
 are defined for Order Buy Limit and Order Sell Limit, and since these
 are the only possible types that a value can be constructed with (the
 type constructor is 'closed' over these types in some sense I guess),
 it seems to me that this should provide enough information to derive
 the Eq and Show instances. Am I making unreasonable expectations of
 ghci's instance-deriving mechanism here, or missing something obvious?


Here you seem to be using newtype deriving in particular, which behaves
differently from standard deriving. Compiling with -ddump-deriv will show
you the instances GHC is generating, which can help in debugging.

Note however that deriving instances for GADTs is not trivial, in general.
In particular, you should not assume that GHC knows that `s` can only be
instantiated with `Buy` and `Sell` since (because we lack a proper kind
system) nothing prevents you from later using, say, `Order Int Limit`
somewhere.

I describe the issue in more detail in the paper:

 José Pedro Magalhães and Johan Jeuring. Generic Programming for Indexed
 Datatypes.
 Color pdf: http://dreixel.net/research/pdf/gpid.pdf
 Greyscale pdf: http://dreixel.net/research/pdf/gpid_nocolor.pdf



Cheers,
Pedro



 Many thanks in advance,

 Tim

 ___
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/mailman/listinfo/haskell-cafe

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Deriving instances with GADTs

2011-08-04 Thread Tim Cowlishaw
2011/8/4 José Pedro Magalhães j...@cs.uu.nl:

 Here you seem to be using newtype deriving in particular, which behaves
 differently from standard deriving. Compiling with -ddump-deriv will show
 you the instances GHC is generating, which can help in debugging.

Aah - this is very useful, thanks!

 Note however that deriving instances for GADTs is not trivial, in general.
 In particular, you should not assume that GHC knows that `s` can only be
 instantiated with `Buy` and `Sell` since (because we lack a proper kind
 system) nothing prevents you from later using, say, `Order Int Limit`
 somewhere.

Aah - this is something like what I suspected (The type signature for
OrderListLevel doesn't preclude eg OrderListLevel Int which would need
an instance of (Eq|Show) for Order Int Limit, which does not exist.

 I describe the issue in more detail in the paper:

 José Pedro Magalhães and Johan Jeuring. Generic Programming for Indexed
 Datatypes.
 Color pdf: http://dreixel.net/research/pdf/gpid.pdf
 Greyscale pdf: http://dreixel.net/research/pdf/gpid_nocolor.pdf

Oh, brilliant, thank you! I'll take a look now.

Thanks,

Tim

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe