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