{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Inferno.Types.Type
  ( BaseType (..),
    ImplType (..),
    Namespace (..),
    TCScheme (..),
    TV (..),
    InfernoType (..),
    TypeClass (..),
    TypeClassShape (..),
    TypeMetadata (..),
    Substitutable (..),
    Subst (..),
    Scheme (..),
    (.->),
    sch,
    var,
    tySig,
    namespaceToIdent,
    typeInt,
    typeBool,
    typeDouble,
    typeWord16,
    typeWord32,
    typeWord64,
    typeText,
    typeResolution,
    typeTimeDiff,
    typeTime,
    punctuate',
  )
where

import Data.Aeson (FromJSON, ToJSON)
import Data.Data (Data)
import Data.List (intercalate)
import Data.Map (Map, empty)
import qualified Data.Map as Map
import Data.Set (Set)
import qualified Data.Set as Set
-- import Data.String (IsString)
import Data.Text (Text, unpack)
import GHC.Generics (Generic)
import Inferno.Types.Syntax (BaseType (..), Expr, ExtIdent (..), Ident (..), InfernoType (..), ModuleName (..), TV (..), punctuate')
import Inferno.Utils.Prettyprinter (renderPretty)
import Prettyprinter
  ( Doc,
    Pretty (pretty),
    align,
    comma,
    enclose,
    encloseSep,
    hsep,
    lbrace,
    lparen,
    rbrace,
    rparen,
    -- sep,
    -- tupled,
    (<+>),
  )
import Test.QuickCheck (Arbitrary (..), oneof)
import Test.QuickCheck.Arbitrary.ADT (ToADTArbitrary)

data ImplType = ImplType (Map ExtIdent InfernoType) InfernoType
  deriving (Int -> ImplType -> ShowS
[ImplType] -> ShowS
ImplType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImplType] -> ShowS
$cshowList :: [ImplType] -> ShowS
show :: ImplType -> String
$cshow :: ImplType -> String
showsPrec :: Int -> ImplType -> ShowS
$cshowsPrec :: Int -> ImplType -> ShowS
Show, ImplType -> ImplType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImplType -> ImplType -> Bool
$c/= :: ImplType -> ImplType -> Bool
== :: ImplType -> ImplType -> Bool
$c== :: ImplType -> ImplType -> Bool
Eq, Eq ImplType
ImplType -> ImplType -> Bool
ImplType -> ImplType -> Ordering
ImplType -> ImplType -> ImplType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ImplType -> ImplType -> ImplType
$cmin :: ImplType -> ImplType -> ImplType
max :: ImplType -> ImplType -> ImplType
$cmax :: ImplType -> ImplType -> ImplType
>= :: ImplType -> ImplType -> Bool
$c>= :: ImplType -> ImplType -> Bool
> :: ImplType -> ImplType -> Bool
$c> :: ImplType -> ImplType -> Bool
<= :: ImplType -> ImplType -> Bool
$c<= :: ImplType -> ImplType -> Bool
< :: ImplType -> ImplType -> Bool
$c< :: ImplType -> ImplType -> Bool
compare :: ImplType -> ImplType -> Ordering
$ccompare :: ImplType -> ImplType -> Ordering
Ord, Typeable ImplType
ImplType -> DataType
ImplType -> Constr
(forall b. Data b => b -> b) -> ImplType -> ImplType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ImplType -> u
forall u. (forall d. Data d => d -> u) -> ImplType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImplType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImplType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ImplType -> m ImplType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImplType -> m ImplType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImplType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImplType -> c ImplType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ImplType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ImplType)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImplType -> m ImplType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImplType -> m ImplType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImplType -> m ImplType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImplType -> m ImplType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ImplType -> m ImplType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ImplType -> m ImplType
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ImplType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ImplType -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ImplType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ImplType -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImplType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImplType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImplType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImplType -> r
gmapT :: (forall b. Data b => b -> b) -> ImplType -> ImplType
$cgmapT :: (forall b. Data b => b -> b) -> ImplType -> ImplType
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ImplType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ImplType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ImplType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ImplType)
dataTypeOf :: ImplType -> DataType
$cdataTypeOf :: ImplType -> DataType
toConstr :: ImplType -> Constr
$ctoConstr :: ImplType -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImplType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImplType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImplType -> c ImplType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImplType -> c ImplType
Data, forall x. Rep ImplType x -> ImplType
forall x. ImplType -> Rep ImplType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImplType x -> ImplType
$cfrom :: forall x. ImplType -> Rep ImplType x
Generic, [ImplType] -> Encoding
[ImplType] -> Value
ImplType -> Encoding
ImplType -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ImplType] -> Encoding
$ctoEncodingList :: [ImplType] -> Encoding
toJSONList :: [ImplType] -> Value
$ctoJSONList :: [ImplType] -> Value
toEncoding :: ImplType -> Encoding
$ctoEncoding :: ImplType -> Encoding
toJSON :: ImplType -> Value
$ctoJSON :: ImplType -> Value
ToJSON, Value -> Parser [ImplType]
Value -> Parser ImplType
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ImplType]
$cparseJSONList :: Value -> Parser [ImplType]
parseJSON :: Value -> Parser ImplType
$cparseJSON :: Value -> Parser ImplType
FromJSON)

