----------------------------------------------------------------------------- -- | -- Module : Data.Generics.Instances -- Copyright : (c) The University of Glasgow, CWI 2001--2004 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (uses Data.Generics.Basics) -- -- \"Scrap your boilerplate\" --- Generic programming in Haskell -- See . The present module -- instantiates the class Data for Prelude-like datatypes. -- (This module does not export anything. It really just defines instances.) -- ----------------------------------------------------------------------------- module Data.Generics.Instances where ------------------------------------------------------------------------------ #ifdef __HADDOCK__ import Prelude #endif import Data.Generics.Basics import Data.Typeable import Data.Int -- So we can give Data instance for Int8, ... import Data.Word -- So we can give Data instance for Word8, ... import GHC.Real( Ratio(..) ) -- So we can give Data instance for Ratio import GHC.IOBase -- So we can give Data instance for IO, Handle import GHC.Ptr -- So we can give Data instance for Ptr import GHC.ForeignPtr -- So we can give Data instance for ForeignPtr import GHC.Stable -- So we can give Data instance for StablePtr import GHC.ST -- So we can give Data instance for ST import GHC.Conc -- So we can give Data instance for MVar & Co. import GHC.Arr -- So we can give Data instance for Array #include "Typeable.h" ------------------------------------------------------------------------------ -- -- Instances of the Data class for Prelude-like types. -- We define top-level definitions for representations. -- ------------------------------------------------------------------------------ falseConstr = mkConstr boolDataType "False" [] Prefix trueConstr = mkConstr boolDataType "True" [] Prefix boolDataType = mkDataType "Prelude.Bool" [falseConstr,trueConstr] instance Data Bool where toConstr False = falseConstr toConstr True = trueConstr gunfold k z c = case constrIndex c of 1 -> z False 2 -> z True _ -> error "gunfold" dataTypeOf _ = boolDataType ------------------------------------------------------------------------------ charType = mkStringType "Prelude.Char" instance Data Char where toConstr x = mkStringConstr charType [x] gunfold k z c = case constrRep c of (StringConstr [x]) -> z x _ -> error "gunfold" dataTypeOf _ = charType ------------------------------------------------------------------------------ floatType = mkFloatType "Prelude.Float" instance Data Float where toConstr x = mkFloatConstr floatType (realToFrac x) gunfold k z c = case constrRep c of (FloatConstr x) -> z (realToFrac x) _ -> error "gunfold" dataTypeOf _ = floatType ------------------------------------------------------------------------------ doubleType = mkFloatType "Prelude.Double" instance Data Double where toConstr = mkFloatConstr floatType gunfold k z c = case constrRep c of (FloatConstr x) -> z x _ -> error "gunfold" dataTypeOf _ = doubleType ------------------------------------------------------------------------------ intType = mkIntType "Prelude.Int" instance Data Int where toConstr x = mkIntConstr intType (fromIntegral x) gunfold k z c = case constrRep c of (IntConstr x) -> z (fromIntegral x) _ -> error "gunfold" dataTypeOf _ = intType ------------------------------------------------------------------------------ integerType = mkIntType "Prelude.Integer" instance Data Integer where toConstr = mkIntConstr integerType gunfold k z c = case constrRep c of (IntConstr x) -> z x _ -> error "gunfold" dataTypeOf _ = integerType ------------------------------------------------------------------------------ int8Type = mkIntType "Data.Int.Int8" instance Data Int8 where toConstr x = mkIntConstr int8Type (fromIntegral x) gunfold k z c = case constrRep c of (IntConstr x) -> z (fromIntegral x) _ -> error "gunfold" dataTypeOf _ = int8Type ------------------------------------------------------------------------------ int16Type = mkIntType "Data.Int.Int16" instance Data Int16 where toConstr x = mkIntConstr int16Type (fromIntegral x) gunfold k z c = case constrRep c of (IntConstr x) -> z (fromIntegral x) _ -> error "gunfold" dataTypeOf _ = int16Type ------------------------------------------------------------------------------ int32Type = mkIntType "Data.Int.Int32" instance Data Int32 where toConstr x = mkIntConstr int32Type (fromIntegral x) gunfold k z c = case constrRep c of (IntConstr x) -> z (fromIntegral x) _ -> error "gunfold" dataTypeOf _ = int32Type ------------------------------------------------------------------------------ int64Type = mkIntType "Data.Int.Int64" instance Data Int64 where toConstr x = mkIntConstr int64Type (fromIntegral x) gunfold k z c = case constrRep c of (IntConstr x) -> z (fromIntegral x) _ -> error "gunfold" dataTypeOf _ = int64Type ------------------------------------------------------------------------------ wordType = mkIntType "Data.Word.Word" instance Data Word where toConstr x = mkIntConstr wordType (fromIntegral x) gunfold k z c = case constrRep c of (IntConstr x) -> z (fromIntegral x) _ -> error "gunfold" dataTypeOf _ = wordType ------------------------------------------------------------------------------ word8Type = mkIntType "Data.Word.Word8" instance Data Word8 where toConstr x = mkIntConstr word8Type (fromIntegral x) gunfold k z c = case constrRep c of (IntConstr x) -> z (fromIntegral x) _ -> error "gunfold" dataTypeOf _ = word8Type ------------------------------------------------------------------------------ word16Type = mkIntType "Data.Word.Word16" instance Data Word16 where toConstr x = mkIntConstr word16Type (fromIntegral x) gunfold k z c = case constrRep c of (IntConstr x) -> z (fromIntegral x) _ -> error "gunfold" dataTypeOf _ = word16Type ------------------------------------------------------------------------------ word32Type = mkIntType "Data.Word.Word32" instance Data Word32 where toConstr x = mkIntConstr word32Type (fromIntegral x) gunfold k z c = case constrRep c of (IntConstr x) -> z (fromIntegral x) _ -> error "gunfold" dataTypeOf _ = word32Type ------------------------------------------------------------------------------ word64Type = mkIntType "Data.Word.Word64" instance Data Word64 where toConstr x = mkIntConstr word64Type (fromIntegral x) gunfold k z c = case constrRep c of (IntConstr x) -> z (fromIntegral x) _ -> error "gunfold" dataTypeOf _ = word64Type ------------------------------------------------------------------------------ ratioConstr = mkConstr ratioDataType ":%" [] Infix ratioDataType = mkDataType "GHC.Real.Ratio" [ratioConstr] instance (Data a, Integral a) => Data (Ratio a) where toConstr _ = ratioConstr gunfold k z c | constrIndex c == 1 = k (k (z (:%))) gunfold _ _ _ = error "gunfold" dataTypeOf _ = ratioDataType ------------------------------------------------------------------------------ nilConstr = mkConstr listDataType "[]" [] Prefix consConstr = mkConstr listDataType "(:)" [] Infix listDataType = mkDataType "Prelude.[]" [nilConstr,consConstr] instance Data a => Data [a] where gfoldl f z [] = z [] gfoldl f z (x:xs) = z (:) `f` x `f` xs toConstr [] = nilConstr toConstr (_:_) = consConstr gunfold k z c = case constrIndex c of 1 -> z [] 2 -> k (k (z (:))) _ -> error "gunfold" dataTypeOf _ = listDataType dataCast1 f = gcast1 f -- -- The gmaps are given as an illustration. -- This shows that the gmaps for lists are different from list maps. -- gmapT f [] = [] gmapT f (x:xs) = (f x:f xs) gmapQ f [] = [] gmapQ f (x:xs) = [f x,f xs] gmapM f [] = return [] gmapM f (x:xs) = f x >>= \x' -> f xs >>= \xs' -> return (x':xs') ------------------------------------------------------------------------------ nothingConstr = mkConstr maybeDataType "Nothing" [] Prefix justConstr = mkConstr maybeDataType "Just" [] Prefix maybeDataType = mkDataType "Prelude.Maybe" [nothingConstr,justConstr] instance Data a => Data (Maybe a) where gfoldl f z Nothing = z Nothing gfoldl f z (Just x) = z Just `f` x toConstr Nothing = nothingConstr toConstr (Just _) = justConstr gunfold k z c = case constrIndex c of 1 -> z Nothing 2 -> k (z Just) _ -> error "gunfold" dataTypeOf _ = maybeDataType dataCast1 f = gcast1 f ------------------------------------------------------------------------------ ltConstr = mkConstr orderingDataType "LT" [] Prefix eqConstr = mkConstr orderingDataType "EQ" [] Prefix gtConstr = mkConstr orderingDataType "GT" [] Prefix orderingDataType = mkDataType "Prelude.Ordering" [ltConstr,eqConstr,gtConstr] instance Data Ordering where gfoldl f z LT = z LT gfoldl f z EQ = z EQ gfoldl f z GT = z GT toConstr LT = ltConstr toConstr EQ = eqConstr toConstr GT = gtConstr gunfold k z c = case constrIndex c of 1 -> z LT 2 -> z EQ 3 -> z GT _ -> error "gunfold" dataTypeOf _ = orderingDataType ------------------------------------------------------------------------------ leftConstr = mkConstr eitherDataType "Left" [] Prefix rightConstr = mkConstr eitherDataType "Right" [] Prefix eitherDataType = mkDataType "Prelude.Either" [leftConstr,rightConstr] instance (Data a, Data b) => Data (Either a b) where gfoldl f z (Left a) = z Left `f` a gfoldl f z (Right a) = z Right `f` a toConstr (Left _) = leftConstr toConstr (Right _) = rightConstr gunfold k z c = case constrIndex c of 1 -> k (z Left) 2 -> k (z Right) _ -> error "gunfold" dataTypeOf _ = eitherDataType dataCast2 f = gcast2 f ------------------------------------------------------------------------------ -- -- A last resort for functions -- instance (Data a, Data b) => Data (a -> b) where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNorepType "Prelude.(->)" dataCast2 f = gcast2 f ------------------------------------------------------------------------------ tuple0Constr = mkConstr tuple0DataType "()" [] Prefix tuple0DataType = mkDataType "Prelude.()" [tuple0Constr] instance Data () where toConstr () = tuple0Constr gunfold k z c | constrIndex c == 1 = z () gunfold _ _ _ = error "gunfold" dataTypeOf _ = tuple0DataType ------------------------------------------------------------------------------ tuple2Constr = mkConstr tuple2DataType "(,)" [] Infix tuple2DataType = mkDataType "Prelude.(,)" [tuple2Constr] instance (Data a, Data b) => Data (a,b) where gfoldl f z (a,b) = z (,) `f` a `f` b toConstr (a,b) = tuple2Constr gunfold k z c | constrIndex c == 1 = k (k (z (,))) gunfold _ _ _ = error "gunfold" dataTypeOf _ = tuple2DataType dataCast2 f = gcast2 f ------------------------------------------------------------------------------ tuple3Constr = mkConstr tuple3DataType "(,,)" [] Infix tuple3DataType = mkDataType "Prelude.(,)" [tuple3Constr] instance (Data a, Data b, Data c) => Data (a,b,c) where gfoldl f z (a,b,c) = z (,,) `f` a `f` b `f` c toConstr (a,b,c) = tuple3Constr gunfold k z c | constrIndex c == 1 = k (k (k (z (,,)))) gunfold _ _ _ = error "gunfold" dataTypeOf _ = tuple3DataType ------------------------------------------------------------------------------ tuple4Constr = mkConstr tuple4DataType "(,,,)" [] Infix tuple4DataType = mkDataType "Prelude.(,,,)" [tuple4Constr] instance (Data a, Data b, Data c, Data d) => Data (a,b,c,d) where gfoldl f z (a,b,c,d) = z (,,,) `f` a `f` b `f` c `f` d toConstr (a,b,c,d) = tuple4Constr gunfold k z c = case constrIndex c of 1 -> k (k (k (k (z (,,,))))) _ -> error "gunfold" dataTypeOf _ = tuple4DataType ------------------------------------------------------------------------------ tuple5Constr = mkConstr tuple5DataType "(,,,,)" [] Infix tuple5DataType = mkDataType "Prelude.(,,,,)" [tuple5Constr] instance (Data a, Data b, Data c, Data d, Data e) => Data (a,b,c,d,e) where gfoldl f z (a,b,c,d,e) = z (,,,,) `f` a `f` b `f` c `f` d `f` e toConstr (a,b,c,d,e) = tuple5Constr gunfold k z c = case constrIndex c of 1 -> k (k (k (k (k (z (,,,,)))))) _ -> error "gunfold" dataTypeOf _ = tuple5DataType ------------------------------------------------------------------------------ tuple6Constr = mkConstr tuple6DataType "(,,,,,)" [] Infix tuple6DataType = mkDataType "Prelude.(,,,,,)" [tuple6Constr] instance (Data a, Data b, Data c, Data d, Data e, Data f) => Data (a,b,c,d,e,f) where gfoldl f z (a,b,c,d,e,f') = z (,,,,,) `f` a `f` b `f` c `f` d `f` e `f` f' toConstr (a,b,c,d,e,f) = tuple6Constr gunfold k z c = case constrIndex c of 1 -> k (k (k (k (k (k (z (,,,,,))))))) _ -> error "gunfold" dataTypeOf _ = tuple6DataType ------------------------------------------------------------------------------ tuple7Constr = mkConstr tuple7DataType "(,,,,,,)" [] Infix tuple7DataType = mkDataType "Prelude.(,,,,,,)" [tuple7Constr] instance (Data a, Data b, Data c, Data d, Data e, Data f, Data g) => Data (a,b,c,d,e,f,g) where gfoldl f z (a,b,c,d,e,f',g) = z (,,,,,,) `f` a `f` b `f` c `f` d `f` e `f` f' `f` g toConstr (a,b,c,d,e,f,g) = tuple7Constr gunfold k z c = case constrIndex c of 1 -> k (k (k (k (k (k (k (z (,,,,,,)))))))) _ -> error "gunfold" dataTypeOf _ = tuple7DataType ------------------------------------------------------------------------------ instance Data TypeRep where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNorepType "Data.Typeable.TypeRep" ------------------------------------------------------------------------------ instance Data TyCon where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNorepType "Data.Typeable.TyCon" ------------------------------------------------------------------------------ INSTANCE_TYPEABLE0(DataType,dataTypeTc,"DataType") instance Data DataType where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNorepType "Data.Generics.Basics.DataType" ------------------------------------------------------------------------------ instance Typeable a => Data (IO a) where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNorepType "GHC.IOBase.IO" ------------------------------------------------------------------------------ instance Data Handle where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNorepType "GHC.IOBase.Handle" ------------------------------------------------------------------------------ instance Typeable a => Data (Ptr a) where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNorepType "GHC.Ptr.Ptr" ------------------------------------------------------------------------------ instance Typeable a => Data (StablePtr a) where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNorepType "GHC.Stable.StablePtr" ------------------------------------------------------------------------------ instance Typeable a => Data (IORef a) where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNorepType "GHC.IOBase.IORef" ------------------------------------------------------------------------------ instance Typeable a => Data (ForeignPtr a) where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNorepType "GHC.ForeignPtr.ForeignPtr" ------------------------------------------------------------------------------ instance (Typeable s, Typeable a) => Data (ST s a) where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNorepType "GHC.ST.ST" ------------------------------------------------------------------------------ instance Data ThreadId where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNorepType "GHC.Conc.ThreadId" ------------------------------------------------------------------------------ instance Typeable a => Data (TVar a) where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNorepType "GHC.Conc.TVar" ------------------------------------------------------------------------------ instance Typeable a => Data (MVar a) where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNorepType "GHC.Conc.MVar" ------------------------------------------------------------------------------ instance Typeable a => Data (STM a) where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNorepType "GHC.Conc.STM" ------------------------------------------------------------------------------ -- The Data instance for Array preserves data abstraction at the cost of inefficiency. -- We omit reflection services for the sake of data abstraction. instance (Typeable a, Data b, Ix a) => Data (Array a b) where gfoldl f z a = z (listArray (bounds a)) `f` (elems a) toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNorepType "Data.Array.Array"