1{-# LANGUAGE BangPatterns #-}
2{-# LANGUAGE DeriveDataTypeable #-}
3{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE GADTs #-}
6{-# LANGUAGE NoImplicitPrelude #-}
7{-# LANGUAGE DataKinds #-}
8{-# LANGUAGE PolyKinds #-}
9{-# LANGUAGE RankNTypes #-}
10{-# LANGUAGE ScopedTypeVariables #-}
11{-# LANGUAGE StandaloneDeriving #-}
12{-# LANGUAGE Trustworthy #-}
13{-# LANGUAGE TypeOperators #-}
14
15-----------------------------------------------------------------------------
16-- |
17-- Module      :  Data.Data
18-- Copyright   :  (c) The University of Glasgow, CWI 2001--2004
19-- License     :  BSD-style (see the file libraries/base/LICENSE)
20--
21-- Maintainer  :  libraries@haskell.org
22-- Stability   :  experimental
23-- Portability :  non-portable (local universal quantification)
24--
25-- \"Scrap your boilerplate\" --- Generic programming in Haskell.  See
26-- <http://www.haskell.org/haskellwiki/Research_papers/Generics#Scrap_your_boilerplate.21>.
27-- This module provides the 'Data' class with its primitives for
28-- generic programming, along with instances for many datatypes. It
29-- corresponds to a merge between the previous "Data.Generics.Basics"
30-- and almost all of "Data.Generics.Instances". The instances that are
31-- not present in this module were moved to the
32-- @Data.Generics.Instances@ module in the @syb@ package.
33--
34-- For more information, please visit the new
35-- SYB wiki: <http://www.cs.uu.nl/wiki/bin/view/GenericProgramming/SYB>.
36--
37-----------------------------------------------------------------------------
38
39module Data.Data (
40
41        -- * Module Data.Typeable re-exported for convenience
42        module Data.Typeable,
43
44        -- * The Data class for processing constructor applications
45        Data(
46                gfoldl,
47                gunfold,
48                toConstr,
49                dataTypeOf,
50                dataCast1,      -- mediate types and unary type constructors
51                dataCast2,      -- mediate types and binary type constructors
52                -- Generic maps defined in terms of gfoldl
53                gmapT,
54                gmapQ,
55                gmapQl,
56                gmapQr,
57                gmapQi,
58                gmapM,
59                gmapMp,
60                gmapMo
61            ),
62
63        -- * Datatype representations
64        DataType,       -- abstract
65        -- ** Constructors
66        mkDataType,
67        mkIntType,
68        mkFloatType,
69        mkCharType,
70        mkNoRepType,
71        -- ** Observers
72        dataTypeName,
73        DataRep(..),
74        dataTypeRep,
75        -- ** Convenience functions
76        repConstr,
77        isAlgType,
78        dataTypeConstrs,
79        indexConstr,
80        maxConstrIndex,
81        isNorepType,
82
83        -- * Data constructor representations
84        Constr,         -- abstract
85        ConIndex,       -- alias for Int, start at 1
86        Fixity(..),
87        -- ** Constructors
88        mkConstr,
89        mkIntegralConstr,
90        mkRealConstr,
91        mkCharConstr,
92        -- ** Observers
93        constrType,
94        ConstrRep(..),
95        constrRep,
96        constrFields,
97        constrFixity,
98        -- ** Convenience function: algebraic data types
99        constrIndex,
100        -- ** From strings to constructors and vice versa: all data types
101        showConstr,
102        readConstr,
103
104        -- * Convenience functions: take type constructors apart
105        tyconUQname,
106        tyconModule,
107
108        -- * Generic operations defined in terms of 'gunfold'
109        fromConstr,
110        fromConstrB,
111        fromConstrM
112
113  ) where
114
115
116------------------------------------------------------------------------------
117
118import Data.Functor.Const
119import Data.Either
120import Data.Eq
121import Data.Maybe
122import Data.Monoid
123import Data.Ord
124import Data.Typeable
125import Data.Version( Version(..) )
126import GHC.Base hiding (Any, IntRep, FloatRep)
127import GHC.List
128import GHC.Num
129import GHC.Read
130import GHC.Show
131import Text.Read( reads )
132
133-- Imports for the instances
134import Control.Applicative (WrappedArrow(..), WrappedMonad(..), ZipList(..))
135       -- So we can give them Data instances
136import Data.Functor.Identity -- So we can give Data instance for Identity
137import Data.Int              -- So we can give Data instance for Int8, ...
138import Data.Type.Coercion
139import Data.Word             -- So we can give Data instance for Word8, ...
140import GHC.Real              -- So we can give Data instance for Ratio
141--import GHC.IOBase            -- So we can give Data instance for IO, Handle
142import GHC.Ptr               -- So we can give Data instance for Ptr
143import GHC.ForeignPtr        -- So we can give Data instance for ForeignPtr
144import Foreign.Ptr (IntPtr(..), WordPtr(..))
145                             -- So we can give Data instance for IntPtr and WordPtr
146--import GHC.Stable            -- So we can give Data instance for StablePtr
147--import GHC.ST                -- So we can give Data instance for ST
148--import GHC.Conc              -- So we can give Data instance for MVar & Co.
149import GHC.Arr               -- So we can give Data instance for Array
150import qualified GHC.Generics as Generics (Fixity(..))
151import GHC.Generics hiding (Fixity(..))
152                             -- So we can give Data instance for U1, V1, ...
153
154------------------------------------------------------------------------------
155--
156--      The Data class
157--
158------------------------------------------------------------------------------
159
160{- |
161The 'Data' class comprehends a fundamental primitive 'gfoldl' for
162folding over constructor applications, say terms. This primitive can
163be instantiated in several ways to map over the immediate subterms
164of a term; see the @gmap@ combinators later in this class.  Indeed, a
165generic programmer does not necessarily need to use the ingenious gfoldl
166primitive but rather the intuitive @gmap@ combinators.  The 'gfoldl'
167primitive is completed by means to query top-level constructors, to
168turn constructor representations into proper terms, and to list all
169possible datatype constructors.  This completion allows us to serve
170generic programming scenarios like read, show, equality, term generation.
171
172The combinators 'gmapT', 'gmapQ', 'gmapM', etc are all provided with
173default definitions in terms of 'gfoldl', leaving open the opportunity
174to provide datatype-specific definitions.
175(The inclusion of the @gmap@ combinators as members of class 'Data'
176allows the programmer or the compiler to derive specialised, and maybe
177more efficient code per datatype.  /Note/: 'gfoldl' is more higher-order
178than the @gmap@ combinators.  This is subject to ongoing benchmarking
179experiments.  It might turn out that the @gmap@ combinators will be
180moved out of the class 'Data'.)
181
182Conceptually, the definition of the @gmap@ combinators in terms of the
183primitive 'gfoldl' requires the identification of the 'gfoldl' function
184arguments.  Technically, we also need to identify the type constructor
185@c@ for the construction of the result type from the folded term type.
186
187In the definition of @gmapQ@/x/ combinators, we use phantom type
188constructors for the @c@ in the type of 'gfoldl' because the result type
189of a query does not involve the (polymorphic) type of the term argument.
190In the definition of 'gmapQl' we simply use the plain constant type
191constructor because 'gfoldl' is left-associative anyway and so it is
192readily suited to fold a left-associative binary operation over the
193immediate subterms.  In the definition of gmapQr, extra effort is
194needed. We use a higher-order accumulation trick to mediate between
195left-associative constructor application vs. right-associative binary
196operation (e.g., @(:)@).  When the query is meant to compute a value
197of type @r@, then the result type withing generic folding is @r -> r@.
198So the result of folding is a function to which we finally pass the
199right unit.
200
201With the @-XDeriveDataTypeable@ option, GHC can generate instances of the
202'Data' class automatically.  For example, given the declaration
203
204> data T a b = C1 a b | C2 deriving (Typeable, Data)
205
206GHC will generate an instance that is equivalent to
207
208> instance (Data a, Data b) => Data (T a b) where
209>     gfoldl k z (C1 a b) = z C1 `k` a `k` b
210>     gfoldl k z C2       = z C2
211>
212>     gunfold k z c = case constrIndex c of
213>                         1 -> k (k (z C1))
214>                         2 -> z C2
215>
216>     toConstr (C1 _ _) = con_C1
217>     toConstr C2       = con_C2
218>
219>     dataTypeOf _ = ty_T
220>
221> con_C1 = mkConstr ty_T "C1" [] Prefix
222> con_C2 = mkConstr ty_T "C2" [] Prefix
223> ty_T   = mkDataType "Module.T" [con_C1, con_C2]
224
225This is suitable for datatypes that are exported transparently.
226
227-}
228
229class Typeable a => Data a where
230
231  -- | Left-associative fold operation for constructor applications.
232  --
233  -- The type of 'gfoldl' is a headache, but operationally it is a simple
234  -- generalisation of a list fold.
235  --
236  -- The default definition for 'gfoldl' is @'const' 'id'@, which is
237  -- suitable for abstract datatypes with no substructures.
238  gfoldl  :: (forall d b. Data d => c (d -> b) -> d -> c b)
239                -- ^ defines how nonempty constructor applications are
240                -- folded.  It takes the folded tail of the constructor
241                -- application and its head, i.e., an immediate subterm,
242                -- and combines them in some way.
243          -> (forall g. g -> c g)
244                -- ^ defines how the empty constructor application is
245                -- folded, like the neutral \/ start element for list
246                -- folding.
247          -> a
248                -- ^ structure to be folded.
249          -> c a
250                -- ^ result, with a type defined in terms of @a@, but
251                -- variability is achieved by means of type constructor
252                -- @c@ for the construction of the actual result type.
253
254  -- See the 'Data' instances in this file for an illustration of 'gfoldl'.
255
256  gfoldl _ z = z
257
258  -- | Unfolding constructor applications
259  gunfold :: (forall b r. Data b => c (b -> r) -> c r)
260          -> (forall r. r -> c r)
261          -> Constr
262          -> c a
263
264  -- | Obtaining the constructor from a given datum.
265  -- For proper terms, this is meant to be the top-level constructor.
266  -- Primitive datatypes are here viewed as potentially infinite sets of
267  -- values (i.e., constructors).
268  toConstr   :: a -> Constr
269
270
271  -- | The outer type constructor of the type
272  dataTypeOf  :: a -> DataType
273
274
275
276------------------------------------------------------------------------------
277--
278-- Mediate types and type constructors
279--
280------------------------------------------------------------------------------
281
282  -- | Mediate types and unary type constructors.
283  --
284  -- In 'Data' instances of the form
285  --
286  -- @
287  --     instance (Data a, ...) => Data (T a)
288  -- @
289  --
290  -- 'dataCast1' should be defined as 'gcast1'.
291  --
292  -- The default definition is @'const' 'Nothing'@, which is appropriate
293  -- for instances of other forms.
294  dataCast1 :: Typeable t
295            => (forall d. Data d => c (t d))
296            -> Maybe (c a)
297  dataCast1 _ = Nothing
298
299  -- | Mediate types and binary type constructors.
300  --
301  -- In 'Data' instances of the form
302  --
303  -- @
304  --     instance (Data a, Data b, ...) => Data (T a b)
305  -- @
306  --
307  -- 'dataCast2' should be defined as 'gcast2'.
308  --
309  -- The default definition is @'const' 'Nothing'@, which is appropriate
310  -- for instances of other forms.
311  dataCast2 :: Typeable t
312            => (forall d e. (Data d, Data e) => c (t d e))
313            -> Maybe (c a)
314  dataCast2 _ = Nothing
315
316
317
318------------------------------------------------------------------------------
319--
320--      Typical generic maps defined in terms of gfoldl
321--
322------------------------------------------------------------------------------
323
324
325  -- | A generic transformation that maps over the immediate subterms
326  --
327  -- The default definition instantiates the type constructor @c@ in the
328  -- type of 'gfoldl' to an identity datatype constructor, using the
329  -- isomorphism pair as injection and projection.
330  gmapT :: (forall b. Data b => b -> b) -> a -> a
331
332  -- Use the Identity datatype constructor
333  -- to instantiate the type constructor c in the type of gfoldl,
334  -- and perform injections Identity and projections runIdentity accordingly.
335  --
336  gmapT f x0 = runIdentity (gfoldl k Identity x0)
337    where
338      k :: Data d => Identity (d->b) -> d -> Identity b
339      k (Identity c) x = Identity (c (f x))
340
341
342  -- | A generic query with a left-associative binary operator
343  gmapQl :: forall r r'. (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r
344  gmapQl o r f = getConst . gfoldl k z
345    where
346      k :: Data d => Const r (d->b) -> d -> Const r b
347      k c x = Const $ (getConst c) `o` f x
348      z :: g -> Const r g
349      z _   = Const r
350
351  -- | A generic query with a right-associative binary operator
352  gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r
353  gmapQr o r0 f x0 = unQr (gfoldl k (const (Qr id)) x0) r0
354    where
355      k :: Data d => Qr r (d->b) -> d -> Qr r b
356      k (Qr c) x = Qr (\r -> c (f x `o` r))
357
358
359  -- | A generic query that processes the immediate subterms and returns a list
360  -- of results.  The list is given in the same order as originally specified
361  -- in the declaration of the data constructors.
362  gmapQ :: (forall d. Data d => d -> u) -> a -> [u]
363  gmapQ f = gmapQr (:) [] f
364
365
366  -- | A generic query that processes one child by index (zero-based)
367  gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> a -> u
368  gmapQi i f x = case gfoldl k z x of { Qi _ q -> fromJust q }
369    where
370      k :: Data d => Qi u (d -> b) -> d -> Qi u b
371      k (Qi i' q) a = Qi (i'+1) (if i==i' then Just (f a) else q)
372      z :: g -> Qi q g
373      z _           = Qi 0 Nothing
374
375
376  -- | A generic monadic transformation that maps over the immediate subterms
377  --
378  -- The default definition instantiates the type constructor @c@ in
379  -- the type of 'gfoldl' to the monad datatype constructor, defining
380  -- injection and projection using 'return' and '>>='.
381  gmapM :: forall m. Monad m => (forall d. Data d => d -> m d) -> a -> m a
382
383  -- Use immediately the monad datatype constructor
384  -- to instantiate the type constructor c in the type of gfoldl,
385  -- so injection and projection is done by return and >>=.
386  --
387  gmapM f = gfoldl k return
388    where
389      k :: Data d => m (d -> b) -> d -> m b
390      k c x = do c' <- c
391                 x' <- f x
392                 return (c' x')
393
394
395  -- | Transformation of at least one immediate subterm does not fail
396  gmapMp :: forall m. MonadPlus m => (forall d. Data d => d -> m d) -> a -> m a
397
398{-
399
400The type constructor that we use here simply keeps track of the fact
401if we already succeeded for an immediate subterm; see Mp below. To
402this end, we couple the monadic computation with a Boolean.
403
404-}
405
406  gmapMp f x = unMp (gfoldl k z x) >>= \(x',b) ->
407                if b then return x' else mzero
408    where
409      z :: g -> Mp m g
410      z g = Mp (return (g,False))
411      k :: Data d => Mp m (d -> b) -> d -> Mp m b
412      k (Mp c) y
413        = Mp ( c >>= \(h, b) ->
414                 (f y >>= \y' -> return (h y', True))
415                 `mplus` return (h y, b)
416             )
417
418  -- | Transformation of one immediate subterm with success
419  gmapMo :: forall m. MonadPlus m => (forall d. Data d => d -> m d) -> a -> m a
420
421{-
422
423We use the same pairing trick as for gmapMp,
424i.e., we use an extra Bool component to keep track of the
425fact whether an immediate subterm was processed successfully.
426However, we cut of mapping over subterms once a first subterm
427was transformed successfully.
428
429-}
430
431  gmapMo f x = unMp (gfoldl k z x) >>= \(x',b) ->
432                if b then return x' else mzero
433    where
434      z :: g -> Mp m g
435      z g = Mp (return (g,False))
436      k :: Data d => Mp m (d -> b) -> d -> Mp m b
437      k (Mp c) y
438        = Mp ( c >>= \(h,b) -> if b
439                        then return (h y, b)
440                        else (f y >>= \y' -> return (h y',True))
441                             `mplus` return (h y, b)
442             )
443
444
445-- | Type constructor for adding counters to queries
446data Qi q a = Qi Int (Maybe q)
447
448
449-- | The type constructor used in definition of gmapQr
450newtype Qr r a = Qr { unQr  :: r -> r }
451
452
453-- | The type constructor used in definition of gmapMp
454newtype Mp m x = Mp { unMp :: m (x, Bool) }
455
456
457
458------------------------------------------------------------------------------
459--
460--      Generic unfolding
461--
462------------------------------------------------------------------------------
463
464
465-- | Build a term skeleton
466fromConstr :: Data a => Constr -> a
467fromConstr = fromConstrB (errorWithoutStackTrace "Data.Data.fromConstr")
468
469
470-- | Build a term and use a generic function for subterms
471fromConstrB :: Data a
472            => (forall d. Data d => d)
473            -> Constr
474            -> a
475fromConstrB f = runIdentity . gunfold k z
476 where
477  k :: forall b r. Data b => Identity (b -> r) -> Identity r
478  k c = Identity (runIdentity c f)
479
480  z :: forall r. r -> Identity r
481  z = Identity
482
483
484-- | Monadic variation on 'fromConstrB'
485fromConstrM :: forall m a. (Monad m, Data a)
486            => (forall d. Data d => m d)
487            -> Constr
488            -> m a
489fromConstrM f = gunfold k z
490 where
491  k :: forall b r. Data b => m (b -> r) -> m r
492  k c = do { c' <- c; b <- f; return (c' b) }
493
494  z :: forall r. r -> m r
495  z = return
496
497
498
499------------------------------------------------------------------------------
500--
501--      Datatype and constructor representations
502--
503------------------------------------------------------------------------------
504
505
506--
507-- | Representation of datatypes.
508-- A package of constructor representations with names of type and module.
509--
510data DataType = DataType
511                        { tycon   :: String
512                        , datarep :: DataRep
513                        }
514
515              deriving Show -- ^ @since 4.0.0.0
516
517-- | Representation of constructors. Note that equality on constructors
518-- with different types may not work -- i.e. the constructors for 'False' and
519-- 'Nothing' may compare equal.
520data Constr = Constr
521                        { conrep    :: ConstrRep
522                        , constring :: String
523                        , confields :: [String] -- for AlgRep only
524                        , confixity :: Fixity   -- for AlgRep only
525                        , datatype  :: DataType
526                        }
527
528-- | @since 4.0.0.0
529instance Show Constr where
530 show = constring
531
532
533-- | Equality of constructors
534--
535-- @since 4.0.0.0
536instance Eq Constr where
537  c == c' = constrRep c == constrRep c'
538
539
540-- | Public representation of datatypes
541data DataRep = AlgRep [Constr]
542             | IntRep
543             | FloatRep
544             | CharRep
545             | NoRep
546
547            deriving ( Eq   -- ^ @since 4.0.0.0
548                     , Show -- ^ @since 4.0.0.0
549                     )
550-- The list of constructors could be an array, a balanced tree, or others.
551
552
553-- | Public representation of constructors
554data ConstrRep = AlgConstr    ConIndex
555               | IntConstr    Integer
556               | FloatConstr  Rational
557               | CharConstr   Char
558
559               deriving ( Eq   -- ^ @since 4.0.0.0
560                        , Show -- ^ @since 4.0.0.0
561                        )
562
563
564-- | Unique index for datatype constructors,
565-- counting from 1 in the order they are given in the program text.
566type ConIndex = Int
567
568
569-- | Fixity of constructors
570data Fixity = Prefix
571            | Infix     -- Later: add associativity and precedence
572
573            deriving ( Eq   -- ^ @since 4.0.0.0
574                     , Show -- ^ @since 4.0.0.0
575                     )
576
577
578------------------------------------------------------------------------------
579--
580--      Observers for datatype representations
581--
582------------------------------------------------------------------------------
583
584
585-- | Gets the type constructor including the module
586dataTypeName :: DataType -> String
587dataTypeName = tycon
588
589
590
591-- | Gets the public presentation of a datatype
592dataTypeRep :: DataType -> DataRep
593dataTypeRep = datarep
594
595
596-- | Gets the datatype of a constructor
597constrType :: Constr -> DataType
598constrType = datatype
599
600
601-- | Gets the public presentation of constructors
602constrRep :: Constr -> ConstrRep
603constrRep = conrep
604
605
606-- | Look up a constructor by its representation
607repConstr :: DataType -> ConstrRep -> Constr
608repConstr dt cr =
609      case (dataTypeRep dt, cr) of
610        (AlgRep cs, AlgConstr i)      -> cs !! (i-1)
611        (IntRep,    IntConstr i)      -> mkIntegralConstr dt i
612        (FloatRep,  FloatConstr f)    -> mkRealConstr dt f
613        (CharRep,   CharConstr c)     -> mkCharConstr dt c
614        _ -> errorWithoutStackTrace "Data.Data.repConstr: The given ConstrRep does not fit to the given DataType."
615
616
617
618------------------------------------------------------------------------------
619--
620--      Representations of algebraic data types
621--
622------------------------------------------------------------------------------
623
624
625-- | Constructs an algebraic datatype
626mkDataType :: String -> [Constr] -> DataType
627mkDataType str cs = DataType
628                        { tycon   = str
629                        , datarep = AlgRep cs
630                        }
631
632
633-- | Constructs a constructor
634mkConstr :: DataType -> String -> [String] -> Fixity -> Constr
635mkConstr dt str fields fix =
636        Constr
637                { conrep    = AlgConstr idx
638                , constring = str
639                , confields = fields
640                , confixity = fix
641                , datatype  = dt
642                }
643  where
644    idx = head [ i | (c,i) <- dataTypeConstrs dt `zip` [1..],
645                     showConstr c == str ]
646
647
648-- | Gets the constructors of an algebraic datatype
649dataTypeConstrs :: DataType -> [Constr]
650dataTypeConstrs dt = case datarep dt of
651                        (AlgRep cons) -> cons
652                        _ -> errorWithoutStackTrace $ "Data.Data.dataTypeConstrs is not supported for "
653                                    ++ dataTypeName dt ++
654                                    ", as it is not an algebraic data type."
655
656
657-- | Gets the field labels of a constructor.  The list of labels
658-- is returned in the same order as they were given in the original
659-- constructor declaration.
660constrFields :: Constr -> [String]
661constrFields = confields
662
663
664-- | Gets the fixity of a constructor
665constrFixity :: Constr -> Fixity
666constrFixity = confixity
667
668
669
670------------------------------------------------------------------------------
671--
672--      From strings to constr's and vice versa: all data types
673--
674------------------------------------------------------------------------------
675
676
677-- | Gets the string for a constructor
678showConstr :: Constr -> String
679showConstr = constring
680
681
682-- | Lookup a constructor via a string
683readConstr :: DataType -> String -> Maybe Constr
684readConstr dt str =
685      case dataTypeRep dt of
686        AlgRep cons -> idx cons
687        IntRep      -> mkReadCon (\i -> (mkPrimCon dt str (IntConstr i)))
688        FloatRep    -> mkReadCon ffloat
689        CharRep     -> mkReadCon (\c -> (mkPrimCon dt str (CharConstr c)))
690        NoRep       -> Nothing
691  where
692
693    -- Read a value and build a constructor
694    mkReadCon :: Read t => (t -> Constr) -> Maybe Constr
695    mkReadCon f = case (reads str) of
696                    [(t,"")] -> Just (f t)
697                    _ -> Nothing
698
699    -- Traverse list of algebraic datatype constructors
700    idx :: [Constr] -> Maybe Constr
701    idx cons = let fit = filter ((==) str . showConstr) cons
702                in if fit == []
703                     then Nothing
704                     else Just (head fit)
705
706    ffloat :: Double -> Constr
707    ffloat =  mkPrimCon dt str . FloatConstr . toRational
708
709------------------------------------------------------------------------------
710--
711--      Convenience functions: algebraic data types
712--
713------------------------------------------------------------------------------
714
715
716-- | Test for an algebraic type
717isAlgType :: DataType -> Bool
718isAlgType dt = case datarep dt of
719                 (AlgRep _) -> True
720                 _ -> False
721
722
723-- | Gets the constructor for an index (algebraic datatypes only)
724indexConstr :: DataType -> ConIndex -> Constr
725indexConstr dt idx = case datarep dt of
726                        (AlgRep cs) -> cs !! (idx-1)
727                        _           -> errorWithoutStackTrace $ "Data.Data.indexConstr is not supported for "
728                                               ++ dataTypeName dt ++
729                                               ", as it is not an algebraic data type."
730
731
732-- | Gets the index of a constructor (algebraic datatypes only)
733constrIndex :: Constr -> ConIndex
734constrIndex con = case constrRep con of
735                    (AlgConstr idx) -> idx
736                    _ -> errorWithoutStackTrace $ "Data.Data.constrIndex is not supported for "
737                                 ++ dataTypeName (constrType con) ++
738                                 ", as it is not an algebraic data type."
739
740
741-- | Gets the maximum constructor index of an algebraic datatype
742maxConstrIndex :: DataType -> ConIndex
743maxConstrIndex dt = case dataTypeRep dt of
744                        AlgRep cs -> length cs
745                        _            -> errorWithoutStackTrace $ "Data.Data.maxConstrIndex is not supported for "
746                                                 ++ dataTypeName dt ++
747                                                 ", as it is not an algebraic data type."
748
749
750
751------------------------------------------------------------------------------
752--
753--      Representation of primitive types
754--
755------------------------------------------------------------------------------
756
757
758-- | Constructs the 'Int' type
759mkIntType :: String -> DataType
760mkIntType = mkPrimType IntRep
761
762
763-- | Constructs the 'Float' type
764mkFloatType :: String -> DataType
765mkFloatType = mkPrimType FloatRep
766
767
768-- | Constructs the 'Char' type
769mkCharType :: String -> DataType
770mkCharType = mkPrimType CharRep
771
772
773-- | Helper for 'mkIntType', 'mkFloatType'
774mkPrimType :: DataRep -> String -> DataType
775mkPrimType dr str = DataType
776                        { tycon   = str
777                        , datarep = dr
778                        }
779
780
781-- Makes a constructor for primitive types
782mkPrimCon :: DataType -> String -> ConstrRep -> Constr
783mkPrimCon dt str cr = Constr
784                        { datatype  = dt
785                        , conrep    = cr
786                        , constring = str
787                        , confields = errorWithoutStackTrace "Data.Data.confields"
788                        , confixity = errorWithoutStackTrace "Data.Data.confixity"
789                        }
790
791mkIntegralConstr :: (Integral a, Show a) => DataType -> a -> Constr
792mkIntegralConstr dt i = case datarep dt of
793                  IntRep -> mkPrimCon dt (show i) (IntConstr (toInteger  i))
794                  _ -> errorWithoutStackTrace $ "Data.Data.mkIntegralConstr is not supported for "
795                               ++ dataTypeName dt ++
796                               ", as it is not an Integral data type."
797
798mkRealConstr :: (Real a, Show a) => DataType -> a -> Constr
799mkRealConstr dt f = case datarep dt of
800                    FloatRep -> mkPrimCon dt (show f) (FloatConstr (toRational f))
801                    _ -> errorWithoutStackTrace $ "Data.Data.mkRealConstr is not supported for "
802                                 ++ dataTypeName dt ++
803                                 ", as it is not a Real data type."
804
805-- | Makes a constructor for 'Char'.
806mkCharConstr :: DataType -> Char -> Constr
807mkCharConstr dt c = case datarep dt of
808                   CharRep -> mkPrimCon dt (show c) (CharConstr c)
809                   _ -> errorWithoutStackTrace $ "Data.Data.mkCharConstr is not supported for "
810                                ++ dataTypeName dt ++
811                                ", as it is not an Char data type."
812
813
814------------------------------------------------------------------------------
815--
816--      Non-representations for non-representable types
817--
818------------------------------------------------------------------------------
819
820
821-- | Constructs a non-representation for a non-representable type
822mkNoRepType :: String -> DataType
823mkNoRepType str = DataType
824                        { tycon   = str
825                        , datarep = NoRep
826                        }
827
828-- | Test for a non-representable type
829isNorepType :: DataType -> Bool
830isNorepType dt = case datarep dt of
831                   NoRep -> True
832                   _ -> False
833
834
835
836------------------------------------------------------------------------------
837--
838--      Convenience for qualified type constructors
839--
840------------------------------------------------------------------------------
841
842
843-- | Gets the unqualified type constructor:
844-- drop *.*.*... before name
845--
846tyconUQname :: String -> String
847tyconUQname x = let x' = dropWhile (not . (==) '.') x
848                 in if x' == [] then x else tyconUQname (tail x')
849
850
851-- | Gets the module of a type constructor:
852-- take *.*.*... before name
853tyconModule :: String -> String
854tyconModule x = let (a,b) = break ((==) '.') x
855                 in if b == ""
856                      then b
857                      else a ++ tyconModule' (tail b)
858  where
859    tyconModule' y = let y' = tyconModule y
860                      in if y' == "" then "" else ('.':y')
861
862
863
864
865------------------------------------------------------------------------------
866------------------------------------------------------------------------------
867--
868--      Instances of the Data class for Prelude-like types.
869--      We define top-level definitions for representations.
870--
871------------------------------------------------------------------------------
872
873-- | @since 4.0.0.0
874deriving instance Data Bool
875
876------------------------------------------------------------------------------
877
878charType :: DataType
879charType = mkCharType "Prelude.Char"
880
881-- | @since 4.0.0.0
882instance Data Char where
883  toConstr x = mkCharConstr charType x
884  gunfold _ z c = case constrRep c of
885                    (CharConstr x) -> z x
886                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c
887                                 ++ " is not of type Char."
888  dataTypeOf _ = charType
889
890
891------------------------------------------------------------------------------
892
893floatType :: DataType
894floatType = mkFloatType "Prelude.Float"
895
896-- | @since 4.0.0.0
897instance Data Float where
898  toConstr = mkRealConstr floatType
899  gunfold _ z c = case constrRep c of
900                    (FloatConstr x) -> z (realToFrac x)
901                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c
902                                 ++ " is not of type Float."
903  dataTypeOf _ = floatType
904
905
906------------------------------------------------------------------------------
907
908doubleType :: DataType
909doubleType = mkFloatType "Prelude.Double"
910
911-- | @since 4.0.0.0
912instance Data Double where
913  toConstr = mkRealConstr doubleType
914  gunfold _ z c = case constrRep c of
915                    (FloatConstr x) -> z (realToFrac x)
916                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c
917                                 ++ " is not of type Double."
918  dataTypeOf _ = doubleType
919
920
921------------------------------------------------------------------------------
922
923intType :: DataType
924intType = mkIntType "Prelude.Int"
925
926-- | @since 4.0.0.0
927instance Data Int where
928  toConstr x = mkIntegralConstr intType x
929  gunfold _ z c = case constrRep c of
930                    (IntConstr x) -> z (fromIntegral x)
931                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c
932                                 ++ " is not of type Int."
933  dataTypeOf _ = intType
934
935
936------------------------------------------------------------------------------
937
938integerType :: DataType
939integerType = mkIntType "Prelude.Integer"
940
941-- | @since 4.0.0.0
942instance Data Integer where
943  toConstr = mkIntegralConstr integerType
944  gunfold _ z c = case constrRep c of
945                    (IntConstr x) -> z x
946                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c
947                                 ++ " is not of type Integer."
948  dataTypeOf _ = integerType
949
950
951------------------------------------------------------------------------------
952
953-- This follows the same style as the other integral 'Data' instances
954-- defined in "Data.Data"
955naturalType :: DataType
956naturalType = mkIntType "Numeric.Natural.Natural"
957
958-- | @since 4.8.0.0
959instance Data Natural where
960  toConstr x = mkIntegralConstr naturalType x
961  gunfold _ z c = case constrRep c of
962                    (IntConstr x) -> z (fromIntegral x)
963                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c
964                                 ++ " is not of type Natural"
965  dataTypeOf _ = naturalType
966
967
968------------------------------------------------------------------------------
969
970int8Type :: DataType
971int8Type = mkIntType "Data.Int.Int8"
972
973-- | @since 4.0.0.0
974instance Data Int8 where
975  toConstr x = mkIntegralConstr int8Type x
976  gunfold _ z c = case constrRep c of
977                    (IntConstr x) -> z (fromIntegral x)
978                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c
979                                 ++ " is not of type Int8."
980  dataTypeOf _ = int8Type
981
982
983------------------------------------------------------------------------------
984
985int16Type :: DataType
986int16Type = mkIntType "Data.Int.Int16"
987
988-- | @since 4.0.0.0
989instance Data Int16 where
990  toConstr x = mkIntegralConstr int16Type x
991  gunfold _ z c = case constrRep c of
992                    (IntConstr x) -> z (fromIntegral x)
993                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c
994                                 ++ " is not of type Int16."
995  dataTypeOf _ = int16Type
996
997
998------------------------------------------------------------------------------
999
1000int32Type :: DataType
1001int32Type = mkIntType "Data.Int.Int32"
1002
1003-- | @since 4.0.0.0
1004instance Data Int32 where
1005  toConstr x = mkIntegralConstr int32Type x
1006  gunfold _ z c = case constrRep c of
1007                    (IntConstr x) -> z (fromIntegral x)
1008                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c
1009                                 ++ " is not of type Int32."
1010  dataTypeOf _ = int32Type
1011
1012
1013------------------------------------------------------------------------------
1014
1015int64Type :: DataType
1016int64Type = mkIntType "Data.Int.Int64"
1017
1018-- | @since 4.0.0.0
1019instance Data Int64 where
1020  toConstr x = mkIntegralConstr int64Type x
1021  gunfold _ z c = case constrRep c of
1022                    (IntConstr x) -> z (fromIntegral x)
1023                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c
1024                                 ++ " is not of type Int64."
1025  dataTypeOf _ = int64Type
1026
1027
1028------------------------------------------------------------------------------
1029
1030wordType :: DataType
1031wordType = mkIntType "Data.Word.Word"
1032
1033-- | @since 4.0.0.0
1034instance Data Word where
1035  toConstr x = mkIntegralConstr wordType x
1036  gunfold _ z c = case constrRep c of
1037                    (IntConstr x) -> z (fromIntegral x)
1038                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c
1039                                 ++ " is not of type Word"
1040  dataTypeOf _ = wordType
1041
1042
1043------------------------------------------------------------------------------
1044
1045word8Type :: DataType
1046word8Type = mkIntType "Data.Word.Word8"
1047
1048-- | @since 4.0.0.0
1049instance Data Word8 where
1050  toConstr x = mkIntegralConstr word8Type x
1051  gunfold _ z c = case constrRep c of
1052                    (IntConstr x) -> z (fromIntegral x)
1053                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c
1054                                 ++ " is not of type Word8."
1055  dataTypeOf _ = word8Type
1056
1057
1058------------------------------------------------------------------------------
1059
1060word16Type :: DataType
1061word16Type = mkIntType "Data.Word.Word16"
1062
1063-- | @since 4.0.0.0
1064instance Data Word16 where
1065  toConstr x = mkIntegralConstr word16Type x
1066  gunfold _ z c = case constrRep c of
1067                    (IntConstr x) -> z (fromIntegral x)
1068                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c
1069                                 ++ " is not of type Word16."
1070  dataTypeOf _ = word16Type
1071
1072
1073------------------------------------------------------------------------------
1074
1075word32Type :: DataType
1076word32Type = mkIntType "Data.Word.Word32"
1077
1078-- | @since 4.0.0.0
1079instance Data Word32 where
1080  toConstr x = mkIntegralConstr word32Type x
1081  gunfold _ z c = case constrRep c of
1082                    (IntConstr x) -> z (fromIntegral x)
1083                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c
1084                                 ++ " is not of type Word32."
1085  dataTypeOf _ = word32Type
1086
1087
1088------------------------------------------------------------------------------
1089
1090word64Type :: DataType
1091word64Type = mkIntType "Data.Word.Word64"
1092
1093-- | @since 4.0.0.0
1094instance Data Word64 where
1095  toConstr x = mkIntegralConstr word64Type x
1096  gunfold _ z c = case constrRep c of
1097                    (IntConstr x) -> z (fromIntegral x)
1098                    _ -> errorWithoutStackTrace $ "Data.Data.gunfold: Constructor " ++ show c
1099                                 ++ " is not of type Word64."
1100  dataTypeOf _ = word64Type
1101
1102
1103------------------------------------------------------------------------------
1104
1105ratioConstr :: Constr
1106ratioConstr = mkConstr ratioDataType ":%" [] Infix
1107
1108ratioDataType :: DataType
1109ratioDataType = mkDataType "GHC.Real.Ratio" [ratioConstr]
1110
1111-- NB: This Data instance intentionally uses the (%) smart constructor instead
1112-- of the internal (:%) constructor to preserve the invariant that a Ratio
1113-- value is reduced to normal form. See #10011.
1114
1115-- | @since 4.0.0.0
1116instance (Data a, Integral a) => Data (Ratio a) where
1117  gfoldl k z (a :% b) = z (%) `k` a `k` b
1118  toConstr _ = ratioConstr
1119  gunfold k z c | constrIndex c == 1 = k (k (z (%)))
1120  gunfold _ _ _ = errorWithoutStackTrace "Data.Data.gunfold(Ratio)"
1121  dataTypeOf _  = ratioDataType
1122
1123
1124------------------------------------------------------------------------------
1125
1126nilConstr :: Constr
1127nilConstr    = mkConstr listDataType "[]" [] Prefix
1128consConstr :: Constr
1129consConstr   = mkConstr listDataType "(:)" [] Infix
1130
1131listDataType :: DataType
1132listDataType = mkDataType "Prelude.[]" [nilConstr,consConstr]
1133
1134-- | @since 4.0.0.0
1135instance Data a => Data [a] where
1136  gfoldl _ z []     = z []
1137  gfoldl f z (x:xs) = z (:) `f` x `f` xs
1138  toConstr []    = nilConstr
1139  toConstr (_:_) = consConstr
1140  gunfold k z c = case constrIndex c of
1141                    1 -> z []
1142                    2 -> k (k (z (:)))
1143                    _ -> errorWithoutStackTrace "Data.Data.gunfold(List)"
1144  dataTypeOf _ = listDataType
1145  dataCast1 f  = gcast1 f
1146
1147--
1148-- The gmaps are given as an illustration.
1149-- This shows that the gmaps for lists are different from list maps.
1150--
1151  gmapT  _   []     = []
1152  gmapT  f   (x:xs) = (f x:f xs)
1153  gmapQ  _   []     = []
1154  gmapQ  f   (x:xs) = [f x,f xs]
1155  gmapM  _   []     = return []
1156  gmapM  f   (x:xs) = f x >>= \x' -> f xs >>= \xs' -> return (x':xs')
1157
1158
1159------------------------------------------------------------------------------
1160
1161-- | @since 4.14.0.0
1162deriving instance (Typeable (a :: Type -> Type -> Type), Typeable b, Typeable c,
1163                   Data (a b c))
1164         => Data (WrappedArrow a b c)
1165
1166-- | @since 4.14.0.0
1167deriving instance (Typeable (m :: Type -> Type), Typeable a, Data (m a))
1168         => Data (WrappedMonad m a)
1169
1170-- | @since 4.14.0.0
1171deriving instance Data a => Data (ZipList a)
1172
1173-- | @since 4.9.0.0
1174deriving instance Data a => Data (NonEmpty a)
1175
1176-- | @since 4.0.0.0
1177deriving instance Data a => Data (Maybe a)
1178
1179-- | @since 4.0.0.0
1180deriving instance Data Ordering
1181
1182-- | @since 4.0.0.0
1183deriving instance (Data a, Data b) => Data (Either a b)
1184
1185-- | @since 4.0.0.0
1186deriving instance Data ()
1187
1188-- | @since 4.0.0.0
1189deriving instance (Data a, Data b) => Data (a,b)
1190
1191-- | @since 4.0.0.0
1192deriving instance (Data a, Data b, Data c) => Data (a,b,c)
1193
1194-- | @since 4.0.0.0
1195deriving instance (Data a, Data b, Data c, Data d)
1196         => Data (a,b,c,d)
1197
1198-- | @since 4.0.0.0
1199deriving instance (Data a, Data b, Data c, Data d, Data e)
1200         => Data (a,b,c,d,e)
1201
1202-- | @since 4.0.0.0
1203deriving instance (Data a, Data b, Data c, Data d, Data e, Data f)
1204         => Data (a,b,c,d,e,f)
1205
1206-- | @since 4.0.0.0
1207deriving instance (Data a, Data b, Data c, Data d, Data e, Data f, Data g)
1208         => Data (a,b,c,d,e,f,g)
1209
1210------------------------------------------------------------------------------
1211
1212-- | @since 4.8.0.0
1213instance Data a => Data (Ptr a) where
1214  toConstr _   = errorWithoutStackTrace "Data.Data.toConstr(Ptr)"
1215  gunfold _ _  = errorWithoutStackTrace "Data.Data.gunfold(Ptr)"
1216  dataTypeOf _ = mkNoRepType "GHC.Ptr.Ptr"
1217  dataCast1 x  = gcast1 x
1218
1219------------------------------------------------------------------------------
1220
1221-- | @since 4.8.0.0
1222instance Data a => Data (ForeignPtr a) where
1223  toConstr _   = errorWithoutStackTrace "Data.Data.toConstr(ForeignPtr)"
1224  gunfold _ _  = errorWithoutStackTrace "Data.Data.gunfold(ForeignPtr)"
1225  dataTypeOf _ = mkNoRepType "GHC.ForeignPtr.ForeignPtr"
1226  dataCast1 x  = gcast1 x
1227
1228-- | @since 4.11.0.0
1229deriving instance Data IntPtr
1230
1231-- | @since 4.11.0.0
1232deriving instance Data WordPtr
1233
1234------------------------------------------------------------------------------
1235-- The Data instance for Array preserves data abstraction at the cost of
1236-- inefficiency. We omit reflection services for the sake of data abstraction.
1237-- | @since 4.8.0.0
1238instance (Data a, Data b, Ix a) => Data (Array a b)
1239 where
1240  gfoldl f z a = z (listArray (bounds a)) `f` (elems a)
1241  toConstr _   = errorWithoutStackTrace "Data.Data.toConstr(Array)"
1242  gunfold _ _  = errorWithoutStackTrace "Data.Data.gunfold(Array)"
1243  dataTypeOf _ = mkNoRepType "Data.Array.Array"
1244  dataCast2 x  = gcast2 x
1245
1246----------------------------------------------------------------------------
1247-- Data instance for Proxy
1248
1249-- | @since 4.7.0.0
1250deriving instance (Data t) => Data (Proxy t)
1251
1252-- | @since 4.7.0.0
1253deriving instance (a ~ b, Data a) => Data (a :~: b)
1254
1255-- | @since 4.10.0.0
1256deriving instance (Typeable i, Typeable j, Typeable a, Typeable b,
1257                    (a :: i) ~~ (b :: j))
1258    => Data (a :~~: b)
1259
1260-- | @since 4.7.0.0
1261deriving instance (Coercible a b, Data a, Data b) => Data (Coercion a b)
1262
1263-- | @since 4.9.0.0
1264deriving instance Data a => Data (Identity a)
1265
1266-- | @since 4.10.0.0
1267deriving instance (Typeable k, Data a, Typeable (b :: k)) => Data (Const a b)
1268
1269-- | @since 4.7.0.0
1270deriving instance Data Version
1271
1272----------------------------------------------------------------------------
1273-- Data instances for Data.Monoid wrappers
1274
1275-- | @since 4.8.0.0
1276deriving instance Data a => Data (Dual a)
1277
1278-- | @since 4.8.0.0
1279deriving instance Data All
1280
1281-- | @since 4.8.0.0
1282deriving instance Data Any
1283
1284-- | @since 4.8.0.0
1285deriving instance Data a => Data (Sum a)
1286
1287-- | @since 4.8.0.0
1288deriving instance Data a => Data (Product a)
1289
1290-- | @since 4.8.0.0
1291deriving instance Data a => Data (First a)
1292
1293-- | @since 4.8.0.0
1294deriving instance Data a => Data (Last a)
1295
1296-- | @since 4.8.0.0
1297deriving instance (Data (f a), Data a, Typeable f) => Data (Alt f a)
1298
1299-- | @since 4.12.0.0
1300deriving instance (Data (f a), Data a, Typeable f) => Data (Ap f a)
1301
1302----------------------------------------------------------------------------
1303-- Data instances for GHC.Generics representations
1304
1305-- | @since 4.9.0.0
1306deriving instance Data p => Data (U1 p)
1307
1308-- | @since 4.9.0.0
1309deriving instance Data p => Data (Par1 p)
1310
1311-- | @since 4.9.0.0
1312deriving instance (Data (f p), Typeable f, Data p) => Data (Rec1 f p)
1313
1314-- | @since 4.9.0.0
1315deriving instance (Typeable i, Data p, Data c) => Data (K1 i c p)
1316
1317-- | @since 4.9.0.0
1318deriving instance (Data p, Data (f p), Typeable c, Typeable i, Typeable f)
1319    => Data (M1 i c f p)
1320
1321-- | @since 4.9.0.0
1322deriving instance (Typeable f, Typeable g, Data p, Data (f p), Data (g p))
1323    => Data ((f :+: g) p)
1324
1325-- | @since 4.9.0.0
1326deriving instance (Typeable (f :: Type -> Type), Typeable (g :: Type -> Type),
1327          Data p, Data (f (g p)))
1328    => Data ((f :.: g) p)
1329
1330-- | @since 4.9.0.0
1331deriving instance Data p => Data (V1 p)
1332
1333-- | @since 4.9.0.0
1334deriving instance (Typeable f, Typeable g, Data p, Data (f p), Data (g p))
1335    => Data ((f :*: g) p)
1336
1337-- | @since 4.9.0.0
1338deriving instance Data Generics.Fixity
1339
1340-- | @since 4.9.0.0
1341deriving instance Data Associativity
1342
1343-- | @since 4.9.0.0
1344deriving instance Data SourceUnpackedness
1345
1346-- | @since 4.9.0.0
1347deriving instance Data SourceStrictness
1348
1349-- | @since 4.9.0.0
1350deriving instance Data DecidedStrictness
1351
1352----------------------------------------------------------------------------
1353-- Data instances for Data.Ord
1354
1355-- | @since 4.12.0.0
1356deriving instance Data a => Data (Down a)
1357