data Scheme = Forall [TV] ImplType
  deriving (Int -> Scheme -> ShowS
[Scheme] -> ShowS
Scheme -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Scheme] -> ShowS
$cshowList :: [Scheme] -> ShowS
show :: Scheme -> String
$cshow :: Scheme -> String
showsPrec :: Int -> Scheme -> ShowS
$cshowsPrec :: Int -> Scheme -> ShowS
Show, Scheme -> Scheme -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Scheme -> Scheme -> Bool
$c/= :: Scheme -> Scheme -> Bool
== :: Scheme -> Scheme -> Bool
$c== :: Scheme -> Scheme -> Bool
Eq, Eq Scheme
Scheme -> Scheme -> Bool
Scheme -> Scheme -> Ordering
Scheme -> Scheme -> Scheme
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Scheme -> Scheme -> Scheme
$cmin :: Scheme -> Scheme -> Scheme
max :: Scheme -> Scheme -> Scheme
$cmax :: Scheme -> Scheme -> Scheme
>= :: Scheme -> Scheme -> Bool
$c>= :: Scheme -> Scheme -> Bool
> :: Scheme -> Scheme -> Bool
$c> :: Scheme -> Scheme -> Bool
<= :: Scheme -> Scheme -> Bool
$c<= :: Scheme -> Scheme -> Bool
< :: Scheme -> Scheme -> Bool
$c< :: Scheme -> Scheme -> Bool
compare :: Scheme -> Scheme -> Ordering
$ccompare :: Scheme -> Scheme -> Ordering
Ord, Typeable Scheme
Scheme -> DataType
Scheme -> Constr
(forall b. Data b => b -> b) -> Scheme -> Scheme
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Scheme -> u
forall u. (forall d. Data d => d -> u) -> Scheme -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Scheme -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Scheme -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Scheme -> m Scheme
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Scheme -> m Scheme
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Scheme
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Scheme -> c Scheme
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Scheme)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Scheme)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Scheme -> m Scheme
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Scheme -> m Scheme
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Scheme -> m Scheme
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Scheme -> m Scheme
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Scheme -> m Scheme
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Scheme -> m Scheme
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Scheme -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Scheme -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Scheme -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Scheme -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Scheme -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Scheme -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Scheme -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Scheme -> r
gmapT :: (forall b. Data b => b -> b) -> Scheme -> Scheme
$cgmapT :: (forall b. Data b => b -> b) -> Scheme -> Scheme
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Scheme)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Scheme)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Scheme)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Scheme)
dataTypeOf :: Scheme -> DataType
$cdataTypeOf :: Scheme -> DataType
toConstr :: Scheme -> Constr
$ctoConstr :: Scheme -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Scheme
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Scheme
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Scheme -> c Scheme
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Scheme -> c Scheme
Data, forall x. Rep Scheme x -> Scheme
forall x. Scheme -> Rep Scheme x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Scheme x -> Scheme
$cfrom :: forall x. Scheme -> Rep Scheme x
Generic, [Scheme] -> Encoding
[Scheme] -> Value
Scheme -> Encoding
Scheme -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Scheme] -> Encoding
$ctoEncodingList :: [Scheme] -> Encoding
toJSONList :: [Scheme] -> Value
$ctoJSONList :: [Scheme] -> Value
toEncoding :: Scheme -> Encoding
$ctoEncoding :: Scheme -> Encoding
toJSON :: Scheme -> Value
$ctoJSON :: Scheme -> Value
ToJSON, Value -> Parser [Scheme]
Value -> Parser Scheme
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Scheme]
$cparseJSONList :: Value -> Parser [Scheme]
parseJSON :: Value -> Parser Scheme
$cparseJSON :: Value -> Parser Scheme
FromJSON)

typeInt, typeBool, typeDouble, typeWord16, typeWord32, typeWord64, typeText, typeResolution, typeTimeDiff, typeTime :: InfernoType
typeInt :: InfernoType
typeInt = BaseType -> InfernoType
TBase BaseType
TInt
typeBool :: InfernoType
typeBool = BaseType -> InfernoType
TBase forall a b. (a -> b) -> a -> b
$ Text -> Set Ident -> BaseType
TEnum Text
"bool" forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
Set.fromList [Ident
"true", Ident
"false"]
typeDouble :: InfernoType
typeDouble = BaseType -> InfernoType
TBase BaseType
TDouble
typeWord16 :: InfernoType
typeWord16 = BaseType -> InfernoType
TBase BaseType
TWord16
typeWord32 :: InfernoType
typeWord32 = BaseType -> InfernoType
TBase BaseType
TWord32
typeWord64 :: InfernoType
typeWord64 = BaseType -> InfernoType
TBase BaseType
TWord64
typeText :: InfernoType
typeText = BaseType -> InfernoType
TBase BaseType
TText
typeTimeDiff :: InfernoType
typeTimeDiff = BaseType -> InfernoType
TBase BaseType
TTimeDiff
typeTime :: InfernoType
typeTime = BaseType -> InfernoType
TBase BaseType
TTime
typeResolution :: InfernoType
typeResolution = BaseType -> InfernoType
TBase BaseType
TResolution

