{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeOperators #-}
module Data.Data (
module Data.Typeable,
Data(
gfoldl,
gunfold,
toConstr,
dataTypeOf,
dataCast1,
dataCast2,
gmapT,
gmapQ,
gmapQl,
gmapQr,
gmapQi,
gmapM,
gmapMp,
gmapMo
),
DataType,
mkDataType,
mkIntType,
mkFloatType,
mkCharType,
mkNoRepType,
dataTypeName,
DataRep(..),
dataTypeRep,
repConstr,
isAlgType,
dataTypeConstrs,
indexConstr,
maxConstrIndex,
isNorepType,
Constr,
ConIndex,
Fixity(..),
mkConstr,
mkIntegralConstr,
mkRealConstr,
mkCharConstr,
constrType,
ConstrRep(..),
constrRep,
constrFields,
constrFixity,
constrIndex,
showConstr,
readConstr,
tyconUQname,
tyconModule,
fromConstr,
fromConstrB,
fromConstrM
) where
import Data.Functor.Const
import Data.Either
import Data.Eq
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Typeable
import Data.Version( Version(..) )
import GHC.Base hiding (Any, IntRep, FloatRep)
import GHC.List
import GHC.Num
import GHC.Read
import GHC.Show
import Text.Read( reads )
import Data.Functor.Identity
import Data.Int
import Data.Type.Coercion
import Data.Word
import GHC.Real
import GHC.Ptr
import GHC.ForeignPtr
import Foreign.Ptr (IntPtr(..), WordPtr(..))
import GHC.Arr
import qualified GHC.Generics as Generics (Fixity(..))
import GHC.Generics hiding (Fixity(..))
class Typeable a => Data a where
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> a
-> c a
gfoldl _ z :: forall g. g -> c g
z = a -> c a
forall g. g -> c g
z
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c a
toConstr :: a -> Constr
dataTypeOf :: a -> DataType
dataCast1 :: Typeable t
=> (forall d. Data d => c (t d))
-> Maybe (c a)
dataCast1 _ = Maybe (c a)
forall a. Maybe a
Nothing
dataCast2 :: Typeable t
=> (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c a)
dataCast2 _ = Maybe (c a)
forall a. Maybe a
Nothing
gmapT :: (forall b. Data b => b -> b) -> a -> a
gmapT f :: forall b. Data b => b -> b
f x0 :: a
x0 = Identity a -> a
forall a. Identity a -> a
runIdentity ((forall d b. Data d => Identity (d -> b) -> d -> Identity b)
-> (forall g. g -> Identity g) -> a -> Identity a
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a
gfoldl forall d b. Data d => Identity (d -> b) -> d -> Identity b
k forall g. g -> Identity g
Identity a
x0)
where
k :: Data d => Identity (d->b) -> d -> Identity b
k :: Identity (d -> b) -> d -> Identity b
k (Identity c :: d -> b
c) x :: d
x = b -> Identity b
forall g. g -> Identity g
Identity (d -> b
c (d -> d
forall b. Data b => b -> b
f d
x))
gmapQl :: forall r r'. (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r
gmapQl o :: r -> r' -> r
o r :: r
r f :: forall d. Data d => d -> r'
f = Const r a -> r
forall a k (b :: k). Const a b -> a
getConst (Const r a -> r) -> (a -> Const r a) -> a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall d b. Data d => Const r (d -> b) -> d -> Const r b)
-> (forall g. g -> Const r g) -> a -> Const r a
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a
gfoldl forall d b. Data d => Const r (d -> b) -> d -> Const r b
k forall g. g -> Const r g
z
where
k :: Data d => Const r (d->b) -> d -> Const r b
k :: Const r (d -> b) -> d -> Const r b
k c :: Const r (d -> b)
c x :: d
x = r -> Const r b
forall k a (b :: k). a -> Const a b
Const (r -> Const r b) -> r -> Const r b
forall a b. (a -> b) -> a -> b
$ (Const r (d -> b) -> r
forall a k (b :: k). Const a b -> a
getConst Const r (d -> b)
c) r -> r' -> r
`o` d -> r'
forall d. Data d => d -> r'
f d
x
z :: g -> Const r g
z :: g -> Const r g
z _ = r -> Const r g
forall k a (b :: k). a -> Const a b
Const r
r
gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r
gmapQr o :: r' -> r -> r
o r0 :: r
r0 f :: forall d. Data d => d -> r'
f x0 :: a
x0 = Qr r a -> r -> r
forall r k (a :: k). Qr r a -> r -> r
unQr ((forall d b. Data d => Qr r (d -> b) -> d -> Qr r b)
-> (forall g. g -> Qr r g) -> a -> Qr r a
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a
gfoldl forall d b. Data d => Qr r (d -> b) -> d -> Qr r b
k (Qr r g -> g -> Qr r g
forall a b. a -> b -> a
const ((r -> r) -> Qr r g
forall k r (a :: k). (r -> r) -> Qr r a
Qr r -> r
forall a. a -> a
id)) a
x0) r
r0
where
k :: Data d => Qr r (d->b) -> d -> Qr r b
k :: Qr r (d -> b) -> d -> Qr r b
k (Qr c :: r -> r
c) x :: d
x = (r -> r) -> Qr r b
forall k r (a :: k). (r -> r) -> Qr r a
Qr (\r :: r
r -> r -> r
c (d -> r'
forall d. Data d => d -> r'
f d
x r' -> r -> r
`o` r
r))
gmapQ :: (forall d. Data d => d -> u) -> a -> [u]
gmapQ f :: forall d. Data d => d -> u
f = (u -> [u] -> [u])
-> [u] -> (forall d. Data d => d -> u) -> a -> [u]
forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r
gmapQr (:) [] forall d. Data d => d -> u
f
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> a -> u
gmapQi i :: Int
i f :: forall d. Data d => d -> u
f x :: a
x = case (forall d b. Data d => Qi u (d -> b) -> d -> Qi u b)
-> (forall g. g -> Qi u g) -> a -> Qi u a
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a
gfoldl forall d b. Data d => Qi u (d -> b) -> d -> Qi u b
k forall g. g -> Qi u g
forall g q. g -> Qi q g
z a
x of { Qi _ q :: Maybe u
q -> Maybe u -> u
forall a. HasCallStack => Maybe a -> a
fromJust Maybe u
q }
where
k :: Data d => Qi u (d -> b) -> d -> Qi u b
k :: Qi u (d -> b) -> d -> Qi u b
k (Qi i' :: Int
i' q :: Maybe u
q) a :: d
a = Int -> Maybe u -> Qi u b
forall k q (a :: k). Int -> Maybe q -> Qi q a
Qi (Int
i'Int -> Int -> Int
forall a. Num a => a -> a -> a
+1) (if Int
iInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
i' then u -> Maybe u
forall a. a -> Maybe a
Just (d -> u
forall d. Data d => d -> u
f d
a) else Maybe u
q)
z :: g -> Qi q g
z :: g -> Qi q g
z _ = Int -> Maybe q -> Qi q g
forall k q (a :: k). Int -> Maybe q -> Qi q a
Qi 0 Maybe q
forall a. Maybe a
Nothing
gmapM :: forall m. Monad m => (forall d. Data d => d -> m d) -> a -> m a
gmapM f :: forall d. Data d => d -> m d
f = (forall d b. Data d => m (d -> b) -> d -> m b)
-> (forall g. g -> m g) -> a -> m a
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a
gfoldl forall d b. Data d => m (d -> b) -> d -> m b
k forall g. g -> m g
forall (m :: * -> *) a. Monad m => a -> m a
return
where
k :: Data d => m (d -> b) -> d -> m b
k :: m (d -> b) -> d -> m b
k c :: m (d -> b)
c x :: d
x = do d -> b
c' <- m (d -> b)
c
d
x' <- d -> m d
forall d. Data d => d -> m d
f d
x
b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (d -> b
c' d
x')
gmapMp :: forall m. MonadPlus m => (forall d. Data d => d -> m d) -> a -> m a
gmapMp f :: forall d. Data d => d -> m d
f x :: a
x = Mp m a -> m (a, Bool)
forall (m :: * -> *) x. Mp m x -> m (x, Bool)
unMp ((forall d b. Data d => Mp m (d -> b) -> d -> Mp m b)
-> (forall g. g -> Mp m g) -> a -> Mp m a
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a
gfoldl forall d b. Data d => Mp m (d -> b) -> d -> Mp m b
k forall g. g -> Mp m g
z a
x) m (a, Bool) -> ((a, Bool) -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(x' :: a
x',b :: Bool
b) ->
if Bool
b then a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x' else m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
where
z :: g -> Mp m g
z :: g -> Mp m g
z g :: g
g = m (g, Bool) -> Mp m g
forall (m :: * -> *) x. m (x, Bool) -> Mp m x
Mp ((g, Bool) -> m (g, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (g
g,Bool
False))
k :: Data d => Mp m (d -> b) -> d -> Mp m b
k :: Mp m (d -> b) -> d -> Mp m b
k (Mp c :: m (d -> b, Bool)
c) y :: d
y
= m (b, Bool) -> Mp m b
forall (m :: * -> *) x. m (x, Bool) -> Mp m x
Mp ( m (d -> b, Bool)
c m (d -> b, Bool) -> ((d -> b, Bool) -> m (b, Bool)) -> m (b, Bool)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(h :: d -> b
h, b :: Bool
b) ->
(d -> m d
forall d. Data d => d -> m d
f d
y m d -> (d -> m (b, Bool)) -> m (b, Bool)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \y' :: d
y' -> (b, Bool) -> m (b, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (d -> b
h d
y', Bool
True))
m (b, Bool) -> m (b, Bool) -> m (b, Bool)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (b, Bool) -> m (b, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (d -> b
h d
y, Bool
b)
)
gmapMo :: forall m. MonadPlus m => (forall d. Data d => d -> m d) -> a -> m a
gmapMo f :: forall d. Data d => d -> m d
f x :: a
x = Mp m a -> m (a, Bool)
forall (m :: * -> *) x. Mp m x -> m (x, Bool)
unMp ((forall d b. Data d => Mp m (d -> b) -> d -> Mp m b)
-> (forall g. g -> Mp m g) -> a -> Mp m a
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a
gfoldl forall d b. Data d => Mp m (d -> b) -> d -> Mp m b
k forall g. g -> Mp m g
z a
x) m (a, Bool) -> ((a, Bool) -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(x' :: a
x',b :: Bool
b) ->
if Bool
b then a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x' else m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
where
z :: g -> Mp m g
z :: g -> Mp m g
z g :: g
g = m (g, Bool) -> Mp m g
forall (m :: * -> *) x. m (x, Bool) -> Mp m x
Mp ((g, Bool) -> m (g, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (g
g,Bool
False))
k :: Data d => Mp m (d -> b) -> d -> Mp m b
k :: Mp m (d -> b) -> d -> Mp m b
k (Mp c :: m (d -> b, Bool)
c) y :: d
y
= m (b, Bool) -> Mp m b
forall (m :: * -> *) x. m (x, Bool) -> Mp m x
Mp ( m (d -> b, Bool)
c m (d -> b, Bool) -> ((d -> b, Bool) -> m (b, Bool)) -> m (b, Bool)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(h :: d -> b
h,b :: Bool
b) -> if Bool
b
then (b, Bool) -> m (b, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (d -> b
h d
y, Bool
b)
else (d -> m d
forall d. Data d => d -> m d
f d
y m d -> (d -> m (b, Bool)) -> m (b, Bool)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \y' :: d
y' -> (b, Bool) -> m (b, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (d -> b
h d
y',Bool
True))
m (b, Bool) -> m (b, Bool) -> m (b, Bool)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (b, Bool) -> m (b, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (d -> b
h d
y, Bool
b)
)
data Qi q a = Qi Int (Maybe q)
newtype Qr r a = Qr { Qr r a -> r -> r
unQr :: r -> r }
newtype Mp m x = Mp { Mp m x -> m (x, Bool)
unMp :: m (x, Bool) }
fromConstr :: Data a => Constr -> a
fromConstr :: Constr -> a
fromConstr = (forall d. Data d => d) -> Constr -> a
forall a. Data a => (forall d. Data d => d) -> Constr -> a
fromConstrB ([Char] -> d
forall a. [Char] -> a
errorWithoutStackTrace "Data.Data.fromConstr")
fromConstrB :: Data a
=> (forall d. Data d => d)
-> Constr
-> a
fromConstrB :: (forall d. Data d => d) -> Constr -> a
fromConstrB f :: forall d. Data d => d
f = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a) -> (Constr -> Identity a) -> Constr -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall b r. Data b => Identity (b -> r) -> Identity r)
-> (forall g. g -> Identity g) -> Constr -> Identity a
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a
gunfold forall b r. Data b => Identity (b -> r) -> Identity r
k forall g. g -> Identity g
z
where
k :: forall b r. Data b => Identity (b -> r) -> Identity r
k :: Identity (b -> r) -> Identity r
k c :: Identity (b -> r)
c = r -> Identity r
forall g. g -> Identity g
Identity (Identity (b -> r) -> b -> r
forall a. Identity a -> a
runIdentity Identity (b -> r)
c b
forall d. Data d => d
f)
z :: forall r. r -> Identity r
z :: r -> Identity r
z = r -> Identity r
forall g. g -> Identity g
Identity
fromConstrM :: forall m a. (Monad m, Data a)
=> (forall d. Data d => m d)
-> Constr
-> m a
fromConstrM :: (forall d. Data d => m d) -> Constr -> m a
fromConstrM f :: forall d. Data d => m d
f = (forall b r. Data b => m (b -> r) -> m r)
-> (forall r. r -> m r) -> Constr -> m a
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a
gunfold forall b r. Data b => m (b -> r) -> m r
k forall r. r -> m r
z
where
k :: forall b r. Data b => m (b -> r) -> m r
k :: m (b -> r) -> m r
k c :: m (b -> r)
c = do { b -> r
c' <- m (b -> r)
c; b
b <- m b
forall d. Data d => m d
f; r -> m r
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> r
c' b
b) }
z :: forall r. r -> m r
z :: r -> m r
z = r -> m r
forall (m :: * -> *) a. Monad m => a -> m a
return
data DataType = DataType
{ DataType -> [Char]
tycon :: String
, DataType -> DataRep
datarep :: DataRep
}
deriving Show
data Constr = Constr
{ Constr -> ConstrRep
conrep :: ConstrRep
, Constr -> [Char]
constring :: String
, Constr -> [[Char]]
confields :: [String]
, Constr -> Fixity
confixity :: Fixity
, Constr -> DataType
datatype :: DataType
}
instance Show Constr where
show :: Constr -> [Char]
show = Constr -> [Char]
constring
instance Eq Constr where
c :: Constr
c == :: Constr -> Constr -> Bool
== c' :: Constr
c' = Constr -> ConstrRep
constrRep Constr
c ConstrRep -> ConstrRep -> Bool
forall a. Eq a => a -> a -> Bool
== Constr -> ConstrRep
constrRep Constr
c'
data DataRep = AlgRep [Constr]
| IntRep
| FloatRep
| CharRep
| NoRep
deriving ( Eq
, Show
)
data ConstrRep = AlgConstr ConIndex
| IntConstr Integer
| FloatConstr Rational
| CharConstr Char
deriving ( Eq
, Show
)
type ConIndex = Int
data Fixity = Prefix
| Infix
deriving ( Eq
, Show
)
dataTypeName :: DataType -> String
dataTypeName :: DataType -> [Char]
dataTypeName = DataType -> [Char]
tycon
dataTypeRep :: DataType -> DataRep
dataTypeRep :: DataType -> DataRep
dataTypeRep = DataType -> DataRep
datarep
constrType :: Constr -> DataType
constrType :: Constr -> DataType
constrType = Constr -> DataType
datatype
constrRep :: Constr -> ConstrRep
constrRep :: Constr -> ConstrRep
constrRep = Constr -> ConstrRep
conrep
repConstr :: DataType -> ConstrRep -> Constr
repConstr :: DataType -> ConstrRep -> Constr
repConstr dt :: DataType
dt cr :: ConstrRep
cr =
case (DataType -> DataRep
dataTypeRep DataType
dt, ConstrRep
cr) of
(AlgRep cs :: [Constr]
cs, AlgConstr i :: Int
i) -> [Constr]
cs [Constr] -> Int -> Constr
forall a. [a] -> Int -> a
!! (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)
(IntRep, IntConstr i :: Integer
i) -> DataType -> Integer -> Constr
forall a. (Integral a, Show a) => DataType -> a -> Constr
mkIntegralConstr DataType
dt Integer
i
(FloatRep, FloatConstr f :: Rational
f) -> DataType -> Rational -> Constr
forall a. (Real a, Show a) => DataType -> a -> Constr
mkRealConstr DataType
dt Rational
f
(CharRep, CharConstr c :: Char
c) -> DataType -> Char -> Constr
mkCharConstr DataType
dt Char
c
_ -> [Char] -> Constr
forall a. [Char] -> a
errorWithoutStackTrace "Data.Data.repConstr: The given ConstrRep does not fit to the given DataType."
mkDataType :: String -> [Constr] -> DataType
mkDataType :: [Char] -> [Constr] -> DataType
mkDataType str :: [Char]
str cs :: [Constr]
cs = DataType :: [Char] -> DataRep -> DataType
DataType
{ tycon :: [Char]
tycon = [Char]
str
, datarep :: DataRep
datarep = [Constr] -> DataRep
AlgRep [Constr]
cs
}
mkConstr :: DataType -> String -> [String] -> Fixity -> Constr
mkConstr :: DataType -> [Char] -> [[Char]] -> Fixity -> Constr
mkConstr dt :: DataType
dt str :: [Char]
str fields :: [[Char]]
fields fix :: Fixity
fix =
Constr :: ConstrRep -> [Char] -> [[Char]] -> Fixity -> DataType -> Constr
Constr
{ conrep :: ConstrRep
conrep = Int -> ConstrRep
AlgConstr Int
idx
, constring :: [Char]
constring = [Char]
str
, confields :: [[Char]]
confields = [[Char]]
fields
, confixity :: Fixity
confixity = Fixity
fix
, datatype :: DataType
datatype = DataType
dt
}
where
idx :: Int
idx = [Int] -> Int
forall a. [a] -> a
head [ Int
i | (c :: Constr
c,i :: Int
i) <- DataType -> [Constr]
dataTypeConstrs DataType
dt [Constr] -> [Int] -> [(Constr, Int)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [1..],
Constr -> [Char]
showConstr Constr
c [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
str ]
dataTypeConstrs :: DataType -> [Constr]
dataTypeConstrs :: DataType -> [Constr]
dataTypeConstrs dt :: DataType
dt = case DataType -> DataRep
datarep DataType
dt of
(AlgRep cons :: [Constr]
cons) -> [Constr]
cons
_ -> [Char] -> [Constr]
forall a. [Char] -> a
errorWithoutStackTrace ([Char] -> [Constr]) -> [Char] -> [Constr]
forall a b. (a -> b) -> a -> b
$ "Data.Data.dataTypeConstrs is not supported for "
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ DataType -> [Char]
dataTypeName DataType
dt [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
", as it is not an algebraic data type."
constrFields :: Constr -> [String]
constrFields :: Constr -> [[Char]]
constrFields = Constr -> [[Char]]
confields
constrFixity :: Constr -> Fixity
constrFixity :: Constr -> Fixity
constrFixity = Constr -> Fixity
confixity
showConstr :: Constr -> String
showConstr :: Constr -> [Char]
showConstr = Constr -> [Char]
constring
readConstr :: DataType -> String -> Maybe Constr
readConstr :: DataType -> [Char] -> Maybe Constr
readConstr dt :: DataType
dt str :: [Char]
str =
case DataType -> DataRep
dataTypeRep DataType
dt of
AlgRep cons :: [Constr]
cons -> [Constr] -> Maybe Constr
idx [Constr]
cons
IntRep -> (Integer -> Constr) -> Maybe Constr
forall t. Read t => (t -> Constr) -> Maybe Constr
mkReadCon (\i :: Integer
i -> (DataType -> [Char] -> ConstrRep -> Constr
mkPrimCon DataType
dt [Char]
str (Integer -> ConstrRep
IntConstr Integer
i)))
FloatRep -> (Double -> Constr) -> Maybe Constr
forall t. Read t => (t -> Constr) -> Maybe Constr
mkReadCon Double -> Constr
ffloat
CharRep -> (Char -> Constr) -> Maybe Constr
forall t. Read t => (t -> Constr) -> Maybe Constr
mkReadCon (\c :: Char
c -> (DataType -> [Char] -> ConstrRep -> Constr
mkPrimCon DataType
dt [Char]
str (Char -> ConstrRep
CharConstr Char
c)))
NoRep -> Maybe Constr
forall a. Maybe a
Nothing
where
mkReadCon :: Read t => (t -> Constr) -> Maybe Constr
mkReadCon :: (t -> Constr) -> Maybe Constr
mkReadCon f :: t -> Constr
f = case (ReadS t
forall a. Read a => ReadS a
reads [Char]
str) of
[(t :: t
t,"")] -> Constr -> Maybe Constr
forall a. a -> Maybe a
Just (t -> Constr
f t
t)
_ -> Maybe Constr
forall a. Maybe a
Nothing
idx :: [Constr] -> Maybe Constr
idx :: [Constr] -> Maybe Constr
idx cons :: [Constr]
cons = let fit :: [Constr]
fit = (Constr -> Bool) -> [Constr] -> [Constr]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
(==) [Char]
str ([Char] -> Bool) -> (Constr -> [Char]) -> Constr -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constr -> [Char]
showConstr) [Constr]
cons
in if [Constr]
fit [Constr] -> [Constr] -> Bool
forall a. Eq a => a -> a -> Bool
== []
then Maybe Constr
forall a. Maybe a
Nothing
else Constr -> Maybe Constr
forall a. a -> Maybe a
Just ([Constr] -> Constr
forall a. [a] -> a
head [Constr]
fit)
ffloat :: Double -> Constr
ffloat :: Double -> Constr
ffloat = DataType -> [Char] -> ConstrRep -> Constr
mkPrimCon DataType
dt [Char]
str (ConstrRep -> Constr) -> (Double -> ConstrRep) -> Double -> Constr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> ConstrRep
FloatConstr (Rational -> ConstrRep)
-> (Double -> Rational) -> Double -> ConstrRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Rational
forall a. Real a => a -> Rational
toRational
isAlgType :: DataType -> Bool
isAlgType :: DataType -> Bool
isAlgType dt :: DataType
dt = case DataType -> DataRep
datarep DataType
dt of
(AlgRep _) -> Bool
True
_ -> Bool
False
indexConstr :: DataType -> ConIndex -> Constr
indexConstr :: DataType -> Int -> Constr
indexConstr dt :: DataType
dt idx :: Int
idx = case DataType -> DataRep
datarep DataType
dt of
(AlgRep cs :: [Constr]
cs) -> [Constr]
cs [Constr] -> Int -> Constr
forall a. [a] -> Int -> a
!! (Int
idxInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)
_ -> [Char] -> Constr
forall a. [Char] -> a
errorWithoutStackTrace ([Char] -> Constr) -> [Char] -> Constr
forall a b. (a -> b) -> a -> b
$ "Data.Data.indexConstr is not supported for "
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ DataType -> [Char]
dataTypeName DataType
dt [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
", as it is not an algebraic data type."
constrIndex :: Constr -> ConIndex
constrIndex :: Constr -> Int
constrIndex con :: Constr
con = case Constr -> ConstrRep
constrRep Constr
con of
(AlgConstr idx :: Int
idx) -> Int
idx
_ -> [Char] -> Int
forall a. [Char] -> a
errorWithoutStackTrace ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ "Data.Data.constrIndex is not supported for "
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ DataType -> [Char]
dataTypeName (Constr -> DataType
constrType Constr
con) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
", as it is not an algebraic data type."
maxConstrIndex :: DataType -> ConIndex
maxConstrIndex :: DataType -> Int
maxConstrIndex dt :: DataType
dt = case DataType -> DataRep
dataTypeRep DataType
dt of
AlgRep cs :: [Constr]
cs -> [Constr] -> Int
forall a. [a] -> Int
length [Constr]
cs
_ -> [Char] -> Int
forall a. [Char] -> a
errorWithoutStackTrace ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ "Data.Data.maxConstrIndex is not supported for "
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ DataType -> [Char]
dataTypeName DataType
dt [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
", as it is not an algebraic data type."
mkIntType :: String -> DataType
mkIntType :: [Char] -> DataType
mkIntType = DataRep -> [Char] -> DataType
mkPrimType DataRep
IntRep
mkFloatType :: String -> DataType
mkFloatType :: [Char] -> DataType
mkFloatType = DataRep -> [Char] -> DataType
mkPrimType DataRep
FloatRep
mkCharType :: String -> DataType
mkCharType :: [Char] -> DataType
mkCharType = DataRep -> [Char] -> DataType
mkPrimType DataRep
CharRep
mkPrimType :: DataRep -> String -> DataType
mkPrimType :: DataRep -> [Char] -> DataType
mkPrimType dr :: DataRep
dr str :: [Char]
str = DataType :: [Char] -> DataRep -> DataType
DataType
{ tycon :: [Char]
tycon = [Char]
str
, datarep :: DataRep
datarep = DataRep
dr
}
mkPrimCon :: DataType -> String -> ConstrRep -> Constr
mkPrimCon :: DataType -> [Char] -> ConstrRep -> Constr
mkPrimCon dt :: DataType
dt str :: [Char]
str cr :: ConstrRep
cr = Constr :: ConstrRep -> [Char] -> [[Char]] -> Fixity -> DataType -> Constr
Constr
{ datatype :: DataType
datatype = DataType
dt
, conrep :: ConstrRep
conrep = ConstrRep
cr
, constring :: [Char]
constring = [Char]
str
, confields :: [[Char]]
confields = [Char] -> [[Char]]
forall a. [Char] -> a
errorWithoutStackTrace "Data.Data.confields"
, confixity :: Fixity
confixity = [Char] -> Fixity
forall a. [Char] -> a
errorWithoutStackTrace "Data.Data.confixity"
}
mkIntegralConstr :: (Integral a, Show a) => DataType -> a -> Constr
mkIntegralConstr :: DataType -> a -> Constr
mkIntegralConstr dt :: DataType
dt i :: a
i = case DataType -> DataRep
datarep DataType
dt of
IntRep -> DataType -> [Char] -> ConstrRep -> Constr
mkPrimCon DataType
dt (a -> [Char]
forall a. Show a => a -> [Char]
show a
i) (Integer -> ConstrRep
IntConstr (a -> Integer
forall a. Integral a => a -> Integer
toInteger a
i))
_ -> [Char] -> Constr
forall a. [Char] -> a
errorWithoutStackTrace ([Char] -> Constr) -> [Char] -> Constr
forall a b. (a -> b) -> a -> b
$ "Data.Data.mkIntegralConstr is not supported for "
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ DataType -> [Char]
dataTypeName DataType
dt [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
", as it is not an Integral data type."
mkRealConstr :: (Real a, Show a) => DataType -> a -> Constr
mkRealConstr :: DataType -> a -> Constr
mkRealConstr dt :: DataType
dt f :: a
f = case DataType -> DataRep
datarep DataType
dt of
FloatRep -> DataType -> [Char] -> ConstrRep -> Constr
mkPrimCon DataType
dt (a -> [Char]
forall a. Show a => a -> [Char]
show a
f) (Rational -> ConstrRep
FloatConstr (a -> Rational
forall a. Real a => a -> Rational
toRational a
f))
_ -> [Char] -> Constr
forall a. [Char] -> a
errorWithoutStackTrace ([Char] -> Constr) -> [Char] -> Constr
forall a b. (a -> b) -> a -> b
$ "Data.Data.mkRealConstr is not supported for "
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ DataType -> [Char]
dataTypeName DataType
dt [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
", as it is not a Real data type."
mkCharConstr :: DataType -> Char -> Constr
mkCharConstr :: DataType -> Char -> Constr
mkCharConstr dt :: DataType
dt c :: Char
c = case DataType -> DataRep
datarep DataType
dt of
CharRep -> DataType -> [Char] -> ConstrRep -> Constr
mkPrimCon DataType
dt (Char -> [Char]
forall a. Show a => a -> [Char]
show Char
c) (Char -> ConstrRep
CharConstr Char
c)
_ -> [Char] -> Constr
forall a. [Char] -> a
errorWithoutStackTrace ([Char] -> Constr) -> [Char] -> Constr
forall a b. (a -> b) -> a -> b
$ "Data.Data.mkCharConstr is not supported for "
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ DataType -> [Char]
dataTypeName DataType
dt [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
", as it is not an Char data type."
mkNoRepType :: String -> DataType
mkNoRepType :: [Char] -> DataType
mkNoRepType str :: [Char]
str = DataType :: [Char] -> DataRep -> DataType
DataType
{ tycon :: [Char]
tycon = [Char]
str
, datarep :: DataRep
datarep = DataRep
NoRep
}
isNorepType :: DataType -> Bool
isNorepType :: DataType -> Bool
isNorepType dt :: DataType
dt = case DataType -> DataRep
datarep DataType
dt of
NoRep -> Bool
True
_ -> Bool
False
tyconUQname :: String -> String
tyconUQname :: ShowS
tyconUQname x :: [Char]
x = let x' :: [Char]
x' = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==) '.') [Char]
x
in if [Char]
x' [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [] then [Char]
x else ShowS
tyconUQname (ShowS
forall a. [a] -> [a]
tail [Char]
x')
tyconModule :: String -> String
tyconModule :: ShowS
tyconModule x :: [Char]
x = let (a :: [Char]
a,b :: [Char]
b) = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==) '.') [Char]
x
in if [Char]
b [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== ""
then [Char]
b
else [Char]
a [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
tyconModule' (ShowS
forall a. [a] -> [a]
tail [Char]
b)
where
tyconModule' :: ShowS
tyconModule' y :: [Char]
y = let y' :: [Char]
y' = ShowS
tyconModule [Char]
y
in if [Char]
y' [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== "" then "" else ('.'Char -> ShowS
forall a. a -> [a] -> [a]
:[Char]
y')
deriving instance Data Bool
charType :: DataType
charType :: DataType
charType = [Char] -> DataType
mkCharType "Prelude.Char"
instance Data Char where
toConstr :: Char -> Constr
toConstr x :: Char
x = DataType -> Char -> Constr
mkCharConstr DataType
charType Char
x
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Char
gunfold _ z :: forall r. r -> c r
z c :: Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
(CharConstr x :: Char
x) -> Char -> c Char
forall r. r -> c r
z Char
x
_ -> [Char] -> c Char
forall a. [Char] -> a
errorWithoutStackTrace ([Char] -> c Char) -> [Char] -> c Char
forall a b. (a -> b) -> a -> b
$ "Data.Data.gunfold: Constructor " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Constr -> [Char]
forall a. Show a => a -> [Char]
show Constr
c
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ " is not of type Char."
dataTypeOf :: Char -> DataType
dataTypeOf _ = DataType
charType
floatType :: DataType
floatType :: DataType
floatType = [Char] -> DataType
mkFloatType "Prelude.Float"
instance Data Float where
toConstr :: Float -> Constr
toConstr = DataType -> Float -> Constr
forall a. (Real a, Show a) => DataType -> a -> Constr
mkRealConstr DataType
floatType
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Float
gunfold _ z :: forall r. r -> c r
z c :: Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
(FloatConstr x :: Rational
x) -> Float -> c Float
forall r. r -> c r
z (Rational -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Rational
x)
_ -> [Char] -> c Float
forall a. [Char] -> a
errorWithoutStackTrace ([Char] -> c Float) -> [Char] -> c Float
forall a b. (a -> b) -> a -> b
$ "Data.Data.gunfold: Constructor " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Constr -> [Char]
forall a. Show a => a -> [Char]
show Constr
c
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ " is not of type Float."
dataTypeOf :: Float -> DataType
dataTypeOf _ = DataType
floatType
doubleType :: DataType
doubleType :: DataType
doubleType = [Char] -> DataType
mkFloatType "Prelude.Double"
instance Data Double where
toConstr :: Double -> Constr
toConstr = DataType -> Double -> Constr
forall a. (Real a, Show a) => DataType -> a -> Constr
mkRealConstr DataType
doubleType
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Double
gunfold _ z :: forall r. r -> c r
z c :: Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
(FloatConstr x :: Rational
x) -> Double -> c Double
forall r. r -> c r
z (Rational -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Rational
x)
_ -> [Char] -> c Double
forall a. [Char] -> a
errorWithoutStackTrace ([Char] -> c Double) -> [Char] -> c Double
forall a b. (a -> b) -> a -> b
$ "Data.Data.gunfold: Constructor " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Constr -> [Char]
forall a. Show a => a -> [Char]
show Constr
c
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ " is not of type Double."
dataTypeOf :: Double -> DataType
dataTypeOf _ = DataType
doubleType
intType :: DataType
intType :: DataType
intType = [Char] -> DataType
mkIntType "Prelude.Int"
instance Data Int where
toConstr :: Int -> Constr
toConstr x :: Int
x = DataType -> Int -> Constr
forall a. (Integral a, Show a) => DataType -> a -> Constr
mkIntegralConstr DataType
intType Int
x
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Int
gunfold _ z :: forall r. r -> c r
z c :: Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
(IntConstr x :: Integer
x) -> Int -> c Int
forall r. r -> c r
z (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)
_ -> [Char] -> c Int
forall a. [Char] -> a
errorWithoutStackTrace ([Char] -> c Int) -> [Char] -> c Int
forall a b. (a -> b) -> a -> b
$ "Data.Data.gunfold: Constructor " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Constr -> [Char]
forall a. Show a => a -> [Char]
show Constr
c
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ " is not of type Int."
dataTypeOf :: Int -> DataType
dataTypeOf _ = DataType
intType
integerType :: DataType
integerType :: DataType
integerType = [Char] -> DataType
mkIntType "Prelude.Integer"
instance Data Integer where
toConstr :: Integer -> Constr
toConstr = DataType -> Integer -> Constr
forall a. (Integral a, Show a) => DataType -> a -> Constr
mkIntegralConstr DataType
integerType
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Integer
gunfold _ z :: forall r. r -> c r
z c :: Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
(IntConstr x :: Integer
x) -> Integer -> c Integer
forall r. r -> c r
z Integer
x
_ -> [Char] -> c Integer
forall a. [Char] -> a
errorWithoutStackTrace ([Char] -> c Integer) -> [Char] -> c Integer
forall a b. (a -> b) -> a -> b
$ "Data.Data.gunfold: Constructor " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Constr -> [Char]
forall a. Show a => a -> [Char]
show Constr
c
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ " is not of type Integer."
dataTypeOf :: Integer -> DataType
dataTypeOf _ = DataType
integerType
naturalType :: DataType
naturalType :: DataType
naturalType = [Char] -> DataType
mkIntType "Numeric.Natural.Natural"
instance Data Natural where
toConstr :: Natural -> Constr
toConstr x :: Natural
x = DataType -> Natural -> Constr
forall a. (Integral a, Show a) => DataType -> a -> Constr
mkIntegralConstr DataType
naturalType Natural
x
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Natural
gunfold _ z :: forall r. r -> c r
z c :: Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
(IntConstr x :: Integer
x) -> Natural -> c Natural
forall r. r -> c r
z (Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)
_ -> [Char] -> c Natural
forall a. [Char] -> a
errorWithoutStackTrace ([Char] -> c Natural) -> [Char] -> c Natural
forall a b. (a -> b) -> a -> b
$ "Data.Data.gunfold: Constructor " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Constr -> [Char]
forall a. Show a => a -> [Char]
show Constr
c
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ " is not of type Natural"
dataTypeOf :: Natural -> DataType
dataTypeOf _ = DataType
naturalType
int8Type :: DataType
int8Type :: DataType
int8Type = [Char] -> DataType
mkIntType "Data.Int.Int8"
instance Data Int8 where
toConstr :: Int8 -> Constr
toConstr x :: Int8
x = DataType -> Int8 -> Constr
forall a. (Integral a, Show a) => DataType -> a -> Constr
mkIntegralConstr DataType
int8Type Int8
x
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Int8
gunfold _ z :: forall r. r -> c r
z c :: Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
(IntConstr x :: Integer
x) -> Int8 -> c Int8
forall r. r -> c r
z (Integer -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)
_ -> [Char] -> c Int8
forall a. [Char] -> a
errorWithoutStackTrace ([Char] -> c Int8) -> [Char] -> c Int8
forall a b. (a -> b) -> a -> b
$ "Data.Data.gunfold: Constructor " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Constr -> [Char]
forall a. Show a => a -> [Char]
show Constr
c
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ " is not of type Int8."
dataTypeOf :: Int8 -> DataType
dataTypeOf _ = DataType
int8Type
int16Type :: DataType
int16Type :: DataType
int16Type = [Char] -> DataType
mkIntType "Data.Int.Int16"
instance Data Int16 where
toConstr :: Int16 -> Constr
toConstr x :: Int16
x = DataType -> Int16 -> Constr
forall a. (Integral a, Show a) => DataType -> a -> Constr
mkIntegralConstr DataType
int16Type Int16
x
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Int16
gunfold _ z :: forall r. r -> c r
z c :: Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
(IntConstr x :: Integer
x) -> Int16 -> c Int16
forall r. r -> c r
z (Integer -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)
_ -> [Char] -> c Int16
forall a. [Char] -> a
errorWithoutStackTrace ([Char] -> c Int16) -> [Char] -> c Int16
forall a b. (a -> b) -> a -> b
$ "Data.Data.gunfold: Constructor " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Constr -> [Char]
forall a. Show a => a -> [Char]
show Constr
c
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ " is not of type Int16."
dataTypeOf :: Int16 -> DataType
dataTypeOf _ = DataType
int16Type
int32Type :: DataType
int32Type :: DataType
int32Type = [Char] -> DataType
mkIntType "Data.Int.Int32"
instance Data Int32 where
toConstr :: Int32 -> Constr
toConstr x :: Int32
x = DataType -> Int32 -> Constr
forall a. (Integral a, Show a) => DataType -> a -> Constr
mkIntegralConstr DataType
int32Type Int32
x
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Int32
gunfold _ z :: forall r. r -> c r
z c :: Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
(IntConstr x :: Integer
x) -> Int32 -> c Int32
forall r. r -> c r
z (Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)
_ -> [Char] -> c Int32
forall a. [Char] -> a
errorWithoutStackTrace ([Char] -> c Int32) -> [Char] -> c Int32
forall a b. (a -> b) -> a -> b
$ "Data.Data.gunfold: Constructor " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Constr -> [Char]
forall a. Show a => a -> [Char]
show Constr
c
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ " is not of type Int32."
dataTypeOf :: Int32 -> DataType
dataTypeOf _ = DataType
int32Type
int64Type :: DataType
int64Type :: DataType
int64Type = [Char] -> DataType
mkIntType "Data.Int.Int64"
instance Data Int64 where
toConstr :: Int64 -> Constr
toConstr x :: Int64
x = DataType -> Int64 -> Constr
forall a. (Integral a, Show a) => DataType -> a -> Constr
mkIntegralConstr DataType
int64Type Int64
x
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Int64
gunfold _ z :: forall r. r -> c r
z c :: Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
(IntConstr x :: Integer
x) -> Int64 -> c Int64
forall r. r -> c r
z (Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)
_ -> [Char] -> c Int64
forall a. [Char] -> a
errorWithoutStackTrace ([Char] -> c Int64) -> [Char] -> c Int64
forall a b. (a -> b) -> a -> b
$ "Data.Data.gunfold: Constructor " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Constr -> [Char]
forall a. Show a => a -> [Char]
show Constr
c
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ " is not of type Int64."
dataTypeOf :: Int64 -> DataType
dataTypeOf _ = DataType
int64Type
wordType :: DataType
wordType :: DataType
wordType = [Char] -> DataType
mkIntType "Data.Word.Word"
instance Data Word where
toConstr :: Word -> Constr
toConstr x :: Word
x = DataType -> Word -> Constr
forall a. (Integral a, Show a) => DataType -> a -> Constr
mkIntegralConstr DataType
wordType Word
x
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Word
gunfold _ z :: forall r. r -> c r
z c :: Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
(IntConstr x :: Integer
x) -> Word -> c Word
forall r. r -> c r
z (Integer -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)
_ -> [Char] -> c Word
forall a. [Char] -> a
errorWithoutStackTrace ([Char] -> c Word) -> [Char] -> c Word
forall a b. (a -> b) -> a -> b
$ "Data.Data.gunfold: Constructor " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Constr -> [Char]
forall a. Show a => a -> [Char]
show Constr
c
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ " is not of type Word"
dataTypeOf :: Word -> DataType
dataTypeOf _ = DataType
wordType
word8Type :: DataType
word8Type :: DataType
word8Type = [Char] -> DataType
mkIntType "Data.Word.Word8"
instance Data Word8 where
toConstr :: Word8 -> Constr
toConstr x :: Word8
x = DataType -> Word8 -> Constr
forall a. (Integral a, Show a) => DataType -> a -> Constr
mkIntegralConstr DataType
word8Type Word8
x
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Word8
gunfold _ z :: forall r. r -> c r
z c :: Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
(IntConstr x :: Integer
x) -> Word8 -> c Word8
forall r. r -> c r
z (Integer -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)
_ -> [Char] -> c Word8
forall a. [Char] -> a
errorWithoutStackTrace ([Char] -> c Word8) -> [Char] -> c Word8
forall a b. (a -> b) -> a -> b
$ "Data.Data.gunfold: Constructor " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Constr -> [Char]
forall a. Show a => a -> [Char]
show Constr
c
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ " is not of type Word8."
dataTypeOf :: Word8 -> DataType
dataTypeOf _ = DataType
word8Type
word16Type :: DataType
word16Type :: DataType
word16Type = [Char] -> DataType
mkIntType "Data.Word.Word16"
instance Data Word16 where
toConstr :: Word16 -> Constr
toConstr x :: Word16
x = DataType -> Word16 -> Constr
forall a. (Integral a, Show a) => DataType -> a -> Constr
mkIntegralConstr DataType
word16Type Word16
x
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Word16
gunfold _ z :: forall r. r -> c r
z c :: Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
(IntConstr x :: Integer
x) -> Word16 -> c Word16
forall r. r -> c r
z (Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)
_ -> [Char] -> c Word16
forall a. [Char] -> a
errorWithoutStackTrace ([Char] -> c Word16) -> [Char] -> c Word16
forall a b. (a -> b) -> a -> b
$ "Data.Data.gunfold: Constructor " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Constr -> [Char]
forall a. Show a => a -> [Char]
show Constr
c
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ " is not of type Word16."
dataTypeOf :: Word16 -> DataType
dataTypeOf _ = DataType
word16Type
word32Type :: DataType
word32Type :: DataType
word32Type = [Char] -> DataType
mkIntType "Data.Word.Word32"
instance Data Word32 where
toConstr :: Word32 -> Constr
toConstr x :: Word32
x = DataType -> Word32 -> Constr
forall a. (Integral a, Show a) => DataType -> a -> Constr
mkIntegralConstr DataType
word32Type Word32
x
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Word32
gunfold _ z :: forall r. r -> c r
z c :: Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
(IntConstr x :: Integer
x) -> Word32 -> c Word32
forall r. r -> c r
z (Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)
_ -> [Char] -> c Word32
forall a. [Char] -> a
errorWithoutStackTrace ([Char] -> c Word32) -> [Char] -> c Word32
forall a b. (a -> b) -> a -> b
$ "Data.Data.gunfold: Constructor " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Constr -> [Char]
forall a. Show a => a -> [Char]
show Constr
c
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ " is not of type Word32."
dataTypeOf :: Word32 -> DataType
dataTypeOf _ = DataType
word32Type
word64Type :: DataType
word64Type :: DataType
word64Type = [Char] -> DataType
mkIntType "Data.Word.Word64"
instance Data Word64 where
toConstr :: Word64 -> Constr
toConstr x :: Word64
x = DataType -> Word64 -> Constr
forall a. (Integral a, Show a) => DataType -> a -> Constr
mkIntegralConstr DataType
word64Type Word64
x
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Word64
gunfold _ z :: forall r. r -> c r
z c :: Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
(IntConstr x :: Integer
x) -> Word64 -> c Word64
forall r. r -> c r
z (Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)
_ -> [Char] -> c Word64
forall a. [Char] -> a
errorWithoutStackTrace ([Char] -> c Word64) -> [Char] -> c Word64
forall a b. (a -> b) -> a -> b
$ "Data.Data.gunfold: Constructor " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Constr -> [Char]
forall a. Show a => a -> [Char]
show Constr
c
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ " is not of type Word64."
dataTypeOf :: Word64 -> DataType
dataTypeOf _ = DataType
word64Type
ratioConstr :: Constr
ratioConstr :: Constr
ratioConstr = DataType -> [Char] -> [[Char]] -> Fixity -> Constr
mkConstr DataType
ratioDataType ":%" [] Fixity
Infix
ratioDataType :: DataType
ratioDataType :: DataType
ratioDataType = [Char] -> [Constr] -> DataType
mkDataType "GHC.Real.Ratio" [Constr
ratioConstr]
instance (Data a, Integral a) => Data (Ratio a) where
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ratio a -> c (Ratio a)
gfoldl k :: forall d b. Data d => c (d -> b) -> d -> c b
k z :: forall g. g -> c g
z (a :: a
a :% b :: a
b) = (a -> a -> Ratio a) -> c (a -> a -> Ratio a)
forall g. g -> c g
z a -> a -> Ratio a
forall a. Integral a => a -> a -> Ratio a
(%) c (a -> a -> Ratio a) -> a -> c (a -> Ratio a)
forall d b. Data d => c (d -> b) -> d -> c b
`k` a
a c (a -> Ratio a) -> a -> c (Ratio a)
forall d b. Data d => c (d -> b) -> d -> c b
`k` a
b
toConstr :: Ratio a -> Constr
toConstr _ = Constr
ratioConstr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Ratio a)
gunfold k :: forall b r. Data b => c (b -> r) -> c r
k z :: forall r. r -> c r
z c :: Constr
c | Constr -> Int
constrIndex Constr
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = c (a -> Ratio a) -> c (Ratio a)
forall b r. Data b => c (b -> r) -> c r
k (c (a -> a -> Ratio a) -> c (a -> Ratio a)
forall b r. Data b => c (b -> r) -> c r
k ((a -> a -> Ratio a) -> c (a -> a -> Ratio a)
forall r. r -> c r
z a -> a -> Ratio a
forall a. Integral a => a -> a -> Ratio a
(%)))
gunfold _ _ _ = [Char] -> c (Ratio a)
forall a. [Char] -> a
errorWithoutStackTrace "Data.Data.gunfold(Ratio)"
dataTypeOf :: Ratio a -> DataType
dataTypeOf _ = DataType
ratioDataType
nilConstr :: Constr
nilConstr :: Constr
nilConstr = DataType -> [Char] -> [[Char]] -> Fixity -> Constr
mkConstr DataType
listDataType "[]" [] Fixity
Prefix
consConstr :: Constr
consConstr :: Constr
consConstr = DataType -> [Char] -> [[Char]] -> Fixity -> Constr
mkConstr DataType
listDataType "(:)" [] Fixity
Infix
listDataType :: DataType
listDataType :: DataType
listDataType = [Char] -> [Constr] -> DataType
mkDataType "Prelude.[]" [Constr
nilConstr,Constr
consConstr]
instance Data a => Data [a] where
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> [a] -> c [a]
gfoldl _ z :: forall g. g -> c g
z [] = [a] -> c [a]
forall g. g -> c g
z []
gfoldl f :: forall d b. Data d => c (d -> b) -> d -> c b
f z :: forall g. g -> c g
z (x :: a
x:xs :: [a]
xs) = (a -> [a] -> [a]) -> c (a -> [a] -> [a])
forall g. g -> c g
z (:) c (a -> [a] -> [a]) -> a -> c ([a] -> [a])
forall d b. Data d => c (d -> b) -> d -> c b
`f` a
x c ([a] -> [a]) -> [a] -> c [a]
forall d b. Data d => c (d -> b) -> d -> c b
`f` [a]
xs
toConstr :: [a] -> Constr
toConstr [] = Constr
nilConstr
toConstr (_:_) = Constr
consConstr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c [a]
gunfold k :: forall b r. Data b => c (b -> r) -> c r
k z :: forall r. r -> c r
z c :: Constr
c = case Constr -> Int
constrIndex Constr
c of
1 -> [a] -> c [a]
forall r. r -> c r
z []
2 -> c ([a] -> [a]) -> c [a]
forall b r. Data b => c (b -> r) -> c r
k (c (a -> [a] -> [a]) -> c ([a] -> [a])
forall b r. Data b => c (b -> r) -> c r
k ((a -> [a] -> [a]) -> c (a -> [a] -> [a])
forall r. r -> c r
z (:)))
_ -> [Char] -> c [a]
forall a. [Char] -> a
errorWithoutStackTrace "Data.Data.gunfold(List)"
dataTypeOf :: [a] -> DataType
dataTypeOf _ = DataType
listDataType
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c [a])
dataCast1 f :: forall d. Data d => c (t d)
f = c (t a) -> Maybe (c [a])
forall k1 k2 (c :: k1 -> *) (t :: k2 -> k1) (t' :: k2 -> k1)
(a :: k2).
(Typeable t, Typeable t') =>
c (t a) -> Maybe (c (t' a))
gcast1 c (t a)
forall d. Data d => c (t d)
f
gmapT :: (forall b. Data b => b -> b) -> [a] -> [a]
gmapT _ [] = []
gmapT f :: forall b. Data b => b -> b
f (x :: a
x:xs :: [a]
xs) = (a -> a
forall b. Data b => b -> b
f a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a] -> [a]
forall b. Data b => b -> b
f [a]
xs)
gmapQ :: (forall d. Data d => d -> u) -> [a] -> [u]
gmapQ _ [] = []
gmapQ f :: forall d. Data d => d -> u
f (x :: a
x:xs :: [a]
xs) = [a -> u
forall d. Data d => d -> u
f a
x,[a] -> u
forall d. Data d => d -> u
f [a]
xs]
gmapM :: (forall d. Data d => d -> m d) -> [a] -> m [a]
gmapM _ [] = [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
gmapM f :: forall d. Data d => d -> m d
f (x :: a
x:xs :: [a]
xs) = a -> m a
forall d. Data d => d -> m d
f a
x m a -> (a -> m [a]) -> m [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \x' :: a
x' -> [a] -> m [a]
forall d. Data d => d -> m d
f [a]
xs m [a] -> ([a] -> m [a]) -> m [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \xs' :: [a]
xs' -> [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x'a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs')
deriving instance Data a => Data (NonEmpty a)
deriving instance Data a => Data (Maybe a)
deriving instance Data Ordering
deriving instance (Data a, Data b) => Data (Either a b)
deriving instance Data ()
deriving instance (Data a, Data b) => Data (a,b)
deriving instance (Data a, Data b, Data c) => Data (a,b,c)
deriving instance (Data a, Data b, Data c, Data d)
=> Data (a,b,c,d)
deriving instance (Data a, Data b, Data c, Data d, Data e)
=> Data (a,b,c,d,e)
deriving instance (Data a, Data b, Data c, Data d, Data e, Data f)
=> Data (a,b,c,d,e,f)
deriving instance (Data a, Data b, Data c, Data d, Data e, Data f, Data g)
=> Data (a,b,c,d,e,f,g)
instance Data a => Data (Ptr a) where
toConstr :: Ptr a -> Constr
toConstr _ = [Char] -> Constr
forall a. [Char] -> a
errorWithoutStackTrace "Data.Data.toConstr(Ptr)"
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Ptr a)
gunfold _ _ = [Char] -> Constr -> c (Ptr a)
forall a. [Char] -> a
errorWithoutStackTrace "Data.Data.gunfold(Ptr)"
dataTypeOf :: Ptr a -> DataType
dataTypeOf _ = [Char] -> DataType
mkNoRepType "GHC.Ptr.Ptr"
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Ptr a))
dataCast1 x :: forall d. Data d => c (t d)
x = c (t a) -> Maybe (c (Ptr a))
forall k1 k2 (c :: k1 -> *) (t :: k2 -> k1) (t' :: k2 -> k1)
(a :: k2).
(Typeable t, Typeable t') =>
c (t a) -> Maybe (c (t' a))
gcast1 c (t a)
forall d. Data d => c (t d)
x
instance Data a => Data (ForeignPtr a) where
toConstr :: ForeignPtr a -> Constr
toConstr _ = [Char] -> Constr
forall a. [Char] -> a
errorWithoutStackTrace "Data.Data.toConstr(ForeignPtr)"
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ForeignPtr a)
gunfold _ _ = [Char] -> Constr -> c (ForeignPtr a)
forall a. [Char] -> a
errorWithoutStackTrace "Data.Data.gunfold(ForeignPtr)"
dataTypeOf :: ForeignPtr a -> DataType
dataTypeOf _ = [Char] -> DataType
mkNoRepType "GHC.ForeignPtr.ForeignPtr"
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (ForeignPtr a))
dataCast1 x :: forall d. Data d => c (t d)
x = c (t a) -> Maybe (c (ForeignPtr a))
forall k1 k2 (c :: k1 -> *) (t :: k2 -> k1) (t' :: k2 -> k1)
(a :: k2).
(Typeable t, Typeable t') =>
c (t a) -> Maybe (c (t' a))
gcast1 c (t a)
forall d. Data d => c (t d)
x
deriving instance Data IntPtr
deriving instance Data WordPtr
instance (Data a, Data b, Ix a) => Data (Array a b)
where
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Array a b -> c (Array a b)
gfoldl f :: forall d b. Data d => c (d -> b) -> d -> c b
f z :: forall g. g -> c g
z a :: Array a b
a = ([b] -> Array a b) -> c ([b] -> Array a b)
forall g. g -> c g
z ((a, a) -> [b] -> Array a b
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Array a b -> (a, a)
forall i e. Array i e -> (i, i)
bounds Array a b
a)) c ([b] -> Array a b) -> [b] -> c (Array a b)
forall d b. Data d => c (d -> b) -> d -> c b
`f` (Array a b -> [b]
forall i e. Array i e -> [e]
elems Array a b
a)
toConstr :: Array a b -> Constr
toConstr _ = [Char] -> Constr
forall a. [Char] -> a
errorWithoutStackTrace "Data.Data.toConstr(Array)"
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Array a b)
gunfold _ _ = [Char] -> Constr -> c (Array a b)
forall a. [Char] -> a
errorWithoutStackTrace "Data.Data.gunfold(Array)"
dataTypeOf :: Array a b -> DataType
dataTypeOf _ = [Char] -> DataType
mkNoRepType "Data.Array.Array"
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Array a b))
dataCast2 x :: forall d e. (Data d, Data e) => c (t d e)
x = c (t a b) -> Maybe (c (Array a b))
forall k1 k2 k3 (c :: k1 -> *) (t :: k2 -> k3 -> k1)
(t' :: k2 -> k3 -> k1) (a :: k2) (b :: k3).
(Typeable t, Typeable t') =>
c (t a b) -> Maybe (c (t' a b))
gcast2 c (t a b)
forall d e. (Data d, Data e) => c (t d e)
x
deriving instance (Data t) => Data (Proxy t)
deriving instance (a ~ b, Data a) => Data (a :~: b)
deriving instance (Typeable i, Typeable j, Typeable a, Typeable b,
(a :: i) ~~ (b :: j))
=> Data (a :~~: b)
deriving instance (Coercible a b, Data a, Data b) => Data (Coercion a b)
deriving instance Data a => Data (Identity a)
deriving instance (Typeable k, Data a, Typeable (b :: k)) => Data (Const a b)
deriving instance Data Version
deriving instance Data a => Data (Dual a)
deriving instance Data All
deriving instance Data Any
deriving instance Data a => Data (Sum a)
deriving instance Data a => Data (Product a)
deriving instance Data a => Data (First a)
deriving instance Data a => Data (Last a)
deriving instance (Data (f a), Data a, Typeable f) => Data (Alt f a)
deriving instance (Data (f a), Data a, Typeable f) => Data (Ap f a)
deriving instance Data p => Data (U1 p)
deriving instance Data p => Data (Par1 p)
deriving instance (Data (f p), Typeable f, Data p) => Data (Rec1 f p)
deriving instance (Typeable i, Data p, Data c) => Data (K1 i c p)
deriving instance (Data p, Data (f p), Typeable c, Typeable i, Typeable f)
=> Data (M1 i c f p)
deriving instance (Typeable f, Typeable g, Data p, Data (f p), Data (g p))
=> Data ((f :+: g) p)
deriving instance (Typeable (f :: Type -> Type), Typeable (g :: Type -> Type),
Data p, Data (f (g p)))
=> Data ((f :.: g) p)
deriving instance Data p => Data (V1 p)
deriving instance (Typeable f, Typeable g, Data p, Data (f p), Data (g p))
=> Data ((f :*: g) p)
deriving instance Data Generics.Fixity
deriving instance Data Associativity
deriving instance Data SourceUnpackedness
deriving instance Data SourceStrictness
deriving instance Data DecidedStrictness
deriving instance Data a => Data (Down a)