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