sch :: InfernoType -> Scheme
sch :: InfernoType -> Scheme
sch = [TV] -> ImplType -> Scheme
Forall [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map ExtIdent InfernoType -> InfernoType -> ImplType
ImplType forall k a. Map k a
empty

infixr 3 .->

(.->) :: InfernoType -> InfernoType -> InfernoType
InfernoType
x .-> :: InfernoType -> InfernoType -> InfernoType
.-> InfernoType
y = InfernoType -> InfernoType -> InfernoType
TArr InfernoType
x InfernoType
y

var :: Int -> InfernoType
var :: Int -> InfernoType
var Int
x = TV -> InfernoType
TVar (Int -> TV
TV Int
x)

data TypeClass = TypeClass
  { TypeClass -> Text
className :: Text,
    TypeClass -> [InfernoType]
params :: [InfernoType]
  }
  deriving (Int -> TypeClass -> ShowS
[TypeClass] -> ShowS
TypeClass -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeClass] -> ShowS
$cshowList :: [TypeClass] -> ShowS
show :: TypeClass -> String
$cshow :: TypeClass -> String
showsPrec :: Int -> TypeClass -> ShowS
$cshowsPrec :: Int -> TypeClass -> ShowS
Show, TypeClass -> TypeClass -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeClass -> TypeClass -> Bool
$c/= :: TypeClass -> TypeClass -> Bool
== :: TypeClass -> TypeClass -> Bool
$c== :: TypeClass -> TypeClass -> Bool
Eq, Eq TypeClass
TypeClass -> TypeClass -> Bool
TypeClass -> TypeClass -> Ordering
TypeClass -> TypeClass -> TypeClass
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TypeClass -> TypeClass -> TypeClass
$cmin :: TypeClass -> TypeClass -> TypeClass
max :: TypeClass -> TypeClass -> TypeClass
$cmax :: TypeClass -> TypeClass -> TypeClass
>= :: TypeClass -> TypeClass -> Bool
$c>= :: TypeClass -> TypeClass -> Bool
> :: TypeClass -> TypeClass -> Bool
$c> :: TypeClass -> TypeClass -> Bool
<= :: TypeClass -> TypeClass -> Bool
$c<= :: TypeClass -> TypeClass -> Bool
< :: TypeClass -> TypeClass -> Bool
$c< :: TypeClass -> TypeClass -> Bool
compare :: TypeClass -> TypeClass -> Ordering
$ccompare :: TypeClass -> TypeClass -> Ordering
Ord, Typeable TypeClass
TypeClass -> DataType
TypeClass -> Constr
(forall b. Data b => b -> b) -> TypeClass -> TypeClass
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TypeClass -> u
forall u. (forall d. Data d => d -> u) -> TypeClass -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeClass -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeClass -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TypeClass -> m TypeClass
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeClass -> m TypeClass
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypeClass
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeClass -> c TypeClass
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypeClass)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TypeClass)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeClass -> m TypeClass
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeClass -> m TypeClass
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeClass -> m TypeClass
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeClass -> m TypeClass
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TypeClass -> m TypeClass
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TypeClass -> m TypeClass
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TypeClass -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TypeClass -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> TypeClass -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TypeClass -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeClass -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeClass -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeClass -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeClass -> r
gmapT :: (forall b. Data b => b -> b) -> TypeClass -> TypeClass
$cgmapT :: (forall b. Data b => b -> b) -> TypeClass -> TypeClass
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TypeClass)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TypeClass)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypeClass)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypeClass)
dataTypeOf :: TypeClass -> DataType
$cdataTypeOf :: TypeClass -> DataType
toConstr :: TypeClass -> Constr
$ctoConstr :: TypeClass -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypeClass
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypeClass
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeClass -> c TypeClass
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeClass -> c TypeClass
Data, forall x. Rep TypeClass x -> TypeClass
forall x. TypeClass -> Rep TypeClass x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TypeClass x -> TypeClass
$cfrom :: forall x. TypeClass -> Rep TypeClass x
Generic, [TypeClass] -> Encoding
[TypeClass] -> Value
TypeClass -> Encoding
TypeClass -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [TypeClass] -> Encoding
$ctoEncodingList :: [TypeClass] -> Encoding
toJSONList :: [TypeClass] -> Value
$ctoJSONList :: [TypeClass] -> Value
toEncoding :: TypeClass -> Encoding
$ctoEncoding :: TypeClass -> Encoding
toJSON :: TypeClass -> Value
$ctoJSON :: TypeClass -> Value
ToJSON, Value -> Parser [TypeClass]
Value -> Parser TypeClass
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [TypeClass]
$cparseJSONList :: Value -> Parser [TypeClass]
parseJSON :: Value -> Parser TypeClass
$cparseJSON :: Value -> Parser TypeClass
FromJSON)

