Data/Generics/Instances.hs

   1 -----------------------------------------------------------------------------
   2 -- |
   3 -- Module      :  Data.Generics.Instances
   4 -- Copyright   :  (c) The University of Glasgow, CWI 2001--2004
   5 -- License     :  BSD-style (see the file libraries/base/LICENSE)
   6 --
   7 -- Maintainer  :  libraries@haskell.org
   8 -- Stability   :  experimental
   9 -- Portability :  non-portable (uses Data.Generics.Basics)
  10 --
  11 -- \"Scrap your boilerplate\" --- Generic programming in Haskell
  12 -- See <http://www.cs.vu.nl/boilerplate/>. The present module
  13 -- instantiates the class Data for Prelude-like datatypes.
  14 -- (This module does not export anything. It really just defines instances.)
  15 --
  16 -----------------------------------------------------------------------------
  17
  18 module Data.Generics.Instances where
  19
  20
  21 ------------------------------------------------------------------------------
  22
  23 #ifdef __HADDOCK__
  24 import Prelude
  25 #endif
  26
  27 import Data.Generics.Basics
  28
  29 import Data.Typeable
  30 import Data.Int              -- So we can give Data instance for Int8, ...
  31 import Data.Word             -- So we can give Data instance for Word8, ...
  32 import GHC.Real( Ratio(..) ) -- So we can give Data instance for Ratio
  33 import GHC.IOBase            -- So we can give Data instance for IO, Handle
  34 import GHC.Ptr               -- So we can give Data instance for Ptr
  35 import GHC.ForeignPtr        -- So we can give Data instance for ForeignPtr
  36 import GHC.Stable            -- So we can give Data instance for StablePtr
  37 import GHC.ST                -- So we can give Data instance for ST
  38 import GHC.Conc              -- So we can give Data instance for MVar & Co.
  39 import GHC.Arr               -- So we can give Data instance for Array
  40
  41 #include "Typeable.h"
  42
  43
  44 ------------------------------------------------------------------------------
  45 --
  46 --      Instances of the Data class for Prelude-like types.
  47 --      We define top-level definitions for representations.
  48 --
  49 ------------------------------------------------------------------------------
  50
  51
  52 falseConstr  = mkConstr boolDataType "False" [] Prefix
  53 trueConstr   = mkConstr boolDataType "True"  [] Prefix
  54 boolDataType = mkDataType "Prelude.Bool" [falseConstr,trueConstr]
  55
  56
  57 instance Data Bool where
  58   toConstr False = falseConstr
  59   toConstr True  = trueConstr
  60   gunfold k z c  = case constrIndex c of
  61                      1 -> z False
  62                      2 -> z True
  63                      _ -> error "gunfold"
  64   dataTypeOf _ = boolDataType
  65
  66
  67 ------------------------------------------------------------------------------
  68
  69
  70 charType = mkStringType "Prelude.Char"
  71
  72 instance Data Char where
  73   toConstr x = mkStringConstr charType [x]
  74   gunfold k z c = case constrRep c of
  75                     (StringConstr [x]) -> z x
  76                     _ -> error "gunfold"
  77   dataTypeOf _ = charType
  78
  79
  80 ------------------------------------------------------------------------------
  81
  82
  83 floatType = mkFloatType "Prelude.Float"
  84
  85 instance Data Float where
  86   toConstr x = mkFloatConstr floatType (realToFrac x)
  87   gunfold k z c = case constrRep c of
  88                     (FloatConstr x) -> z (realToFrac x)
  89                     _ -> error "gunfold"
  90   dataTypeOf _ = floatType
  91
  92
  93 ------------------------------------------------------------------------------
  94
  95
  96 doubleType = mkFloatType "Prelude.Double"
  97
  98 instance Data Double where
  99   toConstr = mkFloatConstr floatType
 100   gunfold k z c = case constrRep c of
 101                     (FloatConstr x) -> z x
 102                     _ -> error "gunfold"
 103   dataTypeOf _ = doubleType
 104
 105
 106 ------------------------------------------------------------------------------
 107
 108
 109 intType = mkIntType "Prelude.Int"
 110
 111 instance Data Int where
 112   toConstr x = mkIntConstr intType (fromIntegral x)
 113   gunfold k z c = case constrRep c of
 114                     (IntConstr x) -> z (fromIntegral x)
 115                     _ -> error "gunfold"
 116   dataTypeOf _ = intType
 117
 118
 119 ------------------------------------------------------------------------------
 120
 121
 122 integerType = mkIntType "Prelude.Integer"
 123
 124 instance Data Integer where
 125   toConstr = mkIntConstr integerType
 126   gunfold k z c = case constrRep c of
 127                     (IntConstr x) -> z x
 128                     _ -> error "gunfold"
 129   dataTypeOf _ = integerType
 130
 131
 132 ------------------------------------------------------------------------------
 133
 134
 135 int8Type = mkIntType "Data.Int.Int8"
 136
 137 instance Data Int8 where
 138   toConstr x = mkIntConstr int8Type (fromIntegral x)
 139   gunfold k z c = case constrRep c of
 140                     (IntConstr x) -> z (fromIntegral x)
 141                     _ -> error "gunfold"
 142   dataTypeOf _ = int8Type
 143
 144
 145 ------------------------------------------------------------------------------
 146
 147
 148 int16Type = mkIntType "Data.Int.Int16"
 149
 150 instance Data Int16 where
 151   toConstr x = mkIntConstr int16Type (fromIntegral x)
 152   gunfold k z c = case constrRep c of
 153                     (IntConstr x) -> z (fromIntegral x)
 154                     _ -> error "gunfold"
 155   dataTypeOf _ = int16Type
 156
 157
 158 ------------------------------------------------------------------------------
 159
 160
 161 int32Type = mkIntType "Data.Int.Int32"
 162
 163 instance Data Int32 where
 164   toConstr x = mkIntConstr int32Type (fromIntegral x)
 165   gunfold k z c = case constrRep c of
 166                     (IntConstr x) -> z (fromIntegral x)
 167                     _ -> error "gunfold"
 168   dataTypeOf _ = int32Type
 169
 170
 171 ------------------------------------------------------------------------------
 172
 173
 174 int64Type = mkIntType "Data.Int.Int64"
 175
 176 instance Data Int64 where
 177   toConstr x = mkIntConstr int64Type (fromIntegral x)
 178   gunfold k z c = case constrRep c of
 179                     (IntConstr x) -> z (fromIntegral x)
 180                     _ -> error "gunfold"
 181   dataTypeOf _ = int64Type
 182
 183
 184 ------------------------------------------------------------------------------
 185
 186
 187 wordType = mkIntType "Data.Word.Word"
 188
 189 instance Data Word where
 190   toConstr x = mkIntConstr wordType (fromIntegral x)
 191   gunfold k z c = case constrRep c of
 192                     (IntConstr x) -> z (fromIntegral x)
 193                     _ -> error "gunfold"
 194   dataTypeOf _ = wordType
 195
 196
 197 ------------------------------------------------------------------------------
 198
 199
 200 word8Type = mkIntType "Data.Word.Word8"
 201
 202 instance Data Word8 where
 203   toConstr x = mkIntConstr word8Type (fromIntegral x)
 204   gunfold k z c = case constrRep c of
 205                     (IntConstr x) -> z (fromIntegral x)
 206                     _ -> error "gunfold"
 207   dataTypeOf _ = word8Type
 208
 209
 210 ------------------------------------------------------------------------------
 211
 212
 213 word16Type = mkIntType "Data.Word.Word16"
 214
 215 instance Data Word16 where
 216   toConstr x = mkIntConstr word16Type (fromIntegral x)
 217   gunfold k z c = case constrRep c of
 218                     (IntConstr x) -> z (fromIntegral x)
 219                     _ -> error "gunfold"
 220   dataTypeOf _ = word16Type
 221
 222
 223 ------------------------------------------------------------------------------
 224
 225
 226 word32Type = mkIntType "Data.Word.Word32"
 227
 228 instance Data Word32 where
 229   toConstr x = mkIntConstr word32Type (fromIntegral x)
 230   gunfold k z c = case constrRep c of
 231                     (IntConstr x) -> z (fromIntegral x)
 232                     _ -> error "gunfold"
 233   dataTypeOf _ = word32Type
 234
 235
 236 ------------------------------------------------------------------------------
 237
 238
 239 word64Type = mkIntType "Data.Word.Word64"
 240
 241 instance Data Word64 where
 242   toConstr x = mkIntConstr word64Type (fromIntegral x)
 243   gunfold k z c = case constrRep c of
 244                     (IntConstr x) -> z (fromIntegral x)
 245                     _ -> error "gunfold"
 246   dataTypeOf _ = word64Type
 247
 248
 249 ------------------------------------------------------------------------------
 250
 251
 252 ratioConstr = mkConstr ratioDataType ":%" [] Infix
 253 ratioDataType = mkDataType "GHC.Real.Ratio" [ratioConstr]
 254
 255 instance (Data a, Integral a) => Data (Ratio a) where
 256   toConstr _ = ratioConstr
 257   gunfold k z c | constrIndex c == 1 = k (k (z (:%)))
 258   gunfold _ _ _ = error "gunfold"
 259   dataTypeOf _  = ratioDataType
 260
 261
 262 ------------------------------------------------------------------------------
 263
 264
 265 nilConstr    = mkConstr listDataType "[]" [] Prefix
 266 consConstr   = mkConstr listDataType "(:)" [] Infix
 267 listDataType = mkDataType "Prelude.[]" [nilConstr,consConstr]
 268
 269 instance Data a => Data [a] where
 270   gfoldl f z []     = z []
 271   gfoldl f z (x:xs) = z (:) `f` x `f` xs
 272   toConstr []    = nilConstr
 273   toConstr (_:_) = consConstr
 274   gunfold k z c = case constrIndex c of
 275                     1 -> z []
 276                     2 -> k (k (z (:)))
 277                     _ -> error "gunfold"
 278   dataTypeOf _ = listDataType
 279   dataCast1 f  = gcast1 f
 280
 281 --
 282 -- The gmaps are given as an illustration.
 283 -- This shows that the gmaps for lists are different from list maps.
 284 --
 285   gmapT  f   []     = []
 286   gmapT  f   (x:xs) = (f x:f xs)
 287   gmapQ  f   []     = []
 288   gmapQ  f   (x:xs) = [f x,f xs]
 289   gmapM  f   []     = return []
 290   gmapM  f   (x:xs) = f x >>= \x' -> f xs >>= \xs' -> return (x':xs')
 291
 292
 293 ------------------------------------------------------------------------------
 294
 295
 296 nothingConstr = mkConstr maybeDataType "Nothing" [] Prefix
 297 justConstr    = mkConstr maybeDataType "Just"    [] Prefix
 298 maybeDataType = mkDataType "Prelude.Maybe" [nothingConstr,justConstr]
 299
 300 instance Data a => Data (Maybe a) where
 301   gfoldl f z Nothing  = z Nothing
 302   gfoldl f z (Just x) = z Just `f` x
 303   toConstr Nothing  = nothingConstr
 304   toConstr (Just _) = justConstr
 305   gunfold k z c = case constrIndex c of
 306                     1 -> z Nothing
 307                     2 -> k (z Just)
 308                     _ -> error "gunfold"
 309   dataTypeOf _ = maybeDataType
 310   dataCast1 f  = gcast1 f
 311
 312
 313 ------------------------------------------------------------------------------
 314
 315
 316 ltConstr         = mkConstr orderingDataType "LT" [] Prefix
 317 eqConstr         = mkConstr orderingDataType "EQ" [] Prefix
 318 gtConstr         = mkConstr orderingDataType "GT" [] Prefix
 319 orderingDataType = mkDataType "Prelude.Ordering" [ltConstr,eqConstr,gtConstr]
 320
 321 instance Data Ordering where
 322   gfoldl f z LT  = z LT
 323   gfoldl f z EQ  = z EQ
 324   gfoldl f z GT  = z GT
 325   toConstr LT  = ltConstr
 326   toConstr EQ  = eqConstr
 327   toConstr GT  = gtConstr
 328   gunfold k z c = case constrIndex c of
 329                     1 -> z LT
 330                     2 -> z EQ
 331                     3 -> z GT
 332                     _ -> error "gunfold"
 333   dataTypeOf _ = orderingDataType
 334
 335
 336 ------------------------------------------------------------------------------
 337
 338
 339 leftConstr     = mkConstr eitherDataType "Left"  [] Prefix
 340 rightConstr    = mkConstr eitherDataType "Right" [] Prefix
 341 eitherDataType = mkDataType "Prelude.Either" [leftConstr,rightConstr]
 342
 343 instance (Data a, Data b) => Data (Either a b) where
 344   gfoldl f z (Left a)   = z Left  `f` a
 345   gfoldl f z (Right a)  = z Right `f` a
 346   toConstr (Left _)  = leftConstr
 347   toConstr (Right _) = rightConstr
 348   gunfold k z c = case constrIndex c of
 349                     1 -> k (z Left)
 350                     2 -> k (z Right)
 351                     _ -> error "gunfold"
 352   dataTypeOf _ = eitherDataType
 353   dataCast2 f  = gcast2 f
 354
 355
 356 ------------------------------------------------------------------------------
 357
 358
 359 --
 360 -- A last resort for functions
 361 --
 362
 363 instance (Data a, Data b) => Data (a -> b) where
 364   toConstr _   = error "toConstr"
 365   gunfold _ _  = error "gunfold"
 366   dataTypeOf _ = mkNorepType "Prelude.(->)"
 367   dataCast2 f  = gcast2 f
 368
 369
 370 ------------------------------------------------------------------------------
 371
 372
 373 tuple0Constr = mkConstr tuple0DataType "()" [] Prefix
 374 tuple0DataType = mkDataType "Prelude.()" [tuple0Constr]
 375
 376 instance Data () where
 377   toConstr ()   = tuple0Constr
 378   gunfold k z c | constrIndex c == 1 = z ()
 379   gunfold _ _ _ = error "gunfold"
 380   dataTypeOf _  = tuple0DataType
 381
 382
 383 ------------------------------------------------------------------------------
 384
 385
 386 tuple2Constr = mkConstr tuple2DataType "(,)" [] Infix
 387 tuple2DataType = mkDataType "Prelude.(,)" [tuple2Constr]
 388
 389 instance (Data a, Data b) => Data (a,b) where
 390   gfoldl f z (a,b) = z (,) `f` a `f` b
 391   toConstr (a,b) = tuple2Constr
 392   gunfold k z c | constrIndex c == 1 = k (k (z (,)))
 393   gunfold _ _ _ = error "gunfold"
 394   dataTypeOf _  = tuple2DataType
 395   dataCast2 f   = gcast2 f
 396
 397
 398 ------------------------------------------------------------------------------
 399
 400
 401 tuple3Constr = mkConstr tuple3DataType "(,,)" [] Infix
 402 tuple3DataType = mkDataType "Prelude.(,)" [tuple3Constr]
 403
 404 instance (Data a, Data b, Data c) => Data (a,b,c) where
 405   gfoldl f z (a,b,c) = z (,,) `f` a `f` b `f` c
 406   toConstr (a,b,c) = tuple3Constr
 407   gunfold k z c | constrIndex c == 1 = k (k (k (z (,,))))
 408   gunfold _ _ _ = error "gunfold"
 409   dataTypeOf _  = tuple3DataType
 410
 411
 412 ------------------------------------------------------------------------------
 413
 414
 415 tuple4Constr = mkConstr tuple4DataType "(,,,)" [] Infix
 416 tuple4DataType = mkDataType "Prelude.(,,,)" [tuple4Constr]
 417
 418 instance (Data a, Data b, Data c, Data d)
 419          => Data (a,b,c,d) where
 420   gfoldl f z (a,b,c,d) = z (,,,) `f` a `f` b `f` c `f` d
 421   toConstr (a,b,c,d) = tuple4Constr
 422   gunfold k z c = case constrIndex c of
 423                     1 -> k (k (k (k (z (,,,)))))
 424                     _ -> error "gunfold"
 425   dataTypeOf _ = tuple4DataType
 426
 427
 428 ------------------------------------------------------------------------------
 429
 430
 431 tuple5Constr = mkConstr tuple5DataType "(,,,,)" [] Infix
 432 tuple5DataType = mkDataType "Prelude.(,,,,)" [tuple5Constr]
 433
 434 instance (Data a, Data b, Data c, Data d, Data e)
 435          => Data (a,b,c,d,e) where
 436   gfoldl f z (a,b,c,d,e) = z (,,,,) `f` a `f` b `f` c `f` d `f` e
 437   toConstr (a,b,c,d,e) = tuple5Constr
 438   gunfold k z c = case constrIndex c of
 439                     1 -> k (k (k (k (k (z (,,,,))))))
 440                     _ -> error "gunfold"
 441   dataTypeOf _ = tuple5DataType
 442
 443
 444 ------------------------------------------------------------------------------
 445
 446
 447 tuple6Constr = mkConstr tuple6DataType "(,,,,,)" [] Infix
 448 tuple6DataType = mkDataType "Prelude.(,,,,,)" [tuple6Constr]
 449
 450 instance (Data a, Data b, Data c, Data d, Data e, Data f)
 451          => Data (a,b,c,d,e,f) where
 452   gfoldl f z (a,b,c,d,e,f') = z (,,,,,) `f` a `f` b `f` c `f` d `f` e `f` f'
 453   toConstr (a,b,c,d,e,f) = tuple6Constr
 454   gunfold k z c = case constrIndex c of
 455                     1 -> k (k (k (k (k (k (z (,,,,,)))))))
 456                     _ -> error "gunfold"
 457   dataTypeOf _ = tuple6DataType
 458
 459
 460 ------------------------------------------------------------------------------
 461
 462
 463 tuple7Constr = mkConstr tuple7DataType "(,,,,,,)" [] Infix
 464 tuple7DataType = mkDataType "Prelude.(,,,,,,)" [tuple7Constr]
 465
 466 instance (Data a, Data b, Data c, Data d, Data e, Data f, Data g)
 467          => Data (a,b,c,d,e,f,g) where
 468   gfoldl f z (a,b,c,d,e,f',g) =
 469     z (,,,,,,) `f` a `f` b `f` c `f` d `f` e `f` f' `f` g
 470   toConstr  (a,b,c,d,e,f,g) = tuple7Constr
 471   gunfold k z c = case constrIndex c of
 472                     1 -> k (k (k (k (k (k (k (z (,,,,,,))))))))
 473                     _ -> error "gunfold"
 474   dataTypeOf _ = tuple7DataType
 475
 476
 477 ------------------------------------------------------------------------------
 478
 479
 480 instance Data TypeRep where
 481   toConstr _   = error "toConstr"
 482   gunfold _ _  = error "gunfold"
 483   dataTypeOf _ = mkNorepType "Data.Typeable.TypeRep"
 484
 485
 486 ------------------------------------------------------------------------------
 487
 488
 489 instance Data TyCon where
 490   toConstr _   = error "toConstr"
 491   gunfold _ _  = error "gunfold"
 492   dataTypeOf _ = mkNorepType "Data.Typeable.TyCon"
 493
 494
 495 ------------------------------------------------------------------------------
 496
 497
 498 INSTANCE_TYPEABLE0(DataType,dataTypeTc,"DataType")
 499
 500 instance Data DataType where
 501   toConstr _   = error "toConstr"
 502   gunfold _ _  = error "gunfold"
 503   dataTypeOf _ = mkNorepType "Data.Generics.Basics.DataType"
 504
 505
 506 ------------------------------------------------------------------------------
 507
 508
 509 instance Typeable a => Data (IO a) where
 510   toConstr _   = error "toConstr"
 511   gunfold _ _  = error "gunfold"
 512   dataTypeOf _ = mkNorepType "GHC.IOBase.IO"
 513
 514
 515 ------------------------------------------------------------------------------
 516
 517
 518 instance Data Handle where
 519   toConstr _   = error "toConstr"
 520   gunfold _ _  = error "gunfold"
 521   dataTypeOf _ = mkNorepType "GHC.IOBase.Handle"
 522
 523
 524 ------------------------------------------------------------------------------
 525
 526
 527 instance Typeable a => Data (Ptr a) where
 528   toConstr _   = error "toConstr"
 529   gunfold _ _  = error "gunfold"
 530   dataTypeOf _ = mkNorepType "GHC.Ptr.Ptr"
 531
 532
 533 ------------------------------------------------------------------------------
 534
 535
 536 instance Typeable a => Data (StablePtr a) where
 537   toConstr _   = error "toConstr"
 538   gunfold _ _  = error "gunfold"
 539   dataTypeOf _ = mkNorepType "GHC.Stable.StablePtr"
 540
 541
 542 ------------------------------------------------------------------------------
 543
 544
 545 instance Typeable a => Data (IORef a) where
 546   toConstr _   = error "toConstr"
 547   gunfold _ _  = error "gunfold"
 548   dataTypeOf _ = mkNorepType "GHC.IOBase.IORef"
 549
 550
 551 ------------------------------------------------------------------------------
 552
 553
 554 instance Typeable a => Data (ForeignPtr a) where
 555   toConstr _   = error "toConstr"
 556   gunfold _ _  = error "gunfold"
 557   dataTypeOf _ = mkNorepType "GHC.ForeignPtr.ForeignPtr"
 558
 559
 560 ------------------------------------------------------------------------------
 561
 562
 563 instance (Typeable s, Typeable a) => Data (ST s a) where
 564   toConstr _   = error "toConstr"
 565   gunfold _ _  = error "gunfold"
 566   dataTypeOf _ = mkNorepType "GHC.ST.ST"
 567
 568
 569 ------------------------------------------------------------------------------
 570
 571
 572 instance Data ThreadId where
 573   toConstr _   = error "toConstr"
 574   gunfold _ _  = error "gunfold"
 575   dataTypeOf _ = mkNorepType "GHC.Conc.ThreadId"
 576
 577
 578 ------------------------------------------------------------------------------
 579
 580
 581 instance Typeable a => Data (TVar a) where
 582   toConstr _   = error "toConstr"
 583   gunfold _ _  = error "gunfold"
 584   dataTypeOf _ = mkNorepType "GHC.Conc.TVar"
 585
 586
 587 ------------------------------------------------------------------------------
 588
 589
 590 instance Typeable a => Data (MVar a) where
 591   toConstr _   = error "toConstr"
 592   gunfold _ _  = error "gunfold"
 593   dataTypeOf _ = mkNorepType "GHC.Conc.MVar"
 594
 595
 596 ------------------------------------------------------------------------------
 597
 598
 599 instance Typeable a => Data (STM a) where
 600   toConstr _   = error "toConstr"
 601   gunfold _ _  = error "gunfold"
 602   dataTypeOf _ = mkNorepType "GHC.Conc.STM"
 603
 604
 605 ------------------------------------------------------------------------------
 606 -- The Data instance for Array preserves data abstraction at the cost of inefficiency.
 607 -- We omit reflection services for the sake of data abstraction.
 608 instance (Typeable a, Data b, Ix a) => Data (Array a b)
 609  where
 610   gfoldl f z a = z (listArray (bounds a)) `f` (elems a)
 611   toConstr _   = error "toConstr"
 612   gunfold _ _  = error "gunfold"
 613   dataTypeOf _ = mkNorepType "Data.Array.Array"
 614