{-# 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,
mkConstrTag,
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.List (findIndex)
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 GHC.Tuple (Solo (..))
import Text.Read( reads )
import Control.Applicative (WrappedArrow(..), WrappedMonad(..), ZipList(..))
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 forall d b. Data d => c (d -> b) -> d -> c b
_ forall g. g -> c g
z = 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 forall d. Data d => c (t d)
_ = forall a. Maybe a
Nothing
dataCast2 :: Typeable t
=> (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c a)
dataCast2 forall d e. (Data d, Data e) => c (t d e)
_ = forall a. Maybe a
Nothing
gmapT :: (forall b. Data b => b -> b) -> a -> a
gmapT forall b. Data b => b -> b
f a
x0 = forall a. Identity a -> a
runIdentity (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 a. a -> Identity a
Identity a
x0)
where
k :: Data d => Identity (d->b) -> d -> Identity b
k :: forall d b. Data d => Identity (d -> b) -> d -> Identity b
k (Identity d -> b
c) d
x = forall a. a -> Identity a
Identity (d -> b
c (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 r -> r' -> r
o r
r forall d. Data d => d -> r'
f = forall {k} a (b :: k). Const a b -> a
getConst forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall d b. Data d => Const r (d -> b) -> d -> Const r b
k Const r (d -> b)
c d
x = forall {k} a (b :: k). a -> Const a b
Const forall a b. (a -> b) -> a -> b
$ (forall {k} a (b :: k). Const a b -> a
getConst Const r (d -> b)
c) r -> r' -> r
`o` forall d. Data d => d -> r'
f d
x
z :: g -> Const r g
z :: forall g. g -> Const r g
z 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 r' -> r -> r
o r
r0 forall d. Data d => d -> r'
f a
x0 = forall {k} r (a :: k). Qr r a -> r -> r
unQr (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 (forall a b. a -> b -> a
const (forall {k} r (a :: k). (r -> r) -> Qr r a
Qr forall a. a -> a
id)) a
x0) r
r0
where
k :: Data d => Qr r (d->b) -> d -> Qr r b
k :: forall d b. Data d => Qr r (d -> b) -> d -> Qr r b
k (Qr r -> r
c) d
x = forall {k} r (a :: k). (r -> r) -> Qr r a
Qr (\r
r -> r -> r
c (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 forall d. Data d => d -> u
f = 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 Int
i forall d. Data d => d -> u
f a
x = case 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 q. g -> Qi q g
z a
x of { Qi Int
_ Maybe u
q -> forall a. HasCallStack => Maybe a -> a
fromJust Maybe u
q }
where
k :: Data d => Qi u (d -> b) -> d -> Qi u b
k :: forall d b. Data d => Qi u (d -> b) -> d -> Qi u b
k (Qi Int
i' Maybe u
q) d
a = forall {k} q (a :: k). Int -> Maybe q -> Qi q a
Qi (Int
i'forall a. Num a => a -> a -> a
+Int
1) (if Int
iforall a. Eq a => a -> a -> Bool
==Int
i' then forall a. a -> Maybe a
Just (forall d. Data d => d -> u
f d
a) else Maybe u
q)
z :: g -> Qi q g
z :: forall g q. g -> Qi q g
z g
_ = forall {k} q (a :: k). Int -> Maybe q -> Qi q a
Qi Int
0 forall a. Maybe a
Nothing
gmapM :: forall m. Monad m => (forall d. Data d => d -> m d) -> a -> m a
gmapM forall d. Data d => d -> m d
f = 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 (m :: * -> *) a. Monad m => a -> m a
return
where
k :: Data d => m (d -> b) -> d -> m b
k :: forall d b. Data d => m (d -> b) -> d -> m b
k m (d -> b)
c d
x = do d -> b
c' <- m (d -> b)
c
d
x' <- forall d. Data d => d -> m d
f d
x
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 forall d. Data d => d -> m d
f a
x = forall (m :: * -> *) x. Mp m x -> m (x, Bool)
unMp (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) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(a
x',Bool
b) ->
if Bool
b then forall (m :: * -> *) a. Monad m => a -> m a
return a
x' else forall (m :: * -> *) a. MonadPlus m => m a
mzero
where
z :: g -> Mp m g
z :: forall g. g -> Mp m g
z g
g = forall (m :: * -> *) x. m (x, Bool) -> Mp m x
Mp (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 :: forall d b. Data d => Mp m (d -> b) -> d -> Mp m b
k (Mp m (d -> b, Bool)
c) d
y
= forall (m :: * -> *) x. m (x, Bool) -> Mp m x
Mp ( m (d -> b, Bool)
c forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(d -> b
h, Bool
b) ->
(forall d. Data d => d -> m d
f d
y forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \d
y' -> forall (m :: * -> *) a. Monad m => a -> m a
return (d -> b
h d
y', Bool
True))
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` 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 forall d. Data d => d -> m d
f a
x = forall (m :: * -> *) x. Mp m x -> m (x, Bool)
unMp (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) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(a
x',Bool
b) ->
if Bool
b then forall (m :: * -> *) a. Monad m => a -> m a
return a
x' else forall (m :: * -> *) a. MonadPlus m => m a
mzero
where
z :: g -> Mp m g
z :: forall g. g -> Mp m g
z g
g = forall (m :: * -> *) x. m (x, Bool) -> Mp m x
Mp (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 :: forall d b. Data d => Mp m (d -> b) -> d -> Mp m b
k (Mp m (d -> b, Bool)
c) d
y
= forall (m :: * -> *) x. m (x, Bool) -> Mp m x
Mp ( m (d -> b, Bool)
c forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(d -> b
h,Bool
b) -> if Bool
b
then forall (m :: * -> *) a. Monad m => a -> m a
return (d -> b
h d
y, Bool
b)
else (forall d. Data d => d -> m d
f d
y forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \d
y' -> forall (m :: * -> *) a. Monad m => a -> m a
return (d -> b
h d
y',Bool
True))
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` 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 { forall {k} r (a :: k). Qr r a -> r -> r
unQr :: r -> r }
newtype Mp m x = Mp { forall (m :: * -> *) x. Mp m x -> m (x, Bool)
unMp :: m (x, Bool) }
fromConstr :: Data a => Constr -> a
fromConstr :: forall a. Data a => Constr -> a
fromConstr = forall a. Data a => (forall d. Data d => d) -> Constr -> a
fromConstrB (forall a. [Char] -> a
errorWithoutStackTrace [Char]
"Data.Data.fromConstr")
fromConstrB :: Data a
=> (forall d. Data d => d)
-> Constr
-> a
fromConstrB :: forall a. Data a => (forall d. Data d => d) -> Constr -> a
fromConstrB forall d. Data d => d
f = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 a. a -> Identity a
z
where
k :: forall b r. Data b => Identity (b -> r) -> Identity r
k :: forall b r. Data b => Identity (b -> r) -> Identity r
k Identity (b -> r)
c = forall a. a -> Identity a
Identity (forall a. Identity a -> a
runIdentity Identity (b -> r)
c forall d. Data d => d
f)
z :: forall r. r -> Identity r
z :: forall a. a -> Identity a
z = forall a. a -> Identity a
Identity
fromConstrM :: forall m a. (Monad m, Data a)
=> (forall d. Data d => m d)
-> Constr
-> m a
fromConstrM :: forall (m :: * -> *) a.
(Monad m, Data a) =>
(forall d. Data d => m d) -> Constr -> m a
fromConstrM forall d. Data d => m d
f = 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 :: forall b r. Data b => m (b -> r) -> m r
k m (b -> r)
c = do { b -> r
c' <- m (b -> r)
c; b
b <- forall d. Data d => m d
f; forall (m :: * -> *) a. Monad m => a -> m a
return (b -> r
c' b
b) }
z :: forall r. r -> m r
z :: forall r. r -> m r
z = forall (m :: * -> *) a. Monad m => a -> m a
return
data DataType = DataType
{ DataType -> [Char]
tycon :: String
, DataType -> DataRep
datarep :: DataRep
}
deriving Int -> DataType -> ShowS
[DataType] -> ShowS
DataType -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [DataType] -> ShowS
$cshowList :: [DataType] -> ShowS
show :: DataType -> [Char]
$cshow :: DataType -> [Char]
showsPrec :: Int -> DataType -> ShowS
$cshowsPrec :: Int -> DataType -> ShowS
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
Constr
c == :: Constr -> Constr -> Bool
== Constr
c' = Constr -> ConstrRep
constrRep Constr
c forall a. Eq a => a -> a -> Bool
== Constr -> ConstrRep
constrRep Constr
c'
data DataRep = AlgRep [Constr]
| IntRep
| FloatRep
| CharRep
| NoRep
deriving ( DataRep -> DataRep -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DataRep -> DataRep -> Bool
$c/= :: DataRep -> DataRep -> Bool
== :: DataRep -> DataRep -> Bool
$c== :: DataRep -> DataRep -> Bool
Eq
, Int -> DataRep -> ShowS
[DataRep] -> ShowS
DataRep -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [DataRep] -> ShowS
$cshowList :: [DataRep] -> ShowS
show :: DataRep -> [Char]
$cshow :: DataRep -> [Char]
showsPrec :: Int -> DataRep -> ShowS
$cshowsPrec :: Int -> DataRep -> ShowS
Show
)
data ConstrRep = AlgConstr ConIndex
| IntConstr Integer
| FloatConstr Rational
| CharConstr Char
deriving ( ConstrRep -> ConstrRep -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConstrRep -> ConstrRep -> Bool
$c/= :: ConstrRep -> ConstrRep -> Bool
== :: ConstrRep -> ConstrRep -> Bool
$c== :: ConstrRep -> ConstrRep -> Bool
Eq
, Int -> ConstrRep -> ShowS
[ConstrRep] -> ShowS
ConstrRep -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ConstrRep] -> ShowS
$cshowList :: [ConstrRep] -> ShowS
show :: ConstrRep -> [Char]
$cshow :: ConstrRep -> [Char]
showsPrec :: Int -> ConstrRep -> ShowS
$cshowsPrec :: Int -> ConstrRep -> ShowS
Show
)
type ConIndex = Int
data Fixity = Prefix
| Infix
deriving ( Fixity -> Fixity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Fixity -> Fixity -> Bool
$c/= :: Fixity -> Fixity -> Bool
== :: Fixity -> Fixity -> Bool
$c== :: Fixity -> Fixity -> Bool
Eq
, Int -> Fixity -> ShowS
[Fixity] -> ShowS
Fixity -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Fixity] -> ShowS
$cshowList :: [Fixity] -> ShowS
show :: Fixity -> [Char]
$cshow :: Fixity -> [Char]
showsPrec :: Int -> Fixity -> ShowS
$cshowsPrec :: Int -> Fixity -> ShowS
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 DataType
dt ConstrRep
cr =
case (DataType -> DataRep
dataTypeRep DataType
dt, ConstrRep
cr) of
(AlgRep [Constr]
cs, AlgConstr Int
i) -> [Constr]
cs forall a. [a] -> Int -> a
!! (Int
iforall a. Num a => a -> a -> a
-Int
1)
(DataRep
IntRep, IntConstr Integer
i) -> forall a. (Integral a, Show a) => DataType -> a -> Constr
mkIntegralConstr DataType
dt Integer
i
(DataRep
FloatRep, FloatConstr Rational
f) -> forall a. (Real a, Show a) => DataType -> a -> Constr
mkRealConstr DataType
dt Rational
f
(DataRep
CharRep, CharConstr Char
c) -> DataType -> Char -> Constr
mkCharConstr DataType
dt Char
c
(DataRep, ConstrRep)
_ -> forall a. [Char] -> a
errorWithoutStackTrace [Char]
"Data.Data.repConstr: The given ConstrRep does not fit to the given DataType."
mkDataType :: String -> [Constr] -> DataType
mkDataType :: [Char] -> [Constr] -> DataType
mkDataType [Char]
str [Constr]
cs = DataType
{ tycon :: [Char]
tycon = [Char]
str
, datarep :: DataRep
datarep = [Constr] -> DataRep
AlgRep [Constr]
cs
}
mkConstrTag :: DataType -> String -> Int -> [String] -> Fixity -> Constr
mkConstrTag :: DataType -> [Char] -> Int -> [[Char]] -> Fixity -> Constr
mkConstrTag DataType
dt [Char]
str Int
idx [[Char]]
fields Fixity
fix =
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
}
mkConstr :: DataType -> String -> [String] -> Fixity -> Constr
mkConstr :: DataType -> [Char] -> [[Char]] -> Fixity -> Constr
mkConstr DataType
dt [Char]
str [[Char]]
fields Fixity
fix = DataType -> [Char] -> Int -> [[Char]] -> Fixity -> Constr
mkConstrTag DataType
dt [Char]
str Int
idx [[Char]]
fields Fixity
fix
where
idx :: Int
idx = case forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (\Constr
c -> Constr -> [Char]
showConstr Constr
c forall a. Eq a => a -> a -> Bool
== [Char]
str) (DataType -> [Constr]
dataTypeConstrs DataType
dt) of
Just Int
i -> Int
iforall a. Num a => a -> a -> a
+Int
1
Maybe Int
Nothing -> forall a. [Char] -> a
errorWithoutStackTrace forall a b. (a -> b) -> a -> b
$
[Char]
"Data.Data.mkConstr: couldn't find constructor " forall a. [a] -> [a] -> [a]
++ [Char]
str
dataTypeConstrs :: DataType -> [Constr]
dataTypeConstrs :: DataType -> [Constr]
dataTypeConstrs DataType
dt = case DataType -> DataRep
datarep DataType
dt of
(AlgRep [Constr]
cons) -> [Constr]
cons
DataRep
_ -> forall a. [Char] -> a
errorWithoutStackTrace forall a b. (a -> b) -> a -> b
$ [Char]
"Data.Data.dataTypeConstrs is not supported for "
forall a. [a] -> [a] -> [a]
++ DataType -> [Char]
dataTypeName DataType
dt forall a. [a] -> [a] -> [a]
++
[Char]
", 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 DataType
dt [Char]
str =
case DataType -> DataRep
dataTypeRep DataType
dt of
AlgRep [Constr]
cons -> [Constr] -> Maybe Constr
idx [Constr]
cons
DataRep
IntRep -> forall t. Read t => (t -> Constr) -> Maybe Constr
mkReadCon (\Integer
i -> (DataType -> [Char] -> ConstrRep -> Constr
mkPrimCon DataType
dt [Char]
str (Integer -> ConstrRep
IntConstr Integer
i)))
DataRep
FloatRep -> forall t. Read t => (t -> Constr) -> Maybe Constr
mkReadCon Double -> Constr
ffloat
DataRep
CharRep -> forall t. Read t => (t -> Constr) -> Maybe Constr
mkReadCon (\Char
c -> (DataType -> [Char] -> ConstrRep -> Constr
mkPrimCon DataType
dt [Char]
str (Char -> ConstrRep
CharConstr Char
c)))
DataRep
NoRep -> forall a. Maybe a
Nothing
where
mkReadCon :: Read t => (t -> Constr) -> Maybe Constr
mkReadCon :: forall t. Read t => (t -> Constr) -> Maybe Constr
mkReadCon t -> Constr
f = case (forall a. Read a => ReadS a
reads [Char]
str) of
[(t
t,[Char]
"")] -> forall a. a -> Maybe a
Just (t -> Constr
f t
t)
[(t, [Char])]
_ -> forall a. Maybe a
Nothing
idx :: [Constr] -> Maybe Constr
idx :: [Constr] -> Maybe Constr
idx [Constr]
cons = let fit :: [Constr]
fit = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
(==) [Char]
str forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constr -> [Char]
showConstr) [Constr]
cons
in if [Constr]
fit forall a. Eq a => a -> a -> Bool
== []
then forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just (forall a. [a] -> a
head [Constr]
fit)
ffloat :: Double -> Constr
ffloat :: Double -> Constr
ffloat = DataType -> [Char] -> ConstrRep -> Constr
mkPrimCon DataType
dt [Char]
str forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> ConstrRep
FloatConstr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Real a => a -> Rational
toRational
isAlgType :: DataType -> Bool
isAlgType :: DataType -> Bool
isAlgType DataType
dt = case DataType -> DataRep
datarep DataType
dt of
(AlgRep [Constr]
_) -> Bool
True
DataRep
_ -> Bool
False
indexConstr :: DataType -> ConIndex -> Constr
indexConstr :: DataType -> Int -> Constr
indexConstr DataType
dt Int
idx = case DataType -> DataRep
datarep DataType
dt of
(AlgRep [Constr]
cs) -> [Constr]
cs forall a. [a] -> Int -> a
!! (Int
idxforall a. Num a => a -> a -> a
-Int
1)
DataRep
_ -> forall a. [Char] -> a
errorWithoutStackTrace forall a b. (a -> b) -> a -> b
$ [Char]
"Data.Data.indexConstr is not supported for "
forall a. [a] -> [a] -> [a]
++ DataType -> [Char]
dataTypeName DataType
dt forall a. [a] -> [a] -> [a]
++
[Char]
", as it is not an algebraic data type."
constrIndex :: Constr -> ConIndex
constrIndex :: Constr -> Int
constrIndex Constr
con = case Constr -> ConstrRep
constrRep Constr
con of
(AlgConstr Int
idx) -> Int
idx
ConstrRep
_ -> forall a. [Char] -> a
errorWithoutStackTrace forall a b. (a -> b) -> a -> b
$ [Char]
"Data.Data.constrIndex is not supported for "
forall a. [a] -> [a] -> [a]
++ DataType -> [Char]
dataTypeName (Constr -> DataType
constrType Constr
con) forall a. [a] -> [a] -> [a]
++
[Char]
", as it is not an algebraic data type."
maxConstrIndex :: DataType -> ConIndex
maxConstrIndex :: DataType -> Int
maxConstrIndex DataType
dt = case DataType -> DataRep
dataTypeRep DataType
dt of
AlgRep [Constr]
cs -> forall a. [a] -> Int
length [Constr]
cs
DataRep
_ -> forall a. [Char] -> a
errorWithoutStackTrace forall a b. (a -> b) -> a -> b
$ [Char]
"Data.Data.maxConstrIndex is not supported for "
forall a. [a] -> [a] -> [a]
++ DataType -> [Char]
dataTypeName DataType
dt forall a. [a] -> [a] -> [a]
++
[Char]
", 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 DataRep
dr [Char]
str = DataType
{ tycon :: [Char]
tycon = [Char]
str
, datarep :: DataRep
datarep = DataRep
dr
}
mkPrimCon :: DataType -> String -> ConstrRep -> Constr
mkPrimCon :: DataType -> [Char] -> ConstrRep -> Constr
mkPrimCon DataType
dt [Char]
str ConstrRep
cr = Constr
{ datatype :: DataType
datatype = DataType
dt
, conrep :: ConstrRep
conrep = ConstrRep
cr
, constring :: [Char]
constring = [Char]
str
, confields :: [[Char]]
confields = forall a. [Char] -> a
errorWithoutStackTrace [Char]
"Data.Data.confields"
, confixity :: Fixity
confixity = forall a. [Char] -> a
errorWithoutStackTrace [Char]
"Data.Data.confixity"
}
mkIntegralConstr :: (Integral a, Show a) => DataType -> a -> Constr
mkIntegralConstr :: forall a. (Integral a, Show a) => DataType -> a -> Constr
mkIntegralConstr DataType
dt a
i = case DataType -> DataRep
datarep DataType
dt of
DataRep
IntRep -> DataType -> [Char] -> ConstrRep -> Constr
mkPrimCon DataType
dt (forall a. Show a => a -> [Char]
show a
i) (Integer -> ConstrRep
IntConstr (forall a. Integral a => a -> Integer
toInteger a
i))
DataRep
_ -> forall a. [Char] -> a
errorWithoutStackTrace forall a b. (a -> b) -> a -> b
$ [Char]
"Data.Data.mkIntegralConstr is not supported for "
forall a. [a] -> [a] -> [a]
++ DataType -> [Char]
dataTypeName DataType
dt forall a. [a] -> [a] -> [a]
++
[Char]
", as it is not an Integral data type."
mkRealConstr :: (Real a, Show a) => DataType -> a -> Constr
mkRealConstr :: forall a. (Real a, Show a) => DataType -> a -> Constr
mkRealConstr DataType
dt a
f = case DataType -> DataRep
datarep DataType
dt of
DataRep
FloatRep -> DataType -> [Char] -> ConstrRep -> Constr
mkPrimCon DataType
dt (forall a. Show a => a -> [Char]
show a
f) (Rational -> ConstrRep
FloatConstr (forall a. Real a => a -> Rational
toRational a
f))
DataRep
_ -> forall a. [Char] -> a
errorWithoutStackTrace forall a b. (a -> b) -> a -> b
$ [Char]
"Data.Data.mkRealConstr is not supported for "
forall a. [a] -> [a] -> [a]
++ DataType -> [Char]
dataTypeName DataType
dt forall a. [a] -> [a] -> [a]
++
[Char]
", as it is not a Real data type."
mkCharConstr :: DataType -> Char -> Constr
mkCharConstr :: DataType -> Char -> Constr
mkCharConstr DataType
dt Char
c = case DataType -> DataRep
datarep DataType
dt of
DataRep
CharRep -> DataType -> [Char] -> ConstrRep -> Constr
mkPrimCon DataType
dt (forall a. Show a => a -> [Char]
show Char
c) (Char -> ConstrRep
CharConstr Char
c)
DataRep
_ -> forall a. [Char] -> a
errorWithoutStackTrace forall a b. (a -> b) -> a -> b
$ [Char]
"Data.Data.mkCharConstr is not supported for "
forall a. [a] -> [a] -> [a]
++ DataType -> [Char]
dataTypeName DataType
dt forall a. [a] -> [a] -> [a]
++
[Char]
", as it is not an Char data type."
mkNoRepType :: String -> DataType
mkNoRepType :: [Char] -> DataType
mkNoRepType [Char]
str = DataType
{ tycon :: [Char]
tycon = [Char]
str
, datarep :: DataRep
datarep = DataRep
NoRep
}
isNorepType :: DataType -> Bool
isNorepType :: DataType -> Bool
isNorepType DataType
dt = case DataType -> DataRep
datarep DataType
dt of
DataRep
NoRep -> Bool
True
DataRep
_ -> Bool
False
tyconUQname :: String -> String
tyconUQname :: ShowS
tyconUQname [Char]
x = let x' :: [Char]
x' = forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> a -> Bool
(==) Char
'.') [Char]
x
in if [Char]
x' forall a. Eq a => a -> a -> Bool
== [] then [Char]
x else ShowS
tyconUQname (forall a. [a] -> [a]
tail [Char]
x')
tyconModule :: String -> String
tyconModule :: ShowS
tyconModule [Char]
x = let ([Char]
a,[Char]
b) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
(==) Char
'.') [Char]
x
in if [Char]
b forall a. Eq a => a -> a -> Bool
== [Char]
""
then [Char]
b
else [Char]
a forall a. [a] -> [a] -> [a]
++ ShowS
tyconModule' (forall a. [a] -> [a]
tail [Char]
b)
where
tyconModule' :: ShowS
tyconModule' [Char]
y = let y' :: [Char]
y' = ShowS
tyconModule [Char]
y
in if [Char]
y' forall a. Eq a => a -> a -> Bool
== [Char]
"" then [Char]
"" else (Char
'.'forall a. a -> [a] -> [a]
:[Char]
y')
deriving instance Data Bool
charType :: DataType
charType :: DataType
charType = [Char] -> DataType
mkCharType [Char]
"Prelude.Char"
instance Data Char where
toConstr :: Char -> Constr
toConstr Char
x = DataType -> Char -> Constr
mkCharConstr DataType
charType Char
x
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Char
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
z Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
(CharConstr Char
x) -> forall r. r -> c r
z Char
x
ConstrRep
_ -> forall a. [Char] -> a
errorWithoutStackTrace forall a b. (a -> b) -> a -> b
$ [Char]
"Data.Data.gunfold: Constructor " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Constr
c
forall a. [a] -> [a] -> [a]
++ [Char]
" is not of type Char."
dataTypeOf :: Char -> DataType
dataTypeOf Char
_ = DataType
charType
floatType :: DataType
floatType :: DataType
floatType = [Char] -> DataType
mkFloatType [Char]
"Prelude.Float"
instance Data Float where
toConstr :: Float -> Constr
toConstr = forall a. (Real a, Show a) => DataType -> a -> Constr
mkRealConstr DataType
floatType
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Float
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
z Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
(FloatConstr Rational
x) -> forall r. r -> c r
z (forall a b. (Real a, Fractional b) => a -> b
realToFrac Rational
x)
ConstrRep
_ -> forall a. [Char] -> a
errorWithoutStackTrace forall a b. (a -> b) -> a -> b
$ [Char]
"Data.Data.gunfold: Constructor " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Constr
c
forall a. [a] -> [a] -> [a]
++ [Char]
" is not of type Float."
dataTypeOf :: Float -> DataType
dataTypeOf Float
_ = DataType
floatType
doubleType :: DataType
doubleType :: DataType
doubleType = [Char] -> DataType
mkFloatType [Char]
"Prelude.Double"
instance Data Double where
toConstr :: Double -> Constr
toConstr = forall a. (Real a, Show a) => DataType -> a -> Constr
mkRealConstr DataType
doubleType
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Double
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
z Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
(FloatConstr Rational
x) -> forall r. r -> c r
z (forall a b. (Real a, Fractional b) => a -> b
realToFrac Rational
x)
ConstrRep
_ -> forall a. [Char] -> a
errorWithoutStackTrace forall a b. (a -> b) -> a -> b
$ [Char]
"Data.Data.gunfold: Constructor " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Constr
c
forall a. [a] -> [a] -> [a]
++ [Char]
" is not of type Double."
dataTypeOf :: Double -> DataType
dataTypeOf Double
_ = DataType
doubleType
intType :: DataType
intType :: DataType
intType = [Char] -> DataType
mkIntType [Char]
"Prelude.Int"
instance Data Int where
toConstr :: Int -> Constr
toConstr Int
x = forall a. (Integral a, Show a) => DataType -> a -> Constr
mkIntegralConstr DataType
intType Int
x
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Int
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
z Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
(IntConstr Integer
x) -> forall r. r -> c r
z (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)
ConstrRep
_ -> forall a. [Char] -> a
errorWithoutStackTrace forall a b. (a -> b) -> a -> b
$ [Char]
"Data.Data.gunfold: Constructor " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Constr
c
forall a. [a] -> [a] -> [a]
++ [Char]
" is not of type Int."
dataTypeOf :: Int -> DataType
dataTypeOf Int
_ = DataType
intType
integerType :: DataType
integerType :: DataType
integerType = [Char] -> DataType
mkIntType [Char]
"Prelude.Integer"
instance Data Integer where
toConstr :: Integer -> Constr
toConstr = forall a. (Integral a, Show a) => DataType -> a -> Constr
mkIntegralConstr DataType
integerType
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Integer
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
z Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
(IntConstr Integer
x) -> forall r. r -> c r
z Integer
x
ConstrRep
_ -> forall a. [Char] -> a
errorWithoutStackTrace forall a b. (a -> b) -> a -> b
$ [Char]
"Data.Data.gunfold: Constructor " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Constr
c
forall a. [a] -> [a] -> [a]
++ [Char]
" is not of type Integer."
dataTypeOf :: Integer -> DataType
dataTypeOf Integer
_ = DataType
integerType
naturalType :: DataType
naturalType :: DataType
naturalType = [Char] -> DataType
mkIntType [Char]
"Numeric.Natural.Natural"
instance Data Natural where
toConstr :: Natural -> Constr
toConstr Natural
x = forall a. (Integral a, Show a) => DataType -> a -> Constr
mkIntegralConstr DataType
naturalType Natural
x
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Natural
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
z Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
(IntConstr Integer
x) -> forall r. r -> c r
z (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)
ConstrRep
_ -> forall a. [Char] -> a
errorWithoutStackTrace forall a b. (a -> b) -> a -> b
$ [Char]
"Data.Data.gunfold: Constructor " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Constr
c
forall a. [a] -> [a] -> [a]
++ [Char]
" is not of type Natural"
dataTypeOf :: Natural -> DataType
dataTypeOf Natural
_ = DataType
naturalType
int8Type :: DataType
int8Type :: DataType
int8Type = [Char] -> DataType
mkIntType [Char]
"Data.Int.Int8"
instance Data Int8 where
toConstr :: Int8 -> Constr
toConstr Int8
x = forall a. (Integral a, Show a) => DataType -> a -> Constr
mkIntegralConstr DataType
int8Type Int8
x
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Int8
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
z Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
(IntConstr Integer
x) -> forall r. r -> c r
z (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)
ConstrRep
_ -> forall a. [Char] -> a
errorWithoutStackTrace forall a b. (a -> b) -> a -> b
$ [Char]
"Data.Data.gunfold: Constructor " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Constr
c
forall a. [a] -> [a] -> [a]
++ [Char]
" is not of type Int8."
dataTypeOf :: Int8 -> DataType
dataTypeOf Int8
_ = DataType
int8Type
int16Type :: DataType
int16Type :: DataType
int16Type = [Char] -> DataType
mkIntType [Char]
"Data.Int.Int16"
instance Data Int16 where
toConstr :: Int16 -> Constr
toConstr Int16
x = forall a. (Integral a, Show a) => DataType -> a -> Constr
mkIntegralConstr DataType
int16Type Int16
x
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Int16
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
z Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
(IntConstr Integer
x) -> forall r. r -> c r
z (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)
ConstrRep
_ -> forall a. [Char] -> a
errorWithoutStackTrace forall a b. (a -> b) -> a -> b
$ [Char]
"Data.Data.gunfold: Constructor " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Constr
c
forall a. [a] -> [a] -> [a]
++ [Char]
" is not of type Int16."
dataTypeOf :: Int16 -> DataType
dataTypeOf Int16
_ = DataType
int16Type
int32Type :: DataType
int32Type :: DataType
int32Type = [Char] -> DataType
mkIntType [Char]
"Data.Int.Int32"
instance Data Int32 where
toConstr :: Int32 -> Constr
toConstr Int32
x = forall a. (Integral a, Show a) => DataType -> a -> Constr
mkIntegralConstr DataType
int32Type Int32
x
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Int32
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
z Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
(IntConstr Integer
x) -> forall r. r -> c r
z (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)
ConstrRep
_ -> forall a. [Char] -> a
errorWithoutStackTrace forall a b. (a -> b) -> a -> b
$ [Char]
"Data.Data.gunfold: Constructor " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Constr
c
forall a. [a] -> [a] -> [a]
++ [Char]
" is not of type Int32."
dataTypeOf :: Int32 -> DataType
dataTypeOf Int32
_ = DataType
int32Type
int64Type :: DataType
int64Type :: DataType
int64Type = [Char] -> DataType
mkIntType [Char]
"Data.Int.Int64"
instance Data Int64 where
toConstr :: Int64 -> Constr
toConstr Int64
x = forall a. (Integral a, Show a) => DataType -> a -> Constr
mkIntegralConstr DataType
int64Type Int64
x
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Int64
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
z Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
(IntConstr Integer
x) -> forall r. r -> c r
z (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)
ConstrRep
_ -> forall a. [Char] -> a
errorWithoutStackTrace forall a b. (a -> b) -> a -> b
$ [Char]
"Data.Data.gunfold: Constructor " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Constr
c
forall a. [a] -> [a] -> [a]
++ [Char]
" is not of type Int64."
dataTypeOf :: Int64 -> DataType
dataTypeOf Int64
_ = DataType
int64Type
wordType :: DataType
wordType :: DataType
wordType = [Char] -> DataType
mkIntType [Char]
"Data.Word.Word"
instance Data Word where
toConstr :: Word -> Constr
toConstr Word
x = forall a. (Integral a, Show a) => DataType -> a -> Constr
mkIntegralConstr DataType
wordType Word
x
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Word
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
z Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
(IntConstr Integer
x) -> forall r. r -> c r
z (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)
ConstrRep
_ -> forall a. [Char] -> a
errorWithoutStackTrace forall a b. (a -> b) -> a -> b
$ [Char]
"Data.Data.gunfold: Constructor " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Constr
c
forall a. [a] -> [a] -> [a]
++ [Char]
" is not of type Word"
dataTypeOf :: Word -> DataType
dataTypeOf Word
_ = DataType
wordType
word8Type :: DataType
word8Type :: DataType
word8Type = [Char] -> DataType
mkIntType [Char]
"Data.Word.Word8"
instance Data Word8 where
toConstr :: Word8 -> Constr
toConstr Word8
x = forall a. (Integral a, Show a) => DataType -> a -> Constr
mkIntegralConstr DataType
word8Type Word8
x
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Word8
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
z Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
(IntConstr Integer
x) -> forall r. r -> c r
z (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)
ConstrRep
_ -> forall a. [Char] -> a
errorWithoutStackTrace forall a b. (a -> b) -> a -> b
$ [Char]
"Data.Data.gunfold: Constructor " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Constr
c
forall a. [a] -> [a] -> [a]
++ [Char]
" is not of type Word8."
dataTypeOf :: Word8 -> DataType
dataTypeOf Word8
_ = DataType
word8Type
word16Type :: DataType
word16Type :: DataType
word16Type = [Char] -> DataType
mkIntType [Char]
"Data.Word.Word16"
instance Data Word16 where
toConstr :: Word16 -> Constr
toConstr Word16
x = forall a. (Integral a, Show a) => DataType -> a -> Constr
mkIntegralConstr DataType
word16Type Word16
x
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Word16
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
z Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
(IntConstr Integer
x) -> forall r. r -> c r
z (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)
ConstrRep
_ -> forall a. [Char] -> a
errorWithoutStackTrace forall a b. (a -> b) -> a -> b
$ [Char]
"Data.Data.gunfold: Constructor " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Constr
c
forall a. [a] -> [a] -> [a]
++ [Char]
" is not of type Word16."
dataTypeOf :: Word16 -> DataType
dataTypeOf Word16
_ = DataType
word16Type
word32Type :: DataType
word32Type :: DataType
word32Type = [Char] -> DataType
mkIntType [Char]
"Data.Word.Word32"
instance Data Word32 where
toConstr :: Word32 -> Constr
toConstr Word32
x = forall a. (Integral a, Show a) => DataType -> a -> Constr
mkIntegralConstr DataType
word32Type Word32
x
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Word32
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
z Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
(IntConstr Integer
x) -> forall r. r -> c r
z (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)
ConstrRep
_ -> forall a. [Char] -> a
errorWithoutStackTrace forall a b. (a -> b) -> a -> b
$ [Char]
"Data.Data.gunfold: Constructor " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Constr
c
forall a. [a] -> [a] -> [a]
++ [Char]
" is not of type Word32."
dataTypeOf :: Word32 -> DataType
dataTypeOf Word32
_ = DataType
word32Type
word64Type :: DataType
word64Type :: DataType
word64Type = [Char] -> DataType
mkIntType [Char]
"Data.Word.Word64"
instance Data Word64 where
toConstr :: Word64 -> Constr
toConstr Word64
x = forall a. (Integral a, Show a) => DataType -> a -> Constr
mkIntegralConstr DataType
word64Type Word64
x
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Word64
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
z Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
(IntConstr Integer
x) -> forall r. r -> c r
z (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)
ConstrRep
_ -> forall a. [Char] -> a
errorWithoutStackTrace forall a b. (a -> b) -> a -> b
$ [Char]
"Data.Data.gunfold: Constructor " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Constr
c
forall a. [a] -> [a] -> [a]
++ [Char]
" is not of type Word64."
dataTypeOf :: Word64 -> DataType
dataTypeOf Word64
_ = DataType
word64Type
ratioConstr :: Constr
ratioConstr :: Constr
ratioConstr = DataType -> [Char] -> [[Char]] -> Fixity -> Constr
mkConstr DataType
ratioDataType [Char]
":%" [] Fixity
Infix
ratioDataType :: DataType
ratioDataType :: DataType
ratioDataType = [Char] -> [Constr] -> DataType
mkDataType [Char]
"GHC.Real.Ratio" [Constr
ratioConstr]
instance (Data a, Integral a) => Data (Ratio a) where
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ratio a -> c (Ratio a)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
k forall g. g -> c g
z (a
a :% a
b) = forall g. g -> c g
z forall a. Integral a => a -> a -> Ratio a
(%) forall d b. Data d => c (d -> b) -> d -> c b
`k` a
a forall d b. Data d => c (d -> b) -> d -> c b
`k` a
b
toConstr :: Ratio a -> Constr
toConstr Ratio a
_ = Constr
ratioConstr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Ratio a)
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c | Constr -> Int
constrIndex Constr
c forall a. Eq a => a -> a -> Bool
== Int
1 = forall b r. Data b => c (b -> r) -> c r
k (forall b r. Data b => c (b -> r) -> c r
k (forall r. r -> c r
z forall a. Integral a => a -> a -> Ratio a
(%)))
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
_ Constr
_ = forall a. [Char] -> a
errorWithoutStackTrace [Char]
"Data.Data.gunfold(Ratio)"
dataTypeOf :: Ratio a -> DataType
dataTypeOf Ratio a
_ = DataType
ratioDataType
nilConstr :: Constr
nilConstr :: Constr
nilConstr = DataType -> [Char] -> [[Char]] -> Fixity -> Constr
mkConstr DataType
listDataType [Char]
"[]" [] Fixity
Prefix
consConstr :: Constr
consConstr :: Constr
consConstr = DataType -> [Char] -> [[Char]] -> Fixity -> Constr
mkConstr DataType
listDataType [Char]
"(:)" [] Fixity
Infix
listDataType :: DataType
listDataType :: DataType
listDataType = [Char] -> [Constr] -> DataType
mkDataType [Char]
"Prelude.[]" [Constr
nilConstr,Constr
consConstr]
instance Data a => Data [a] where
gfoldl :: forall (c :: * -> *).
(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 => c (d -> b) -> d -> c b
_ forall g. g -> c g
z [] = forall g. g -> c g
z []
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z (a
x:[a]
xs) = forall g. g -> c g
z (:) forall d b. Data d => c (d -> b) -> d -> c b
`f` a
x forall d b. Data d => c (d -> b) -> d -> c b
`f` [a]
xs
toConstr :: [a] -> Constr
toConstr [] = Constr
nilConstr
toConstr (a
_:[a]
_) = Constr
consConstr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c [a]
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c = case Constr -> Int
constrIndex Constr
c of
Int
1 -> forall r. r -> c r
z []
Int
2 -> forall b r. Data b => c (b -> r) -> c r
k (forall b r. Data b => c (b -> r) -> c r
k (forall r. r -> c r
z (:)))
Int
_ -> forall a. [Char] -> a
errorWithoutStackTrace [Char]
"Data.Data.gunfold(List)"
dataTypeOf :: [a] -> DataType
dataTypeOf [a]
_ = DataType
listDataType
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c [a])
dataCast1 forall d. Data d => c (t d)
f = 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 forall d. Data d => c (t d)
f
gmapT :: (forall b. Data b => b -> b) -> [a] -> [a]
gmapT forall b. Data b => b -> b
_ [] = []
gmapT forall b. Data b => b -> b
f (a
x:[a]
xs) = (forall b. Data b => b -> b
f a
xforall a. a -> [a] -> [a]
:forall b. Data b => b -> b
f [a]
xs)
gmapQ :: forall u. (forall d. Data d => d -> u) -> [a] -> [u]
gmapQ forall d. Data d => d -> u
_ [] = []
gmapQ forall d. Data d => d -> u
f (a
x:[a]
xs) = [forall d. Data d => d -> u
f a
x,forall d. Data d => d -> u
f [a]
xs]
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> [a] -> m [a]
gmapM forall d. Data d => d -> m d
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return []
gmapM forall d. Data d => d -> m d
f (a
x:[a]
xs) = forall d. Data d => d -> m d
f a
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x' -> forall d. Data d => d -> m d
f [a]
xs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[a]
xs' -> forall (m :: * -> *) a. Monad m => a -> m a
return (a
x'forall a. a -> [a] -> [a]
:[a]
xs')
deriving instance (Typeable (a :: Type -> Type -> Type), Typeable b, Typeable c,
Data (a b c))
=> Data (WrappedArrow a b c)
deriving instance (Typeable (m :: Type -> Type), Typeable a, Data (m a))
=> Data (WrappedMonad m a)
deriving instance Data a => Data (ZipList a)
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 (Solo a)
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 Ptr a
_ = forall a. [Char] -> a
errorWithoutStackTrace [Char]
"Data.Data.toConstr(Ptr)"
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Ptr a)
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
_ = forall a. [Char] -> a
errorWithoutStackTrace [Char]
"Data.Data.gunfold(Ptr)"
dataTypeOf :: Ptr a -> DataType
dataTypeOf Ptr a
_ = [Char] -> DataType
mkNoRepType [Char]
"GHC.Ptr.Ptr"
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Ptr a))
dataCast1 forall d. Data d => c (t d)
x = 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 forall d. Data d => c (t d)
x
instance Data a => Data (ForeignPtr a) where
toConstr :: ForeignPtr a -> Constr
toConstr ForeignPtr a
_ = forall a. [Char] -> a
errorWithoutStackTrace [Char]
"Data.Data.toConstr(ForeignPtr)"
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ForeignPtr a)
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
_ = forall a. [Char] -> a
errorWithoutStackTrace [Char]
"Data.Data.gunfold(ForeignPtr)"
dataTypeOf :: ForeignPtr a -> DataType
dataTypeOf ForeignPtr a
_ = [Char] -> DataType
mkNoRepType [Char]
"GHC.ForeignPtr.ForeignPtr"
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (ForeignPtr a))
dataCast1 forall d. Data d => c (t d)
x = 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 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 (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Array a b -> c (Array a b)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z Array a b
a = forall g. g -> c g
z (forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (forall i e. Array i e -> (i, i)
bounds Array a b
a)) forall d b. Data d => c (d -> b) -> d -> c b
`f` (forall i e. Array i e -> [e]
elems Array a b
a)
toConstr :: Array a b -> Constr
toConstr Array a b
_ = forall a. [Char] -> a
errorWithoutStackTrace [Char]
"Data.Data.toConstr(Array)"
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Array a b)
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
_ = forall a. [Char] -> a
errorWithoutStackTrace [Char]
"Data.Data.gunfold(Array)"
dataTypeOf :: Array a b -> DataType
dataTypeOf Array a b
_ = [Char] -> DataType
mkNoRepType [Char]
"Data.Array.Array"
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Array a b))
dataCast2 forall d e. (Data d, Data e) => c (t d e)
x = 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 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)