data TCScheme = ForallTC [TV] (Set TypeClass) ImplType
  deriving (Int -> TCScheme -> ShowS
[TCScheme] -> ShowS
TCScheme -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TCScheme] -> ShowS
$cshowList :: [TCScheme] -> ShowS
show :: TCScheme -> String
$cshow :: TCScheme -> String
showsPrec :: Int -> TCScheme -> ShowS
$cshowsPrec :: Int -> TCScheme -> ShowS
Show, TCScheme -> TCScheme -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TCScheme -> TCScheme -> Bool
$c/= :: TCScheme -> TCScheme -> Bool
== :: TCScheme -> TCScheme -> Bool
$c== :: TCScheme -> TCScheme -> Bool
Eq, Eq TCScheme
TCScheme -> TCScheme -> Bool
TCScheme -> TCScheme -> Ordering
TCScheme -> TCScheme -> TCScheme
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TCScheme -> TCScheme -> TCScheme
$cmin :: TCScheme -> TCScheme -> TCScheme
max :: TCScheme -> TCScheme -> TCScheme
$cmax :: TCScheme -> TCScheme -> TCScheme
>= :: TCScheme -> TCScheme -> Bool
$c>= :: TCScheme -> TCScheme -> Bool
> :: TCScheme -> TCScheme -> Bool
$c> :: TCScheme -> TCScheme -> Bool
<= :: TCScheme -> TCScheme -> Bool
$c<= :: TCScheme -> TCScheme -> Bool
< :: TCScheme -> TCScheme -> Bool
$c< :: TCScheme -> TCScheme -> Bool
compare :: TCScheme -> TCScheme -> Ordering
$ccompare :: TCScheme -> TCScheme -> Ordering
Ord, Typeable TCScheme
TCScheme -> DataType
TCScheme -> Constr
(forall b. Data b => b -> b) -> TCScheme -> TCScheme
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TCScheme -> u
forall u. (forall d. Data d => d -> u) -> TCScheme -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TCScheme -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TCScheme -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TCScheme -> m TCScheme
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TCScheme -> m TCScheme
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TCScheme
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TCScheme -> c TCScheme
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TCScheme)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TCScheme)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TCScheme -> m TCScheme
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TCScheme -> m TCScheme
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TCScheme -> m TCScheme
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TCScheme -> m TCScheme
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TCScheme -> m TCScheme
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TCScheme -> m TCScheme
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TCScheme -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TCScheme -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> TCScheme -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TCScheme -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TCScheme -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TCScheme -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TCScheme -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TCScheme -> r
gmapT :: (forall b. Data b => b -> b) -> TCScheme -> TCScheme
$cgmapT :: (forall b. Data b => b -> b) -> TCScheme -> TCScheme
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TCScheme)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TCScheme)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TCScheme)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TCScheme)
dataTypeOf :: TCScheme -> DataType
$cdataTypeOf :: TCScheme -> DataType
toConstr :: TCScheme -> Constr
$ctoConstr :: TCScheme -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TCScheme
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TCScheme
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TCScheme -> c TCScheme
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TCScheme -> c TCScheme
Data, forall x. Rep TCScheme x -> TCScheme
forall x. TCScheme -> Rep TCScheme x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TCScheme x -> TCScheme
$cfrom :: forall x. TCScheme -> Rep TCScheme x
Generic, [TCScheme] -> Encoding
[TCScheme] -> Value
TCScheme -> Encoding
TCScheme -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [TCScheme] -> Encoding
$ctoEncodingList :: [TCScheme] -> Encoding
toJSONList :: [TCScheme] -> Value
$ctoJSONList :: [TCScheme] -> Value
toEncoding :: TCScheme -> Encoding
$ctoEncoding :: TCScheme -> Encoding
toJSON :: TCScheme -> Value
$ctoJSON :: TCScheme -> Value
ToJSON, Value -> Parser [TCScheme]
Value -> Parser TCScheme
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [TCScheme]
$cparseJSONList :: Value -> Parser [TCScheme]
parseJSON :: Value -> Parser TCScheme
$cparseJSON :: Value -> Parser TCScheme
FromJSON)

tySig :: [Doc ann] -> [Doc ann]
tySig :: forall ann. [Doc ann] -> [Doc ann]
tySig [] = []
tySig [Doc ann
d] = [Doc ann
":" forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
d]
tySig (Doc ann
d : [Doc ann]
ds) = (Doc ann
":" forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
d) forall a. a -> [a] -> [a]
: forall ann. [Doc ann] -> [Doc ann]
go [Doc ann]
ds
  where
    go :: [Doc ann] -> [Doc ann]
go [] = []
    go (Doc ann
d' : [Doc ann]
ds') = (Doc ann
"|" forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
d') forall a. a -> [a] -> [a]
: [Doc ann] -> [Doc ann]
go [Doc ann]
ds'

instance Pretty ImplType where
  pretty :: forall ann. ImplType -> Doc ann
pretty (ImplType Map ExtIdent InfernoType
impl InfernoType
ty)
    | forall k a. Map k a -> Bool
Map.null Map ExtIdent InfernoType
impl = forall a ann. Pretty a => a -> Doc ann
pretty InfernoType
ty
    | Bool
otherwise =
      forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
encloseSep
        forall ann. Doc ann
lbrace
        forall ann. Doc ann
rbrace
        forall ann. Doc ann
comma
        (forall a b. (a -> b) -> [a] -> [b]
map (\(ExtIdent Either Int Text
idt, InfernoType
t) -> Doc ann
"implicit" forall ann. Doc ann -> Doc ann -> Doc ann
<+> case Either Int Text
idt of { Left Int
i -> Doc ann
"var$" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Int
i; Right Text
i -> forall a ann. Pretty a => a -> Doc ann
pretty Text
i } forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
":" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty InfernoType
t)) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toList Map ExtIdent InfernoType
impl)
        forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"⇒"
        forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty InfernoType
ty

instance Pretty Scheme where
  pretty :: forall ann. Scheme -> Doc ann
pretty (Forall [TV]
_ ImplType
implType) = forall a ann. Pretty a => a -> Doc ann
pretty ImplType
implType

instance Pretty TypeClass where
  pretty :: forall ann. TypeClass -> Doc ann
pretty = \case
    TypeClass Text
nm [InfernoType]
tys -> forall a ann. Pretty a => a -> Doc ann
pretty Text
nm forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"on" forall ann. Doc ann -> Doc ann -> Doc ann
<+> (forall ann. [Doc ann] -> Doc ann
hsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {ann}. InfernoType -> Doc ann
bracketPretty [InfernoType]
tys)
    where
      bracketPretty :: InfernoType -> Doc ann
bracketPretty InfernoType
ty = case InfernoType
ty of
        TVar TV
_ -> forall a ann. Pretty a => a -> Doc ann
pretty InfernoType
ty
        TBase BaseType
_ -> forall a ann. Pretty a => a -> Doc ann
pretty InfernoType
ty
        InfernoType
_ -> forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann
enclose forall ann. Doc ann
lparen forall ann. Doc ann
rparen forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty InfernoType
ty

newtype TypeClassShape = TypeClassShape TypeClass

instance Pretty TypeClassShape where
  pretty :: forall ann. TypeClassShape -> Doc ann
