{-# LANGUAGE UndecidableInstances, Rank2Types,
    CPP, KindSignatures, MultiParamTypeClasses, EmptyDataDecls #-}

{- |

(C) 2004--2005 Ralf Laemmel, Simon D. Foster

This module approximates Data.Generics.Basics.

-}


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

------------------------------------------------------------------------------
-- * The ingenious Data class

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

     -- Default definition for gfoldl
     -- which copes immediately with basic datatypes
     --
     gfoldl Proxy ctx
_ forall b c. Data ctx b => w (b -> c) -> b -> w c
_ 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

     -- incomplete implementation

     gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
_ forall r. r -> c r
_ Constr
_ = c a
forall a. HasCallStack => a
undefined

     dataTypeOf Proxy ctx
_ a
_ = DataType
forall a. HasCallStack => a
undefined

     -- | Mediate types and unary type constructors
#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 Proxy ctx
_ forall b. Data ctx b => w (t b)
_ = Maybe (w a)
forall a. Maybe a
Nothing

     -- | Mediate types and binary type constructors
#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 Proxy ctx
_ forall b c. (Data ctx b, Data ctx c) => w (t b c)
_ = Maybe (w a)
forall a. Maybe a
Nothing



------------------------------------------------------------------------------

-- * Generic transformations

type GenericT ctx = forall a. Data ctx a => a -> a


-- | Generic map for transformations

gmapT :: Proxy ctx -> GenericT ctx -> GenericT ctx

gmapT :: Proxy ctx -> GenericT ctx -> GenericT ctx
gmapT Proxy ctx
ctx GenericT ctx
f 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 t -> x
g) t
y = x -> ID x
forall g. g -> ID g
ID (t -> x
g (t -> t
GenericT ctx
f t
y))


-- | The identity type constructor

newtype ID x = ID { ID x -> x
unID :: x }


------------------------------------------------------------------------------

-- | Generic monadic transformations

type GenericM m ctx = forall a. Data ctx a => a -> m a

-- | Generic map for monadic transformations

gmapM :: Monad m => Proxy ctx -> GenericM m ctx -> GenericM m ctx
gmapM :: Proxy ctx -> GenericM m ctx -> GenericM m ctx
gmapM Proxy ctx
ctx 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 m (t -> b)
c 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')


------------------------------------------------------------------------------

-- * Generic queries

type GenericQ ctx r = forall a. Data ctx a => a -> r


-- | Map for queries

gmapQ :: Proxy ctx -> GenericQ ctx r -> GenericQ ctx [r]
gmapQ :: Proxy ctx -> GenericQ ctx r -> GenericQ ctx [r]
gmapQ Proxy ctx
ctx 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 Proxy ctx
ctx r' -> r -> r
o r
r GenericQ ctx r'
f 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 r -> r
g) a
y = (r -> r) -> Qr r a
forall r a. (r -> r) -> Qr r a
Qr (\r
s -> r -> r
g (a -> r'
GenericQ ctx r'
f a
y r' -> r -> r
`o` r
s))

-- | The type constructor used in definition of gmapQr
newtype Qr r a = Qr { Qr r a -> r -> r
unQr  :: r -> r }



------------------------------------------------------------------------------
--
-- * Generic unfolding
--
------------------------------------------------------------------------------



-- | Build a term skeleton
fromConstr :: Data ctx a => Proxy ctx -> Constr -> a
fromConstr :: Proxy ctx -> Constr -> a
fromConstr 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

-- | Build a term and use a generic function for subterms
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 Proxy ctx
ctx 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 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



-- | Monadic variation on \"fromConstrB\"
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 Proxy ctx
ctx 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 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



------------------------------------------------------------------------------
--
-- * Datatype and constructor representations
--
------------------------------------------------------------------------------


--
-- | Representation of datatypes.
--   A package of constructor representations with names of type and module.
--   The list of constructors could be an array, a balanced tree, or others.
--
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


