Example using gmapQ

Hi All, I got this far: {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveDataTypeable #-} import Data.Text import Data.Typeable import Data.Data data Thing = Thing { foo :: Int, bar :: String} deriving (Read, Show, Typeable, Data) thing :: Thing thing = Thing 1 "wop" con = toConstr thing fields = constrFields con main = putStrLn $ show con ++ show fields ++ ( Prelude.concat $ gmapQ show thing ) But it's barfing like this: Could not deduce (Show d) arising from a use of `show' from the context (Data d) bound by a type expected by the context: Data d => d -> [Char] at w.hs:76:65-80 I can see why, but not how to fix it. Any help much appreciated, Adrian.

Comment out the last line (main = etc...) and do this in ghci, :t (show thing) Type of (show thing) is String. This is input to gmapQ function which has following type. :t gmapQ gmapQ :: Data a => (forall d. Data d => d -> u) -> a -> [u] First argument to this function has the type (d -> u). Surely, this can't be String. -- Dilawar EE, IITB On Sat, Jul 13, 2013 at 04:48:49PM +0800, Adrian May wrote:
Hi All,
I got this far:
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveDataTypeable #-} import Data.Text import Data.Typeable import Data.Data
data Thing = Thing { foo :: Int, bar :: String} deriving (Read, Show, Typeable, Data) thing :: Thing thing = Thing 1 "wop" con = toConstr thing fields = constrFields con main = putStrLn $ show con ++ show fields ++ ( Prelude.concat $ gmapQ show thing )
But it's barfing like this:
Could not deduce (Show d) arising from a use of `show' from the context (Data d) bound by a type expected by the context: Data d => d -> [Char] at w.hs:76:65-80
I can see why, but not how to fix it.
Any help much appreciated, Adrian.
_______________________________________________ Beginners mailing list Beginners@haskell.org http://www.haskell.org/mailman/listinfo/beginners
participants (2)
-
Adrian May
-
Dilawar Singh