pretty = \case
    TypeClassShape (TypeClass Text
nm [InfernoType]
tys) -> forall a ann. Pretty a => a -> Doc ann
pretty Text
nm forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"on" forall ann. Doc ann -> Doc ann -> Doc ann
<+> (forall ann. [Doc ann] -> Doc ann
hsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {ann}. InfernoType -> Doc ann
bracketPretty [InfernoType]
tys)
    where
      bracketPretty :: InfernoType -> Doc ann
bracketPretty InfernoType
ty = case InfernoType
ty of
        TVar TV
_ -> Doc ann
"_"
        TBase BaseType
_ -> forall a ann. Pretty a => a -> Doc ann
pretty InfernoType
ty
        InfernoType
_ -> forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann
enclose forall ann. Doc ann
lparen forall ann. Doc ann
rparen forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty InfernoType
ty

instance Pretty TCScheme where
  pretty :: forall ann. TCScheme -> Doc ann
pretty (ForallTC [TV]
_ Set TypeClass
tcs (ImplType Map ExtIdent InfernoType
impl InfernoType
ty))
    | forall k a. Map k a -> Bool
Map.null Map ExtIdent InfernoType
impl Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set TypeClass
tcs = forall a ann. Pretty a => a -> Doc ann
pretty InfernoType
ty
    | Bool
otherwise =
      forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
encloseSep
        forall ann. Doc ann
lbrace
        forall ann. Doc ann
rbrace
        forall ann. Doc ann
comma
        ( (forall a b. (a -> b) -> [a] -> [b]
map ((Doc ann
"requires" forall ann. Doc ann -> Doc ann -> Doc ann
<+>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty) forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toList Set TypeClass
tcs)
            forall a. [a] -> [a] -> [a]
++ (forall a b. (a -> b) -> [a] -> [b]
map (\(ExtIdent Either Int Text
idt, InfernoType
t) -> Doc ann
"implicit" forall ann. Doc ann -> Doc ann -> Doc ann
<+> case Either Int Text
idt of { Left Int
i -> Doc ann
"var$" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Int
i; Right Text
i -> forall a ann. Pretty a => a -> Doc ann
pretty Text
i } forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
":" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty InfernoType
t)) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toList Map ExtIdent InfernoType
impl)
        )
        forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"⇒"
        forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty InfernoType
ty

newtype Subst = Subst (Map.Map TV InfernoType)
  deriving stock (Subst -> Subst -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Subst -> Subst -> Bool
$c/= :: Subst -> Subst -> Bool
== :: Subst -> Subst -> Bool
$c== :: Subst -> Subst -> Bool
Eq, Eq Subst
Subst -> Subst -> Bool
Subst -> Subst -> Ordering
Subst -> Subst -> Subst
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Subst -> Subst -> Subst
$cmin :: Subst -> Subst -> Subst
max :: Subst -> Subst -> Subst
$cmax :: Subst -> Subst -> Subst
>= :: Subst -> Subst -> Bool
$c>= :: Subst -> Subst -> Bool
> :: Subst -> Subst -> Bool
$c> :: Subst -> Subst -> Bool
<= :: Subst -> Subst -> Bool
$c<= :: Subst -> Subst -> Bool
< :: Subst -> Subst -> Bool
$c< :: Subst -> Subst -> Bool
compare :: Subst -> Subst -> Ordering
$ccompare :: Subst -> Subst -> Ordering
Ord)
  deriving newtype (NonEmpty Subst -> Subst
Subst -> Subst -> Subst
forall b. Integral b => b -> Subst -> Subst
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Subst -> Subst
$cstimes :: forall b. Integral b => b -> Subst -> Subst
sconcat :: NonEmpty Subst -> Subst
$csconcat :: NonEmpty Subst -> Subst
<> :: Subst -> Subst -> Subst
$c<> :: Subst -> Subst -> Subst
Semigroup, Semigroup Subst
Subst
[Subst] -> Subst
Subst -> Subst -> Subst
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Subst] -> Subst
$cmconcat :: [Subst] -> Subst
mappend :: Subst -> Subst -> Subst
$cmappend :: Subst -> Subst -> Subst
mempty :: Subst
$cmempty :: Subst
Monoid)

instance Show Subst where
  show :: Subst -> String
show (Subst Map TV InfernoType
m) = forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(TV
x, InfernoType
t) -> Text -> String
unpack forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> Text
renderPretty TV
x forall a. Semigroup a => a -> a -> a
<> Text
" ~> " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
renderPretty InfernoType
t) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toList Map TV InfernoType
m

class Substitutable a where
  apply :: Subst -> a -> a
  ftv :: a -> Set.Set TV

instance Substitutable InfernoType where
  apply :: Subst -> InfernoType -> InfernoType
apply Subst
_ (TBase BaseType
a) = BaseType -> InfernoType
TBase BaseType
a
  apply (Subst Map TV InfernoType
s) t :: InfernoType
t@(TVar TV
a) = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault InfernoType
t TV
a Map TV InfernoType
s
  apply Subst
s (InfernoType
t1 `TArr` InfernoType
t2) = forall a. Substitutable a => Subst -> a -> a
apply Subst
s InfernoType
t1 InfernoType -> InfernoType -> InfernoType
`TArr` forall a. Substitutable a => Subst -> a -> a
apply Subst
s InfernoType
t2
  apply Subst
s (TArray InfernoType
t) = InfernoType -> InfernoType
TArray forall a b. (a -> b) -> a -> b
$ forall a. Substitutable a => Subst -> a -> a
apply Subst
s InfernoType
t
  apply Subst
s (TSeries InfernoType
t) = InfernoType -> InfernoType
TSeries forall a b. (a -> b) -> a -> b
$ forall a. Substitutable a => Subst -> a -> a
apply Subst
s InfernoType
t
  apply Subst
