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