Hi Philipp,

On 06/29/2011 11:50 PM, Philipp Schneider wrote:
Hi cafe,

in my program i use a monad of the following type

newtype M a = M (State ->  (a, State))

btw., it looks like you just rebuilt the State monad.


...

instance (Show a,Show b) =>  Show (M (a,b)) where
    show (M f) = let ((v,_), s) = f 0 in
      "Value: " ++ show v ++  " Count: " ++ show s

instance Show a =>  Show (M a) where
    show (M f) = let (v, s) = f 0 in
      "Value: " ++ show v ++  " Count: " ++ show s

however this gives me the following error message:

     Overlapping instances for Show (M (Value, Environment))
       arising from a use of `print'
     Matching instances:
       instance (Show a, Show b) =>  Show (M (a, b))
         -- Defined at
/home/phil/code/haskell/vorlesung/ue09/ue09-3c3.hs:78:10-42
       instance Show a =>  Show (M a)
         -- Defined at
/home/phil/code/haskell/vorlesung/ue09/ue09-3c3.hs:82:10-29
     In a stmt of an interactive GHCi command: print it

This is a well-known issue. The problem is as follows: Your second instance declares an instance Show (M a) for any type a. If a is of the Form (b, c), we can derive a tuple instance from that. This however conflicts with the tuple instance declared above.

If you want GHC to choose the most specific instance (which would be your first one for tuples), use the

{-# LANGUAGE OverlappingInstances #-}

pragma. Be careful with this however, as it might lead to unexpected results. For a similar problem, you may want to consult the haskell wiki[1].

-- Steffen

[1] http://haskell.org/haskellwiki/GHC/AdvancedOverlap

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

Reply via email to