s (TOptional InfernoType
t) = InfernoType -> InfernoType
TOptional forall a b. (a -> b) -> a -> b
$ forall a. Substitutable a => Subst -> a -> a
apply Subst
s InfernoType
t
  apply Subst
s (TTuple TList InfernoType
ts) = TList InfernoType -> InfernoType
TTuple forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Substitutable a => Subst -> a -> a
apply Subst
s) TList InfernoType
ts
  apply Subst
s (TRep InfernoType
t) = InfernoType -> InfernoType
TRep forall a b. (a -> b) -> a -> b
$ forall a. Substitutable a => Subst -> a -> a
apply Subst
s InfernoType
t

  ftv :: InfernoType -> Set TV
ftv TBase {} = forall a. Set a
Set.empty
  ftv (TVar TV
a) = forall a. a -> Set a
Set.singleton TV
a
  ftv (InfernoType
t1 `TArr` InfernoType
t2) = forall a. Substitutable a => a -> Set TV
ftv InfernoType
t1 forall a. Ord a => Set a -> Set a -> Set a
`Set.union` forall a. Substitutable a => a -> Set TV
ftv InfernoType
t2
  ftv (TArray InfernoType
t) = forall a. Substitutable a => a -> Set TV
ftv InfernoType
t
  ftv (TSeries InfernoType
t) = forall a. Substitutable a => a -> Set TV
ftv InfernoType
t
  ftv (TOptional InfernoType
t) = forall a. Substitutable a => a -> Set TV
ftv InfernoType
t
  ftv (TTuple TList InfernoType
ts) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Ord a => Set a -> Set a -> Set a
Set.union forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Substitutable a => a -> Set TV
ftv) forall a. Set a
Set.empty TList InfernoType
ts
  ftv (TRep InfernoType
t) = forall a. Substitutable a => a -> Set TV
ftv InfernoType
t

instance Substitutable ImplType where
  apply :: Subst -> ImplType -> ImplType
apply Subst
s (ImplType Map ExtIdent InfernoType
impl InfernoType
t) =
    Map ExtIdent InfernoType -> InfernoType -> ImplType
ImplType (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (forall a. Substitutable a => Subst -> a -> a
apply Subst
s) Map ExtIdent InfernoType
impl) forall a b. (a -> b) -> a -> b
$ forall a. Substitutable a => Subst -> a -> a
apply Subst
s InfernoType
t
  ftv :: ImplType -> Set TV
ftv (ImplType Map ExtIdent InfernoType
impl InfernoType
t) = (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Ord a => Set a -> Set a -> Set a
Set.union forall a. Set a
Set.empty forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. Substitutable a => a -> Set TV
ftv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toList Map ExtIdent InfernoType
impl) forall a. Ord a => Set a -> Set a -> Set a
`Set.union` forall a. Substitutable a => a -> Set TV
ftv InfernoType
t

instance Substitutable TypeClass where
  apply :: Subst -> TypeClass -> TypeClass
apply Subst
s (TypeClass Text
n [InfernoType]
tys) = Text -> [InfernoType] -> TypeClass
TypeClass Text
n forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. Substitutable a => Subst -> a -> a
apply Subst
s) [InfernoType]
tys
  ftv :: TypeClass -> Set TV
ftv (TypeClass Text
_ [InfernoType]
tys) = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Substitutable a => a -> Set TV
ftv [InfernoType]
tys

instance Substitutable TCScheme where
  apply :: Subst -> TCScheme -> TCScheme