-- | Representation of constructors
data Constr = Constr
                        { Constr -> ConstrRep
conrep    :: ConstrRep
                        , Constr -> String
constring :: String
                        , Constr -> [String]
confields :: [String] -- for AlgRep only
                        , Constr -> Fixity
confixity :: Fixity   -- for AlgRep only
                        , Constr -> DataType
datatype  :: DataType
                        }

instance Show Constr where
 show :: Constr -> String
show = Constr -> String
constring


-- | Equality of constructors
instance Eq Constr where
  Constr
c == :: Constr -> Constr -> Bool
== Constr
c' = Constr -> ConstrRep
constrRep Constr
c ConstrRep -> ConstrRep -> Bool
forall a. Eq a => a -> a -> Bool
== Constr -> ConstrRep
constrRep Constr
c'


-- | Public representation of datatypes
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)


-- | Public representation of constructors
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)


--
-- | Unique index for datatype constructors.
-- | Textual order is respected. Starts at 1.
--
type ConIndex = Int


-- | Fixity of constructors
data Fixity = Prefix
            | Infix  -- Later: add associativity and precedence

            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)


------------------------------------------------------------------------------
--
-- * Observers for datatype representations
--
------------------------------------------------------------------------------


-- | Gets the type constructor including the module
dataTypeName :: DataType -> String
dataTypeName :: DataType -> String
dataTypeName = DataType -> String
tycon



-- | Gets the public presentation of datatypes
dataTypeRep :: DataType -> DataRep
dataTypeRep :: DataType -> DataRep
dataTypeRep = DataType -> DataRep
datarep


-- | Gets the datatype of a constructor
constrType :: Constr -> DataType
constrType :: Constr -> DataType
constrType = Constr -> DataType
datatype


-- | Gets the public presentation of constructors
constrRep :: Constr -> ConstrRep
constrRep :: Constr -> ConstrRep
constrRep = Constr -> ConstrRep
conrep


