{-# LANGUAGE UndecidableInstances, Rank2Types,
CPP, KindSignatures, MultiParamTypeClasses, EmptyDataDecls #-}
module Data.Generics.SYB.WithClass.Basics (
module Data.Typeable,
module Data.Generics.SYB.WithClass.Context,
module Data.Generics.SYB.WithClass.Basics
) where
#if MIN_VERSION_base(4,7,0)
import Data.Typeable hiding (Proxy)
#else
import Data.Typeable
#endif
import Data.Generics.SYB.WithClass.Context
#ifdef __HADDOCK__
data Proxy
#else
data Proxy (a :: * -> *)
#endif
class (Typeable a, Sat (ctx a)) => Data ctx a
where
gfoldl :: Proxy ctx
-> (forall b c. Data ctx b => w (b -> c) -> b -> w c)
-> (forall g. g -> w g)
-> a -> w a
gfoldl _ _ z :: forall g. g -> w g
z = a -> w a
forall g. g -> w g
z
gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c a
toConstr :: Proxy ctx -> a -> Constr
dataTypeOf :: Proxy ctx -> a -> DataType
gunfold _ _ _ _ = c a
forall a. HasCallStack => a
undefined
dataTypeOf _ _ = DataType
forall a. HasCallStack => a
undefined
#if MIN_VERSION_base(4,11,0)
dataCast1 :: Typeable t
#else
dataCast1 :: Typeable1 t
#endif
=> Proxy ctx
-> (forall b. Data ctx b => w (t b))
-> Maybe (w a)
dataCast1 _ _ = Maybe (w a)
forall a. Maybe a
Nothing
#if MIN_VERSION_base(4,11,0)
dataCast2 :: Typeable t
#else
dataCast2 :: Typeable2 t
#endif
=> Proxy ctx
-> (forall b c. (Data ctx b, Data ctx c) => w (t b c))
-> Maybe (w a)
dataCast2 _ _ = Maybe (w a)
forall a. Maybe a
Nothing
type GenericT ctx = forall a. Data ctx a => a -> a
gmapT :: Proxy ctx -> GenericT ctx -> GenericT ctx
gmapT :: Proxy ctx -> GenericT ctx -> GenericT ctx
gmapT ctx :: Proxy ctx
ctx f :: GenericT ctx
f x :: a
x = ID a -> a
forall x. ID x -> x
unID (Proxy ctx
-> (forall b c. Data ctx b => ID (b -> c) -> b -> ID c)
-> (forall g. g -> ID g)
-> a
-> ID a
forall (ctx :: * -> *) a (w :: * -> *).
Data ctx a =>
Proxy ctx
-> (forall b c. Data ctx b => w (b -> c) -> b -> w c)
-> (forall g. g -> w g)
-> a
-> w a
gfoldl Proxy ctx
ctx forall b c. Data ctx b => ID (b -> c) -> b -> ID c
k forall g. g -> ID g
ID a
x)
where
k :: ID (t -> x) -> t -> ID x
k (ID g :: t -> x
g) y :: t
y = x -> ID x
forall g. g -> ID g
ID (t -> x
g (t -> t
GenericT ctx
f t
y))
newtype ID x = ID { ID x -> x
unID :: x }
type GenericM m ctx = forall a. Data ctx a => a -> m a
gmapM :: Monad m => Proxy ctx -> GenericM m ctx -> GenericM m ctx
gmapM :: Proxy ctx -> GenericM m ctx -> GenericM m ctx
gmapM ctx :: Proxy ctx
ctx f :: GenericM m ctx
f = Proxy ctx
-> (forall b c. Data ctx b => m (b -> c) -> b -> m c)
-> (forall g. g -> m g)
-> a
-> m a
forall (ctx :: * -> *) a (w :: * -> *).
Data ctx a =>
Proxy ctx
-> (forall b c. Data ctx b => w (b -> c) -> b -> w c)
-> (forall g. g -> w g)
-> a
-> w a
gfoldl Proxy ctx
ctx forall b c. Data ctx b => m (b -> c) -> b -> m c
k forall g. g -> m g
forall (m :: * -> *) a. Monad m => a -> m a
return
where k :: m (t -> b) -> t -> m b
k c :: m (t -> b)
c x :: t
x = do t -> b
c' <- m (t -> b)
c
t
x' <- t -> m t
GenericM m ctx
f t
x
b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (t -> b
c' t
x')
type GenericQ ctx r = forall a. Data ctx a => a -> r
gmapQ :: Proxy ctx -> GenericQ ctx r -> GenericQ ctx [r]
gmapQ :: Proxy ctx -> GenericQ ctx r -> GenericQ ctx [r]
gmapQ ctx :: Proxy ctx
ctx f :: GenericQ ctx r
f = Proxy ctx -> (r -> [r] -> [r]) -> [r] -> GenericQ ctx r -> a -> [r]
forall (ctx :: * -> *) a r' r.
Data ctx a =>
Proxy ctx -> (r' -> r -> r) -> r -> GenericQ ctx r' -> a -> r
gmapQr Proxy ctx
ctx (:) [] GenericQ ctx r
f
gmapQr :: Data ctx a
=> Proxy ctx
-> (r' -> r -> r)
-> r
-> GenericQ ctx r'
-> a
-> r
gmapQr :: Proxy ctx -> (r' -> r -> r) -> r -> GenericQ ctx r' -> a -> r
gmapQr ctx :: Proxy ctx
ctx o :: r' -> r -> r
o r :: r
r f :: GenericQ ctx r'
f x :: a
x = Qr r a -> r -> r
forall r a. Qr r a -> r -> r
unQr (Proxy ctx
-> (forall b c. Data ctx b => Qr r (b -> c) -> b -> Qr r c)
-> (forall g. g -> Qr r g)
-> a
-> Qr r a
forall (ctx :: * -> *) a (w :: * -> *).
Data ctx a =>
Proxy ctx
-> (forall b c. Data ctx b => w (b -> c) -> b -> w c)
-> (forall g. g -> w g)
-> a
-> w a
gfoldl Proxy ctx
ctx forall b c. Data ctx b => Qr r (b -> c) -> b -> Qr r c
forall a a a. Data ctx a => Qr r a -> a -> Qr r a
k (Qr r g -> g -> Qr r g
forall a b. a -> b -> a
const ((r -> r) -> Qr r g
forall r a. (r -> r) -> Qr r a
Qr r -> r
forall a. a -> a
id)) a
x) r
r
where
k :: Qr r a -> a -> Qr r a
k (Qr g :: r -> r
g) y :: a
y = (r -> r) -> Qr r a
forall r a. (r -> r) -> Qr r a
Qr (\s :: r
s -> r -> r
g (a -> r'
GenericQ ctx r'
f a
y r' -> r -> r
`o` r
s))
newtype Qr r a = Qr { Qr r a -> r -> r
unQr :: r -> r }
fromConstr :: Data ctx a => Proxy ctx -> Constr -> a
fromConstr :: Proxy ctx -> Constr -> a
fromConstr ctx :: Proxy ctx
ctx = Proxy ctx -> (forall b. Data ctx b => b) -> Constr -> a
forall (ctx :: * -> *) a.
Data ctx a =>
Proxy ctx -> (forall b. Data ctx b => b) -> Constr -> a
fromConstrB Proxy ctx
ctx forall b. Data ctx b => b
forall a. HasCallStack => a
undefined
fromConstrB :: Data ctx a
=> Proxy ctx
-> (forall b. Data ctx b => b)
-> Constr
-> a
fromConstrB :: Proxy ctx -> (forall b. Data ctx b => b) -> Constr -> a
fromConstrB ctx :: Proxy ctx
ctx f :: forall b. Data ctx b => b
f = ID a -> a
forall x. ID x -> x
unID (ID a -> a) -> (Constr -> ID a) -> Constr -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy ctx
-> (forall b r. Data ctx b => ID (b -> r) -> ID r)
-> (forall g. g -> ID g)
-> Constr
-> ID a
forall (ctx :: * -> *) a (c :: * -> *).
Data ctx a =>
Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c a
gunfold Proxy ctx
ctx forall b r. Data ctx b => ID (b -> r) -> ID r
k forall g. g -> ID g
z
where
k :: ID (t -> x) -> ID x
k c :: ID (t -> x)
c = x -> ID x
forall g. g -> ID g
ID (ID (t -> x) -> t -> x
forall x. ID x -> x
unID ID (t -> x)
c t
forall b. Data ctx b => b
f)
z :: x -> ID x
z = x -> ID x
forall g. g -> ID g
ID
fromConstrM :: (Monad m, Data ctx a)
=> Proxy ctx
-> (forall b. Data ctx b => m b)
-> Constr
-> m a
fromConstrM :: Proxy ctx -> (forall b. Data ctx b => m b) -> Constr -> m a
fromConstrM ctx :: Proxy ctx
ctx f :: forall b. Data ctx b => m b
f = Proxy ctx
-> (forall b r. Data ctx b => m (b -> r) -> m r)
-> (forall r. r -> m r)
-> Constr
-> m a
forall (ctx :: * -> *) a (c :: * -> *).
Data ctx a =>
Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c a
gunfold Proxy ctx
ctx forall b r. Data ctx b => m (b -> r) -> m r
k forall r. r -> m r
z
where
k :: m (t -> b) -> m b
k c :: m (t -> b)
c = do { t -> b
c' <- m (t -> b)
c; t
b <- m t
forall b. Data ctx b => m b
f; b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (t -> b
c' t
b) }
z :: a -> m a
z = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
data DataType = DataType
{ DataType -> String
tycon :: String
, DataType -> DataRep
datarep :: DataRep
}
deriving Int -> DataType -> ShowS
[DataType] -> ShowS
DataType -> String
(Int -> DataType -> ShowS)
-> (DataType -> String) -> ([DataType] -> ShowS) -> Show DataType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DataType] -> ShowS
$cshowList :: [DataType] -> ShowS
show :: DataType -> String
$cshow :: DataType -> String
showsPrec :: Int -> DataType -> ShowS
$cshowsPrec :: Int -> DataType -> ShowS
Show
data Constr = Constr
{ Constr -> ConstrRep
conrep :: ConstrRep
, Constr -> String
constring :: String
, Constr -> [String]
confields :: [String]
, Constr -> Fixity
confixity :: Fixity
, Constr -> DataType
datatype :: DataType
}
instance Show Constr where
show :: Constr -> String
show = Constr -> String
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
| StringRep
| NoRep
deriving (DataRep -> DataRep -> Bool
(DataRep -> DataRep -> Bool)
-> (DataRep -> DataRep -> Bool) -> Eq DataRep
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 -> String
(Int -> DataRep -> ShowS)
-> (DataRep -> String) -> ([DataRep] -> ShowS) -> Show DataRep
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DataRep] -> ShowS
$cshowList :: [DataRep] -> ShowS
show :: DataRep -> String
$cshow :: DataRep -> String
showsPrec :: Int -> DataRep -> ShowS
$cshowsPrec :: Int -> DataRep -> ShowS
Show)
data ConstrRep = AlgConstr ConIndex
| IntConstr Integer
| FloatConstr Double
| StringConstr String
deriving (ConstrRep -> ConstrRep -> Bool
(ConstrRep -> ConstrRep -> Bool)
-> (ConstrRep -> ConstrRep -> Bool) -> Eq ConstrRep
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 -> String
(Int -> ConstrRep -> ShowS)
-> (ConstrRep -> String)
-> ([ConstrRep] -> ShowS)
-> Show ConstrRep
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConstrRep] -> ShowS
$cshowList :: [ConstrRep] -> ShowS
show :: ConstrRep -> String
$cshow :: ConstrRep -> String
showsPrec :: Int -> ConstrRep -> ShowS
$cshowsPrec :: Int -> ConstrRep -> ShowS
Show)
type ConIndex = Int
data Fixity = Prefix
| Infix
deriving (Fixity -> Fixity -> Bool
(Fixity -> Fixity -> Bool)
-> (Fixity -> Fixity -> Bool) -> Eq Fixity
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 -> String
(Int -> Fixity -> ShowS)
-> (Fixity -> String) -> ([Fixity] -> ShowS) -> Show Fixity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Fixity] -> ShowS
$cshowList :: [Fixity] -> ShowS
show :: Fixity -> String
$cshow :: Fixity -> String
showsPrec :: Int -> Fixity -> ShowS
$cshowsPrec :: Int -> Fixity -> ShowS
Show)
dataTypeName :: DataType -> String
dataTypeName :: DataType -> String
dataTypeName = DataType -> String
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
mkIntConstr DataType
dt Integer
i
(FloatRep, FloatConstr f :: Double
f) -> DataType -> Double -> Constr
mkFloatConstr DataType
dt Double
f
(StringRep, StringConstr str :: String
str) -> DataType -> String -> Constr
mkStringConstr DataType
dt String
str
_ -> String -> Constr
forall a. HasCallStack => String -> a
error "repConstr"
mkDataType :: String -> [Constr] -> DataType
mkDataType :: String -> [Constr] -> DataType
mkDataType str :: String
str cs :: [Constr]
cs = DataType :: String -> DataRep -> DataType
DataType
{ tycon :: String
tycon = String
str
, datarep :: DataRep
datarep = [Constr] -> DataRep
AlgRep [Constr]
cs
}
mkConstr :: DataType -> String -> [String] -> Fixity -> Constr
mkConstr :: DataType -> String -> [String] -> Fixity -> Constr
mkConstr dt :: DataType
dt str :: String
str fields :: [String]
fields fix :: Fixity
fix =
Constr :: ConstrRep -> String -> [String] -> Fixity -> DataType -> Constr
Constr
{ conrep :: ConstrRep
conrep = Int -> ConstrRep
AlgConstr Int
idx
, constring :: String
constring = String
str
, confields :: [String]
confields = [String]
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 -> String
showConstr Constr
c String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
str ]
dataTypeConstrs :: DataType -> [Constr]
dataTypeConstrs :: DataType -> [Constr]
dataTypeConstrs dt :: DataType
dt = case DataType -> DataRep
datarep DataType
dt of
(AlgRep cons :: [Constr]
cons) -> [Constr]
cons
_ -> String -> [Constr]
forall a. HasCallStack => String -> a
error "dataTypeConstrs"
constrFields :: Constr -> [String]
constrFields :: Constr -> [String]
constrFields = Constr -> [String]
confields
constrFixity :: Constr -> Fixity
constrFixity :: Constr -> Fixity
constrFixity = Constr -> Fixity
confixity
showConstr :: Constr -> String
showConstr :: Constr -> String
showConstr = Constr -> String
constring
readConstr :: DataType -> String -> Maybe Constr
readConstr :: DataType -> String -> Maybe Constr
readConstr dt :: DataType
dt str :: String
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 -> String -> ConstrRep -> Constr
mkPrimCon DataType
dt String
str (Integer -> ConstrRep
IntConstr Integer
i)))
FloatRep -> (Double -> Constr) -> Maybe Constr
forall t. Read t => (t -> Constr) -> Maybe Constr
mkReadCon (\f :: Double
f -> (DataType -> String -> ConstrRep -> Constr
mkPrimCon DataType
dt String
str (Double -> ConstrRep
FloatConstr Double
f)))
StringRep -> Constr -> Maybe Constr
forall a. a -> Maybe a
Just (DataType -> String -> Constr
mkStringConstr DataType
dt String
str)
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 String
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 (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) String
str (String -> Bool) -> (Constr -> String) -> Constr -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constr -> String
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)
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)
_ -> String -> Constr
forall a. HasCallStack => String -> a
error "indexConstr"
constrIndex :: Constr -> ConIndex
constrIndex :: Constr -> Int
constrIndex con :: Constr
con = case Constr -> ConstrRep
constrRep Constr
con of
(AlgConstr idx :: Int
idx) -> Int
idx
_ -> String -> Int
forall a. HasCallStack => String -> a
error "constrIndex"
maxConstrIndex :: DataType -> ConIndex
maxConstrIndex :: DataType -> Int
maxConstrIndex dt :: DataType
dt = case DataType -> DataRep
dataTypeRep DataType
dt of
AlgRep cs :: [Constr]
cs -> [Constr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Constr]
cs
_ -> String -> Int
forall a. HasCallStack => String -> a
error "maxConstrIndex"
mkIntType :: String -> DataType
mkIntType :: String -> DataType
mkIntType = DataRep -> String -> DataType
mkPrimType DataRep
IntRep
mkFloatType :: String -> DataType
mkFloatType :: String -> DataType
mkFloatType = DataRep -> String -> DataType
mkPrimType DataRep
FloatRep
mkStringType :: String -> DataType
mkStringType :: String -> DataType
mkStringType = DataRep -> String -> DataType
mkPrimType DataRep
StringRep
mkPrimType :: DataRep -> String -> DataType
mkPrimType :: DataRep -> String -> DataType
mkPrimType dr :: DataRep
dr str :: String
str = DataType :: String -> DataRep -> DataType
DataType
{ tycon :: String
tycon = String
str
, datarep :: DataRep
datarep = DataRep
dr
}
mkPrimCon :: DataType -> String -> ConstrRep -> Constr
mkPrimCon :: DataType -> String -> ConstrRep -> Constr
mkPrimCon dt :: DataType
dt str :: String
str cr :: ConstrRep
cr = Constr :: ConstrRep -> String -> [String] -> Fixity -> DataType -> Constr
Constr
{ datatype :: DataType
datatype = DataType
dt
, conrep :: ConstrRep
conrep = ConstrRep
cr
, constring :: String
constring = String
str
, confields :: [String]
confields = String -> [String]
forall a. HasCallStack => String -> a
error (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ["constrFields : ", (DataType -> String
tycon DataType
dt), " is primative"]
, confixity :: Fixity
confixity = String -> Fixity
forall a. HasCallStack => String -> a
error "constrFixity"
}
mkIntConstr :: DataType -> Integer -> Constr
mkIntConstr :: DataType -> Integer -> Constr
mkIntConstr dt :: DataType
dt i :: Integer
i = case DataType -> DataRep
datarep DataType
dt of
IntRep -> DataType -> String -> ConstrRep -> Constr
mkPrimCon DataType
dt (Integer -> String
forall a. Show a => a -> String
show Integer
i) (Integer -> ConstrRep
IntConstr Integer
i)
_ -> String -> Constr
forall a. HasCallStack => String -> a
error "mkIntConstr"
mkFloatConstr :: DataType -> Double -> Constr
mkFloatConstr :: DataType -> Double -> Constr
mkFloatConstr dt :: DataType
dt f :: Double
f = case DataType -> DataRep
datarep DataType
dt of
FloatRep -> DataType -> String -> ConstrRep -> Constr
mkPrimCon DataType
dt (Double -> String
forall a. Show a => a -> String
show Double
f) (Double -> ConstrRep
FloatConstr Double
f)
_ -> String -> Constr
forall a. HasCallStack => String -> a
error "mkFloatConstr"
mkStringConstr :: DataType -> String -> Constr
mkStringConstr :: DataType -> String -> Constr
mkStringConstr dt :: DataType
dt str :: String
str = case DataType -> DataRep
datarep DataType
dt of
StringRep -> DataType -> String -> ConstrRep -> Constr
mkPrimCon DataType
dt String
str (String -> ConstrRep
StringConstr String
str)
_ -> String -> Constr
forall a. HasCallStack => String -> a
error "mkStringConstr"
mkNorepType :: String -> DataType
mkNorepType :: String -> DataType
mkNorepType str :: String
str = DataType :: String -> DataRep -> DataType
DataType
{ tycon :: String
tycon = String
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