apply (Subst Map TV InfernoType
s) (ForallTC [TV]
as Set TypeClass
tcs ImplType
t) = [TV] -> Set TypeClass -> ImplType -> TCScheme
ForallTC [TV]
as (forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (forall a. Substitutable a => Subst -> a -> a
apply Subst
s') Set TypeClass
tcs) (forall a. Substitutable a => Subst -> a -> a
apply Subst
s' ImplType
t)
    where
      s' :: Subst
s' = Map TV InfernoType -> Subst
Subst forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Map TV InfernoType
s [TV]
as
  ftv :: TCScheme -> Set TV
ftv (ForallTC [TV]
as Set TypeClass
tcs ImplType
t) = ((forall a. Substitutable a => a -> Set TV
ftv ImplType
t) forall a. Ord a => Set a -> Set a -> Set a
`Set.union` (forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.elems forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map forall a. Substitutable a => a -> Set TV
ftv Set TypeClass
tcs)) forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` forall a. Ord a => [a] -> Set a
Set.fromList [TV]
as

instance Substitutable a => Substitutable [a] where
  apply :: Subst -> [a] -> [a]
apply = forall a b. (a -> b) -> [a] -> [b]
map forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Substitutable a => Subst -> a -> a
apply
  ftv :: [a] -> Set TV
ftv = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Ord a => Set a -> Set a -> Set a
Set.union forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Substitutable a => a -> Set TV
ftv) forall a. Set a
Set.empty

data Namespace
  = FunNamespace Ident
  | OpNamespace Ident
  | EnumNamespace Ident
  | ModuleNamespace ModuleName
  | TypeNamespace Ident
  deriving (Namespace -> Namespace -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Namespace -> Namespace -> Bool
$c/= :: Namespace -> Namespace -> Bool
== :: Namespace -> Namespace -> Bool
$c== :: Namespace -> Namespace -> Bool
Eq, Int -> Namespace -> ShowS
[Namespace] -> ShowS
Namespace -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Namespace] -> ShowS
$cshowList :: [Namespace] -> ShowS
show :: Namespace -> String
$cshow :: Namespace -> String
showsPrec :: Int -> Namespace -> ShowS
$cshowsPrec :: Int -> Namespace -> ShowS
Show, Eq Namespace
Namespace -> Namespace -> Bool
Namespace -> Namespace -> Ordering
Namespace -> Namespace -> Namespace
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Namespace -> Namespace -> Namespace
$cmin :: Namespace -> Namespace -> Namespace
max :: Namespace -> Namespace -> Namespace
$cmax :: Namespace -> Namespace -> Namespace
>= :: Namespace -> Namespace -> Bool
$c>= :: Namespace -> Namespace -> Bool
> :: Namespace -> Namespace -> Bool
$c> :: Namespace -> Namespace -> Bool
<= :: Namespace -> Namespace -> Bool
$c<= :: Namespace -> Namespace -> Bool
< :: Namespace -> Namespace -> Bool
$c< :: Namespace -> Namespace -> Bool
compare :: Namespace -> Namespace -> Ordering
$ccompare :: Namespace -> Namespace -> Ordering
Ord, forall x. Rep Namespace x -> Namespace
forall x. Namespace -> Rep Namespace x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Namespace x -> Namespace
$cfrom :: forall x. Namespace -> Rep Namespace x
Generic, [Namespace] -> Encoding
[Namespace] -> Value
Namespace -> Encoding
Namespace -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Namespace] -> Encoding
$ctoEncodingList :: [Namespace] -> Encoding
toJSONList :: [Namespace] -> Value
$ctoJSONList :: [Namespace] -> Value
toEncoding :: Namespace -> Encoding
$ctoEncoding :: Namespace -> Encoding
toJSON :: Namespace -> Value
$ctoJSON :: Namespace -> Value
ToJSON, Value -> Parser [Namespace]
Value -> Parser Namespace
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Namespace]
$cparseJSONList :: Value -> Parser [Namespace]
parseJSON :: Value -> Parser Namespace
$cparseJSON :: Value -> Parser Namespace
FromJSON, Proxy Namespace -> Gen (ADTArbitrarySingleton Namespace)
Proxy Namespace -> Gen (ADTArbitrary Namespace)
forall a.
(Proxy a -> Gen (ADTArbitrarySingleton a))
-> (Proxy a -> Gen (ADTArbitrary a)) -> ToADTArbitrary a
toADTArbitrary :: Proxy Namespace -> Gen (ADTArbitrary Namespace)
$ctoADTArbitrary :: Proxy Namespace -> Gen (ADTArbitrary Namespace)
toADTArbitrarySingleton :: Proxy Namespace -> Gen (ADTArbitrarySingleton Namespace)
$ctoADTArbitrarySingleton :: Proxy Namespace -> Gen (ADTArbitrarySingleton Namespace)
ToADTArbitrary)

instance Pretty Namespace where
  pretty :: forall ann. Namespace -> Doc ann
pretty = \case
    FunNamespace (Ident Text
i) -> forall a ann. Pretty a => a -> Doc ann
pretty Text
i
    OpNamespace (Ident Text
i) -> forall a ann. Pretty a => a -> Doc ann
pretty Text
i
    EnumNamespace (Ident Text
i) -> Doc ann
"#" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Text
i
    ModuleNamespace (ModuleName Text
m) -> forall a ann. Pretty a => a -> Doc ann
pretty Text
m
    TypeNamespace (Ident Text
i) -> forall a ann. Pretty a => a -> Doc ann
pretty Text
i

instance Arbitrary Namespace where
  arbitrary :: Gen Namespace
arbitrary =
    forall a. [Gen a] -> Gen a
oneof
      [ Ident -> Namespace
FunNamespace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary,
        Ident -> Namespace
OpNamespace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary,
        Ident -> Namespace
EnumNamespace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary,
        ModuleName -> Namespace
ModuleNamespace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary,
        Ident -> Namespace
TypeNamespace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
      ]

namespaceToIdent :: Namespace -> Ident
namespaceToIdent :: Namespace -> Ident
namespaceToIdent = \case
  FunNamespace Ident
i -> Ident
i
  OpNamespace Ident
i -> Ident
i
  EnumNamespace Ident
i -> Ident
i
  TypeNamespace Ident
i -> Ident
i
  ModuleNamespace ModuleName
_ -> forall a. HasCallStack => String -> a
error String
"namespaceToIdent undefined for ModuleNamespace"

data TypeMetadata ty = TypeMetadata
  { forall ty. TypeMetadata ty -> Expr () ()
identExpr :: Expr () (),
    forall ty. TypeMetadata ty -> Maybe Text
docs :: Maybe Text,
    forall ty. TypeMetadata ty -> ty
ty :: ty
  }
  deriving (TypeMetadata ty -> TypeMetadata ty -> Bool
forall ty. Eq ty => TypeMetadata ty -> TypeMetadata ty -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeMetadata ty -> TypeMetadata ty -> Bool
$c/= :: forall ty. Eq ty => TypeMetadata ty -> TypeMetadata ty -> Bool
== :: TypeMetadata ty -> TypeMetadata ty -> Bool
$c== :: forall ty. Eq ty => TypeMetadata ty -> TypeMetadata ty -> Bool
Eq, Int -> TypeMetadata ty -> ShowS
forall ty. Show ty => Int -> TypeMetadata ty -> ShowS
forall ty. Show ty => [TypeMetadata ty] -> ShowS
forall ty. Show ty => TypeMetadata ty -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeMetadata ty] -> ShowS
$cshowList :: forall ty. Show ty => [TypeMetadata ty] -> ShowS
show :: TypeMetadata ty -> String
$cshow :: forall ty. Show ty => TypeMetadata ty -> String
showsPrec :: Int -> TypeMetadata ty -> ShowS
$cshowsPrec :: forall ty. Show ty => Int -> TypeMetadata ty -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall ty x. Rep (TypeMetadata ty) x -> TypeMetadata ty
forall ty x. TypeMetadata ty -> Rep (TypeMetadata ty) x
$cto :: forall ty x. Rep (TypeMetadata ty) x -> TypeMetadata ty
$cfrom :: forall ty x. TypeMetadata ty -> Rep (TypeMetadata ty) x
Generic, TypeMetadata ty -> DataType
TypeMetadata ty -> Constr
forall {ty}. Data ty => Typeable (TypeMetadata ty)
forall ty. Data ty => TypeMetadata ty -> DataType
forall ty. Data ty => TypeMetadata ty -> Constr
forall ty.
Data ty =>
(forall b. Data b => b -> b) -> TypeMetadata ty -> TypeMetadata ty
forall ty u.
Data ty =>
Int -> (forall d. Data d => d -> u) -> TypeMetadata ty -> u
forall ty u.
Data ty =>
(forall d. Data d => d -> u) -> TypeMetadata ty -> [u]
forall ty r r'.
Data ty =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeMetadata ty -> r
forall ty r r'.
Data ty =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeMetadata ty -> r
forall ty (m :: * -> *).
(Data ty, Monad m) =>
(forall d. Data d => d -> m d)
-> TypeMetadata ty -> m (TypeMetadata ty)
forall ty (m :: * -> *).
(Data ty, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> TypeMetadata ty -> m (TypeMetadata ty)
forall ty (c :: * -> *).
Data ty =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (TypeMetadata ty)
forall ty (c :: * -> *).
Data ty =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeMetadata ty -> c (TypeMetadata ty)
forall ty (t :: * -> *) (c :: * -> *).
(Data ty, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (TypeMetadata ty))
forall ty (t :: * -> * -> *) (c :: * -> *).
(Data ty, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (TypeMetadata ty))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (TypeMetadata ty)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeMetadata ty -> c (TypeMetadata ty)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (TypeMetadata ty))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TypeMetadata ty -> m (TypeMetadata ty)
$cgmapMo :: forall ty (m :: * -> *).
(Data ty, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> TypeMetadata ty -> m (TypeMetadata ty)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TypeMetadata ty -> m (TypeMetadata ty)
$cgmapMp :: forall ty (m :: * -> *).
(Data ty, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> TypeMetadata ty -> m (TypeMetadata ty)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TypeMetadata ty -> m (TypeMetadata ty)
$cgmapM :: forall ty (m :: * -> *).
(Data ty, Monad m) =>
(forall d. Data d => d -> m d)
-> TypeMetadata ty -> m (TypeMetadata ty)
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> TypeMetadata ty -> u
$cgmapQi :: forall ty u.
Data ty =>
Int -> (forall d. Data d => d -> u) -> TypeMetadata ty -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> TypeMetadata ty -> [u]
$cgmapQ :: forall ty u.
Data ty =>
(forall d. Data d => d -> u) -> TypeMetadata ty -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeMetadata ty -> r
$cgmapQr :: forall ty r r'.
Data ty =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeMetadata ty -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeMetadata ty -> r
$cgmapQl :: forall ty r r'.
Data ty =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeMetadata ty -> r
gmapT :: (forall b. Data b => b -> b) -> TypeMetadata ty -> TypeMetadata ty
$cgmapT :: forall ty.
Data ty =>
(forall b. Data b => b -> b) -> TypeMetadata ty -> TypeMetadata ty
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (TypeMetadata ty))
$cdataCast2 :: forall ty (t :: * -> * -> *) (c :: * -> *).
(Data ty, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (TypeMetadata ty))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (TypeMetadata ty))
$cdataCast1 :: forall ty (t :: * -> *) (c :: * -> *).
(Data ty, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (TypeMetadata ty))
dataTypeOf :: TypeMetadata ty -> DataType
$cdataTypeOf :: forall ty. Data ty => TypeMetadata ty -> DataType
toConstr :: TypeMetadata ty -> Constr
$ctoConstr :: forall ty. Data ty => TypeMetadata ty -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (TypeMetadata ty)
$cgunfold :: forall ty (c :: * -> *).
Data ty =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (TypeMetadata ty)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeMetadata ty -> c (TypeMetadata ty)
$cgfoldl :: forall ty (c :: * -> *).
Data ty =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeMetadata ty -> c (TypeMetadata ty)
Data, forall ty. ToJSON ty => [TypeMetadata ty] -> Encoding
forall ty. ToJSON ty => [TypeMetadata ty] -> Value
forall ty. ToJSON ty => TypeMetadata ty -> Encoding
forall ty. ToJSON ty => TypeMetadata ty -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [TypeMetadata ty] -> Encoding
$ctoEncodingList :: forall ty. ToJSON ty => [TypeMetadata ty] -> Encoding
toJSONList :: [TypeMetadata ty] -> Value
$ctoJSONList :: forall ty. ToJSON ty => [TypeMetadata ty] -> Value
toEncoding :: TypeMetadata ty -> Encoding
$ctoEncoding :: forall ty. ToJSON ty => TypeMetadata ty -> Encoding
toJSON :: TypeMetadata ty -> Value
$ctoJSON :: forall ty. ToJSON ty => TypeMetadata ty -> Value
ToJSON, forall ty. FromJSON ty => Value -> Parser [TypeMetadata ty]
forall ty. FromJSON ty => Value -> Parser (TypeMetadata ty)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [TypeMetadata ty]
$cparseJSONList :: forall ty. FromJSON ty => Value -> Parser [TypeMetadata ty]
parseJSON :: Value -> Parser (TypeMetadata ty)
$cparseJSON :: forall ty. FromJSON ty => Value -> Parser (TypeMetadata ty)
FromJSON)