-- | Look up a constructor by its representation
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 [Constr] -> Int -> Constr
forall a. [a] -> Int -> a
!! (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
        (DataRep
IntRep,    IntConstr Integer
i)      -> DataType -> Integer -> Constr
mkIntConstr DataType
dt Integer
i
        (DataRep
FloatRep,  FloatConstr Double
f)    -> DataType -> Double -> Constr
mkFloatConstr DataType
dt Double
f
        (DataRep
StringRep, StringConstr String
str) -> DataType -> String -> Constr
mkStringConstr DataType
dt String
str
        (DataRep, ConstrRep)
_ -> String -> Constr
forall a. HasCallStack => String -> a
error String
"repConstr"



------------------------------------------------------------------------------
--
-- * Representations of algebraic data types
--
------------------------------------------------------------------------------


-- | Constructs an algebraic datatype
mkDataType :: String -> [Constr] -> DataType
mkDataType :: String -> [Constr] -> DataType
mkDataType String
str [Constr]
cs = DataType :: String -> DataRep -> DataType
DataType
                        { tycon :: String
tycon   = String
str
                        , datarep :: DataRep
datarep = [Constr] -> DataRep
AlgRep [Constr]
cs
                        }


-- | Constructs a constructor
mkConstr :: DataType -> String -> [String] -> Fixity -> Constr
mkConstr :: DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
dt String
str [String]
fields 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 | (Constr
c,Int
i) <- DataType -> [Constr]
dataTypeConstrs DataType
dt [Constr] -> [Int] -> [(Constr, Int)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [Int
1..],
                     Constr -> String
showConstr Constr
c String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
str ]


-- | Gets the constructors
dataTypeConstrs :: DataType -> [Constr]
dataTypeConstrs :: DataType -> [Constr]
dataTypeConstrs DataType
dt = case DataType -> DataRep
datarep DataType
dt of
                        (AlgRep [Constr]
cons) -> [Constr]
cons
                        DataRep
_ -> String -> [Constr]
forall a. HasCallStack => String -> a
error String
"dataTypeConstrs"


-- | Gets the field labels of a constructor
constrFields :: Constr -> [String]
constrFields :: Constr -> [String]
constrFields = Constr -> [String]
confields


-- | Gets the fixity of a constructor
constrFixity :: Constr -> Fixity
constrFixity :: Constr -> Fixity
constrFixity = Constr -> Fixity
confixity



------------------------------------------------------------------------------
--
-- * From strings to constr's and vice versa: all data types
--
------------------------------------------------------------------------------


-- | Gets the string for a constructor
showConstr :: Constr -> String
showConstr :: Constr -> String
showConstr = Constr -> String
constring


-- | Lookup a constructor via a string
readConstr :: DataType -> String -> Maybe Constr
readConstr :: DataType -> String -> Maybe Constr
readConstr DataType
dt String
str =
      case DataType -> DataRep
dataTypeRep DataType
dt of
        AlgRep [Constr]
cons -> [Constr] -> Maybe Constr
idx [Constr]
cons
        DataRep
IntRep      -> (Integer -> Constr) -> Maybe Constr
forall t. Read t => (t -> Constr) -> Maybe Constr
mkReadCon (\Integer
i -> (DataType -> String -> ConstrRep -> Constr
mkPrimCon DataType
dt String
str (Integer -> ConstrRep
IntConstr Integer
i)))
        DataRep
FloatRep    -> (Double -> Constr) -> Maybe Constr
forall t. Read t => (t -> Constr) -> Maybe Constr
mkReadCon (\Double
f -> (DataType -> String -> ConstrRep -> Constr
mkPrimCon DataType
dt String
str (Double -> ConstrRep
FloatConstr Double
f)))
        DataRep
StringRep   -> Constr -> Maybe Constr
forall a. a -> Maybe a
Just (DataType -> String -> Constr
mkStringConstr DataType
dt String
str)
        DataRep
NoRep       -> Maybe Constr
forall a. Maybe a
Nothing
  where

    -- Read a value and build a constructor
    mkReadCon :: Read t => (t -> Constr) -> Maybe Constr
    mkReadCon :: (t -> Constr) -> Maybe Constr
mkReadCon t -> Constr
f = case (ReadS t
forall a. Read a => ReadS a
reads String
str) of
                    [(t
t,String
"")] -> Constr -> Maybe Constr
forall a. a -> Maybe a
Just (t -> Constr
f t
t)
                    [(t, String)]
_ -> Maybe Constr
forall a. Maybe a
Nothing

    -- Traverse list of algebraic datatype constructors
    idx :: [Constr] -> Maybe Constr
    idx :: [Constr] -> Maybe Constr
idx [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)


------------------------------------------------------------------------------
--
-- * Convenience funtions: algebraic data types
--
------------------------------------------------------------------------------


-- | Test for an algebraic type
isAlgType :: DataType -> Bool
isAlgType :: DataType -> Bool
isAlgType DataType
dt = case DataType -> DataRep
datarep DataType
dt of
                 (AlgRep [Constr]
_) -> Bool
True
                 DataRep
_ -> Bool
False


-- | Gets the constructor for an index
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 [Constr] -> Int -> Constr
forall a. [a] -> Int -> a
!! (Int
idxInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                        DataRep
_           -> String -> Constr
forall a. HasCallStack => String -> a
error String
"indexConstr"


-- | Gets the index of a constructor
constrIndex :: Constr -> ConIndex
constrIndex :: Constr -> Int
constrIndex Constr
con = case Constr -> ConstrRep
constrRep Constr
con of
                    (AlgConstr Int
idx) -> Int
idx
                    ConstrRep
_ -> String -> Int
forall a. HasCallStack => String -> a
error String
"constrIndex"


-- | Gets the maximum constructor index
maxConstrIndex :: DataType -> ConIndex
maxConstrIndex :: DataType -> Int
maxConstrIndex DataType
dt = case DataType -> DataRep
dataTypeRep DataType
dt of
                        AlgRep [Constr]
cs -> [Constr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Constr]
cs
                        DataRep
_         -> String -> Int
forall a. HasCallStack => String -> a
error String
"maxConstrIndex"



------------------------------------------------------------------------------
--
-- * Representation of primitive types
--
------------------------------------------------------------------------------


-- | Constructs the Int type
mkIntType :: String -> DataType
mkIntType :: String -> DataType
mkIntType = DataRep -> String -> DataType
mkPrimType DataRep
IntRep


-- | Constructs the Float type
mkFloatType :: String -> DataType
mkFloatType :: String -> DataType
mkFloatType = DataRep -> String -> DataType
mkPrimType DataRep
FloatRep


-- | Constructs the String type
mkStringType :: String -> DataType
mkStringType :: String -> DataType
mkStringType = DataRep -> String -> DataType
mkPrimType DataRep
StringRep


-- | Helper for mkIntType, mkFloatType, mkStringType
mkPrimType :: DataRep -> String -> DataType
mkPrimType :: DataRep -> String -> DataType
mkPrimType DataRep
dr String
str = DataType :: String -> DataRep -> DataType
DataType
                        { tycon :: String
tycon   = String
str
                        , datarep :: DataRep
datarep = DataRep
dr
                        }


-- | Makes a constructor for primitive types
mkPrimCon :: DataType -> String -> ConstrRep -> Constr
mkPrimCon :: DataType -> String -> ConstrRep -> Constr
mkPrimCon DataType
dt String
str 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 [String
"constrFields : ", (DataType -> String
tycon DataType
dt), String
" is primative"]
                        , confixity :: Fixity
confixity = String -> Fixity
forall a. HasCallStack => String -> a
error String
"constrFixity"
                        }


-- | Makes a constructor for an Int
mkIntConstr :: DataType -> Integer -> Constr
mkIntConstr :: DataType -> Integer -> Constr
mkIntConstr DataType
dt Integer
i = case DataType -> DataRep
datarep DataType
dt of
                  DataRep
IntRep -> DataType -> String -> ConstrRep -> Constr
mkPrimCon DataType
dt (Integer -> String
forall a. Show a => a -> String
show Integer
i) (Integer -> ConstrRep
IntConstr Integer
i)
                  DataRep
_ -> String -> Constr
forall a. HasCallStack => String -> a
error String
"mkIntConstr"


-- | Makes a constructor for a Float
mkFloatConstr :: DataType -> Double -> Constr
mkFloatConstr :: DataType -> Double -> Constr
mkFloatConstr DataType
dt Double
f = case DataType -> DataRep
datarep DataType
dt of
                    DataRep
FloatRep -> DataType -> String -> ConstrRep -> Constr
mkPrimCon DataType
dt (Double -> String
forall a. Show a => a -> String
show Double
f) (Double -> ConstrRep
FloatConstr Double
f)
                    DataRep
_ -> String -> Constr
forall a. HasCallStack => String -> a
error String
"mkFloatConstr"


-- | Makes a constructor for a String
mkStringConstr :: DataType -> String -> Constr
mkStringConstr :: DataType -> String -> Constr
mkStringConstr DataType
dt String
str = case DataType -> DataRep
datarep DataType
dt of
                       DataRep
StringRep -> DataType -> String -> ConstrRep -> Constr
mkPrimCon DataType
dt String
str (String -> ConstrRep
StringConstr String
str)
                       DataRep
_ -> String -> Constr
forall a. HasCallStack => String -> a
error String
"mkStringConstr"


------------------------------------------------------------------------------
--
-- * Non-representations for non-presentable types
--
------------------------------------------------------------------------------


-- | Constructs a non-representation
mkNorepType :: String -> DataType
mkNorepType :: String -> DataType
mkNorepType String
str = DataType :: String -> DataRep -> DataType
DataType
                        { tycon :: String
tycon   = String
str
                        , datarep :: DataRep
datarep = DataRep
NoRep
                        }


-- | Test for a non-representable type
isNorepType :: DataType -> Bool
isNorepType :: DataType -> Bool
isNorepType DataType
dt = case DataType -> DataRep
datarep DataType
dt of
                   DataRep
NoRep -> Bool
True
                   DataRep
_ -> Bool
False