-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Derive.TopDown.CxtGen
-- Copyright   :  (c) Song Zhang
-- License     :  BSD-style (see the LICENSE file)
-- 
-- Maintainer  :  haskell.zhang.song `at` hotmail.com
-- Stability   :  experimental
-- Portability :  non-portable
--
-----------------------------------------------------------------------------
module Data.Derive.TopDown.CxtGen
  ( genInferredContext
  , genHoleContext
  , genAllFieldsContext
  ) where

{-
-- This module contains functions with type ClassName -> TypeName -> Type

    There are 2 ways 
    1. deriving by making the context with all wholes with @PartialTypeSignatures@

    ```
    deriving instance _ => Eq (A a)

    ```
    
    2. deriving by generate the class context which can handle type family
-}

import           Control.Applicative
import           Control.Exception
import           Control.Monad
import           Control.Monad.State
import qualified Control.Monad.Trans           as T
import           Data.Derive.TopDown.Lib
import qualified Data.List                     as L
import qualified Data.Map                      as M
import           Data.Map                       ( (!)
                                                , delete
                                                , insert
                                                )
import           Data.Map                       ( Map )
import           Data.Maybe
import qualified Data.Set                      as S
import           Data.Set                       ( Set )
import           GHC.Generics
import           Language.Haskell.TH

data Env = Env
  { Env -> [ClassName]
inferring    :: [Name]             -- ^ encountered types during infer process
  , Env -> Map ClassName [ClassName]
parameters   :: Map Name [Name]      -- ^ type parameters list
  , Env -> Map ClassName (Set Type)
fields       :: Map Name (Set Type)  -- ^ the context
  , Env -> Map ClassName (Map Type [(Type, Type)])
substitution :: Map Name (Map Type [(Type, Type)])   -- ^ caller indexed substitution
  , Env -> Map ClassName (Set Type)
inferred     :: Map Name (Set Type)  -- ^ inferred context of types
  }
  deriving (Env -> Env -> Bool
(Env -> Env -> Bool) -> (Env -> Env -> Bool) -> Eq Env
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Env -> Env -> Bool
== :: Env -> Env -> Bool
$c/= :: Env -> Env -> Bool
/= :: Env -> Env -> Bool
Eq, Int -> Env -> ShowS
[Env] -> ShowS
Env -> String
(Int -> Env -> ShowS)
-> (Env -> String) -> ([Env] -> ShowS) -> Show Env
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Env -> ShowS
showsPrec :: Int -> Env -> ShowS
$cshow :: Env -> String
show :: Env -> String
$cshowList :: [Env] -> ShowS
showList :: [Env] -> ShowS
Show)

putSubst :: Name -> Type -> [(Type, Type)] -> Env -> Env
putSubst :: ClassName -> Type -> [(Type, Type)] -> Env -> Env
putSubst ClassName
n Type
t [(Type, Type)]
s Env
e =
  let subs :: Map ClassName (Map Type [(Type, Type)])
subs = Env -> Map ClassName (Map Type [(Type, Type)])
substitution Env
e
  in  if ClassName -> Map ClassName (Map Type [(Type, Type)]) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member ClassName
n Map ClassName (Map Type [(Type, Type)])
subs
        then
          -- find the its t2tt and insert
          let new_t2tt :: Map Type [(Type, Type)]
new_t2tt = Type
-> [(Type, Type)]
-> Map Type [(Type, Type)]
-> Map Type [(Type, Type)]
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Type
t [(Type, Type)]
s (Map ClassName (Map Type [(Type, Type)])
subs Map ClassName (Map Type [(Type, Type)])
-> ClassName -> Map Type [(Type, Type)]
forall k a. Ord k => Map k a -> k -> a
! ClassName
n)
          in  Env
e { substitution :: Map ClassName (Map Type [(Type, Type)])
substitution = ClassName
-> Map Type [(Type, Type)]
-> Map ClassName (Map Type [(Type, Type)])
-> Map ClassName (Map Type [(Type, Type)])
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ClassName
n Map Type [(Type, Type)]
new_t2tt Map ClassName (Map Type [(Type, Type)])
subs }
        else Env
e { substitution :: Map ClassName (Map Type [(Type, Type)])
substitution = ClassName
-> Map Type [(Type, Type)]
-> Map ClassName (Map Type [(Type, Type)])
-> Map ClassName (Map Type [(Type, Type)])
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ClassName
n (Type -> [(Type, Type)] -> Map Type [(Type, Type)]
forall k a. k -> a -> Map k a
M.singleton Type
t [(Type, Type)]
s) Map ClassName (Map Type [(Type, Type)])
subs }

putInferringType :: Name -> Env -> Env
putInferringType :: ClassName -> Env -> Env
putInferringType ClassName
n Env
e = Env
e { inferring :: [ClassName]
inferring = ClassName
n ClassName -> [ClassName] -> [ClassName]
forall a. a -> [a] -> [a]
: Env -> [ClassName]
inferring Env
e }

putParameters :: Name -> [Name] -> Env -> Env
putParameters :: ClassName -> [ClassName] -> Env -> Env
putParameters ClassName
n [ClassName]
ns Env
e = Env
e { parameters :: Map ClassName [ClassName]
parameters = ClassName
-> [ClassName]
-> Map ClassName [ClassName]
-> Map ClassName [ClassName]
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ClassName
n [ClassName]
ns (Env -> Map ClassName [ClassName]
parameters Env
e) }

putFields :: Name -> Set Type -> Env -> Env
putFields :: ClassName -> Set Type -> Env -> Env
putFields ClassName
n Set Type
ts Env
e = Env
e { fields :: Map ClassName (Set Type)
fields = ClassName
-> Set Type -> Map ClassName (Set Type) -> Map ClassName (Set Type)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ClassName
n Set Type
ts (Env -> Map ClassName (Set Type)
fields Env
e) }


deleteInferring :: Name -> Env -> Env
deleteInferring :: ClassName -> Env -> Env
deleteInferring ClassName
n Env
e = Env
e { inferring :: [ClassName]
inferring = ClassName -> [ClassName] -> [ClassName]
forall a. Eq a => a -> [a] -> [a]
L.delete ClassName
n (Env -> [ClassName]
inferring Env
e) }

moveFieldsToInferred :: Name -> Env -> Env
moveFieldsToInferred :: ClassName -> Env -> Env
moveFieldsToInferred ClassName
n Env
e =
  let ts :: Set Type
ts = Env -> Map ClassName (Set Type)
fields Env
e Map ClassName (Set Type) -> ClassName -> Set Type
forall k a. Ord k => Map k a -> k -> a
! ClassName
n
      f' :: Map ClassName (Set Type)
f' = ClassName -> Map ClassName (Set Type) -> Map ClassName (Set Type)
forall k a. Ord k => k -> Map k a -> Map k a
delete ClassName
n (Env -> Map ClassName (Set Type)
fields Env
e)
      i' :: Map ClassName (Set Type)
i' = ClassName
-> Set Type -> Map ClassName (Set Type) -> Map ClassName (Set Type)
forall k a. Ord k => k -> a -> Map k a -> Map k a
insert ClassName
n Set Type
ts (Env -> Map ClassName (Set Type)
inferred Env
e)
  in  Env
e { fields :: Map ClassName (Set Type)
fields = Map ClassName (Set Type)
f', inferred :: Map ClassName (Set Type)
inferred = Map ClassName (Set Type)
i' }

-- | Context Infer Monad
type CIM a = StateT Env Q a

initEnv :: Env
initEnv :: Env
initEnv = Env { inferring :: [ClassName]
inferring    = []
              , parameters :: Map ClassName [ClassName]
parameters   = Map ClassName [ClassName]
forall k a. Map k a
M.empty
              , fields :: Map ClassName (Set Type)
fields       = Map ClassName (Set Type)
forall k a. Map k a
M.empty
              , substitution :: Map ClassName (Map Type [(Type, Type)])
substitution = Map ClassName (Map Type [(Type, Type)])
forall k a. Map k a
M.empty
              , inferred :: Map ClassName (Set Type)
inferred     = Map ClassName (Set Type)
forall k a. Map k a
M.empty
              }

isWholeTypeContext :: Type -> Q Bool
isWholeTypeContext :: Type -> Q Bool
isWholeTypeContext (VarT ClassName
_) = Bool -> Q Bool
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
-- TODO: Here I will not rewrite fully applied type family
-- and just put the type family application into context.
-- In the future it should be changed.
isWholeTypeContext Type
v =
  Bool -> Bool -> Bool
(||) (Bool -> Bool -> Bool) -> Q Bool -> Q (Bool -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Q Bool
isLeftMostAppTTypeFamily Type
v Q (Bool -> Bool) -> Q Bool -> Q Bool
forall a b. Q (a -> b) -> Q a -> Q b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> Q Bool
isLeftMostAppTTypeVar Type
v

doesFieldContainPotentialContext :: Type -> Q Bool
doesFieldContainPotentialContext :: Type -> Q Bool
doesFieldContainPotentialContext Type
t = case Type
t of
  ForallT [TyVarBndr Specificity]
_ Cxt
_ Type
_        -> Bool -> Q Bool
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
#if __GLASGOW_HASKELL__ >= 810
  ForallVisT [TyVarBndr ()]
_       Type
_ -> Bool -> Q Bool
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
#endif
  a :: Type
a@(        AppT Type
_ Type
_) -> do
    Bool
is_ty_fam_or_var <-
      Bool -> Bool -> Bool
(||) (Bool -> Bool -> Bool) -> Q Bool -> Q (Bool -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Q Bool
isLeftMostAppTTypeFamily Type
a Q (Bool -> Bool) -> Q Bool -> Q Bool
forall a b. Q (a -> b) -> Q a -> Q b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> Q Bool
isLeftMostAppTTypeVar Type
a
    if Bool
is_ty_fam_or_var
      then Bool -> Q Bool
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
      -- if it not var then it can be tuple, list, ConT
      -- for those types if no type variables such as 
      -- (Int, Bool), Maybe Char in it then it should not be
      -- in the context.
      else if [ClassName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([ClassName] -> Bool) -> [ClassName] -> Bool
forall a b. (a -> b) -> a -> b
$ Type -> [ClassName]
forall a. Data a => a -> [ClassName]
getAllVarNames Type
t then Bool -> Q Bool
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False else Bool -> Q Bool
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
#if __GLASGOW_HASKELL__ >= 808
  AppKindT Type
ty Type
_  -> Type -> Q Bool
doesFieldContainPotentialContext Type
ty
#endif
  SigT     Type
ty Type
_  -> Type -> Q Bool
doesFieldContainPotentialContext Type
ty
  VarT      ClassName
_    -> Bool -> Q Bool
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
  ConT      ClassName
_    -> Bool -> Q Bool
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  PromotedT ClassName
_    -> String -> Q Bool
forall a. HasCallStack => String -> a
error String
"impossible field for PromotedT"
  InfixT Type
t1 ClassName
_ Type
t2 -> (Bool -> Bool -> Bool) -> Q Bool -> Q Bool -> Q Bool
forall a b c. (a -> b -> c) -> Q a -> Q b -> Q c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(||)
                           (Type -> Q Bool
doesFieldContainPotentialContext Type
t1)
                           (Type -> Q Bool
doesFieldContainPotentialContext Type
t2)
  UInfixT         Type
_ ClassName
_ Type
_ -> String -> Q Bool
forall a. HasCallStack => String -> a
error String
"impossible field for UInfixT"
#if __GLASGOW_HASKELL__ >= 904
  PromotedInfixT  Type
_ ClassName
_ Type
_ -> String -> Q Bool
forall a. HasCallStack => String -> a
error String
"impossible field for PromotedInfixT"
  PromotedUInfixT Type
_ ClassName
_ Type
_ -> String -> Q Bool
forall a. HasCallStack => String -> a
error String
"impossible field for PromotedUInfixT"
#endif
  ParensT       Type
ty      -> Type -> Q Bool
doesFieldContainPotentialContext Type
ty
  TupleT        Int
_       -> String -> Q Bool
forall a. HasCallStack => String -> a
error String
"impossible field for TupleT"
  UnboxedTupleT Int
_       -> String -> Q Bool
forall a. HasCallStack => String -> a
error String
"impossible field for UnboxedTupleT"
  UnboxedSumT   Int
_       -> String -> Q Bool
forall a. HasCallStack => String -> a
error String
"impossible field for UnboxedSumT"
  Type
ArrowT                -> Q Bool
forall a. HasCallStack => a
undefined -- should put app of Arrow into context?
#if __GLASGOW_HASKELL__ >= 900
  Type
MulArrowT             -> Q Bool
forall a. HasCallStack => a
undefined
#endif
  Type
EqualityT             -> String -> Q Bool
forall a. HasCallStack => String -> a
error String
"impossible field for EqualityT"
  Type
ListT                 -> String -> Q Bool
forall a. HasCallStack => String -> a
error String
"impossible field for ListT"
  PromotedTupleT Int
_      -> String -> Q Bool
forall a. HasCallStack => String -> a
error String
"impossible field for PromotedTupleT"
  Type
PromotedNilT          -> String -> Q Bool
forall a. HasCallStack => String -> a
error String
"impossible field for PromotedNilT"
  Type
PromotedConsT         -> String -> Q Bool
forall a. HasCallStack => String -> a
error String
"impossible field for PromotedConsT"
  Type
StarT                 -> String -> Q Bool
forall a. HasCallStack => String -> a
error String
"impossible field for StarT"
  Type
ConstraintT           -> String -> Q Bool
forall a. HasCallStack => String -> a
error String
"impossible field for ConstraintT"
  LitT TyLit
_                -> String -> Q Bool
forall a. HasCallStack => String -> a
error String
"impossible field for LitT"
  Type
WildCardT             -> String -> Q Bool
forall a. HasCallStack => String -> a
error String
"impossible field for WildCardT"
#if __GLASGOW_HASKELL__ >= 808
  ImplicitParamT String
_ Type
_    -> String -> Q Bool
forall a. HasCallStack => String -> a
error String
"impossible field for ImplicitParamT"
#endif

-- | a lazily applied type paramters lookup function
getParams :: TypeName -> CIM [Name]
getParams :: ClassName -> CIM [ClassName]
getParams ClassName
tn = do
  Env
env <- StateT Env Q Env
forall s (m :: * -> *). MonadState s m => m s
get
  let n2p :: Map ClassName [ClassName]
n2p = Env -> Map ClassName [ClassName]
parameters Env
env
  if ClassName -> Map ClassName [ClassName] -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member ClassName
tn Map ClassName [ClassName]
n2p
    then [ClassName] -> CIM [ClassName]
forall a. a -> StateT Env Q a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ClassName] -> CIM [ClassName]) -> [ClassName] -> CIM [ClassName]
forall a b. (a -> b) -> a -> b
$ Map ClassName [ClassName]
n2p Map ClassName [ClassName] -> ClassName -> [ClassName]
forall k a. Ord k => Map k a -> k -> a
! ClassName
tn
    else do
      ([TyVarBndr ()]
tvs, Cxt
_) <- Q ([TyVarBndr ()], Cxt) -> StateT Env Q ([TyVarBndr ()], Cxt)
forall (m :: * -> *) a. Monad m => m a -> StateT Env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
T.lift (ClassName -> Q ([TyVarBndr ()], Cxt)
getTyVarFields ClassName
tn)
      let tv_names :: [ClassName]
tv_names = (TyVarBndr () -> ClassName) -> [TyVarBndr ()] -> [ClassName]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBndr () -> ClassName
forall a. TyVarBndr a -> ClassName
getTVBName [TyVarBndr ()]
tvs
      (Env -> Env) -> StateT Env Q ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ClassName -> [ClassName] -> Env -> Env
putParameters ClassName
tn [ClassName]
tv_names)
      [ClassName] -> CIM [ClassName]
forall a. a -> StateT Env Q a
forall (m :: * -> *) a. Monad m => a -> m a
return [ClassName]
tv_names

-- find base case of recursive functions
-- handle type synonym?
inferContext :: TypeName -> CIM (Set Type)
inferContext :: ClassName -> CIM (Set Type)
inferContext ClassName
tn = do
  -- check the global context
  Env
env <- StateT Env Q Env
forall s (m :: * -> *). MonadState s m => m s
get
  let it :: Map ClassName (Set Type)
it = Env -> Map ClassName (Set Type)
inferred Env
env
  if ClassName -> Map ClassName (Set Type) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member ClassName
tn Map ClassName (Set Type)
it
    -- already inferred
    then Set Type -> CIM (Set Type)
forall a. a -> StateT Env Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Set Type -> CIM (Set Type)) -> Set Type -> CIM (Set Type)
forall a b. (a -> b) -> a -> b
$ Maybe (Set Type) -> Set Type
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Set Type) -> Set Type) -> Maybe (Set Type) -> Set Type
forall a b. (a -> b) -> a -> b
$ ClassName -> Map ClassName (Set Type) -> Maybe (Set Type)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ClassName
tn Map ClassName (Set Type)
it
    else do
      -- put tn into list of type chain
      (Env -> Env) -> StateT Env Q ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ClassName -> Env -> Env
putInferringType ClassName
tn)
      -- get all cons
      ([TyVarBndr ()]
_, Cxt
all_fields) <- Q ([TyVarBndr ()], Cxt) -> StateT Env Q ([TyVarBndr ()], Cxt)
forall (m :: * -> *) a. Monad m => m a -> StateT Env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ClassName -> Q ([TyVarBndr ()], Cxt)
getTyVarFields ClassName
tn)
      -- get all constructor types and replace all forall quantifiers
      let fs :: Cxt
fs = (Type -> Type) -> Cxt -> Cxt
forall a b. (a -> b) -> [a] -> [b]
map Type -> Type
replaceForallTWithAny Cxt
all_fields
      Cxt
fs_without_type_sym <- Q Cxt -> StateT Env Q Cxt
forall (m :: * -> *) a. Monad m => m a -> StateT Env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q Cxt -> StateT Env Q Cxt) -> Q Cxt -> StateT Env Q Cxt
forall a b. (a -> b) -> a -> b
$ (Type -> Q Type) -> Cxt -> Q Cxt
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Type -> Q Type
noWarnExpandSynsWith Cxt
fs
      Cxt
ts <- Q Cxt -> StateT Env Q Cxt
forall (m :: * -> *) a. Monad m => m a -> StateT Env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q Cxt -> StateT Env Q Cxt) -> Q Cxt -> StateT Env Q Cxt
forall a b. (a -> b) -> a -> b
$ (Type -> Q Bool) -> Cxt -> Q Cxt
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM Type -> Q Bool
doesFieldContainPotentialContext Cxt
fs_without_type_sym
      Bool
all_sat <- Q Bool -> StateT Env Q Bool
forall (m :: * -> *) a. Monad m => m a -> StateT Env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q Bool -> StateT Env Q Bool) -> Q Bool -> StateT Env Q Bool
forall a b. (a -> b) -> a -> b
$ ([Bool] -> Bool) -> Q [Bool] -> Q Bool
forall a b. (a -> b) -> Q a -> Q b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((Type -> Q Bool) -> Cxt -> Q [Bool]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Type -> Q Bool
isWholeTypeContext Cxt
ts)
      (Env -> Env) -> StateT Env Q ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ClassName -> Set Type -> Env -> Env
putFields ClassName
tn (Cxt -> Set Type
forall a. Ord a => [a] -> Set a
S.fromList Cxt
ts))
      if Bool
all_sat
        then do
          -- put into inferred and remove it from context
          -- this is the basecase of this recursive function
          (Env -> Env) -> StateT Env Q ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ClassName -> Env -> Env
moveFieldsToInferred ClassName
tn)
          -- remove it from inferring
          (Env -> Env) -> StateT Env Q ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ClassName -> Env -> Env
deleteInferring ClassName
tn)
          Set Type -> CIM (Set Type)
forall a. a -> StateT Env Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Set Type -> CIM (Set Type)) -> Set Type -> CIM (Set Type)
forall a b. (a -> b) -> a -> b
$ Cxt -> Set Type
forall a. Ord a => [a] -> Set a
S.fromList Cxt
ts
        else do
          ClassName -> StateT Env Q ()
apply_until_fix_point ClassName
tn
          -- put result into inferred
          (Env -> Env) -> StateT Env Q ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ClassName -> Env -> Env
moveFieldsToInferred ClassName
tn)
          (Env -> Env) -> StateT Env Q ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ClassName -> Env -> Env
deleteInferring ClassName
tn)
          Env
e <- StateT Env Q Env
forall s (m :: * -> *). MonadState s m => m s
get
          let tn_context :: Cxt
tn_context = Set Type -> Cxt
forall a. Set a -> [a]
S.toList (Set Type -> Cxt) -> Set Type -> Cxt
forall a b. (a -> b) -> a -> b
$ Env -> Map ClassName (Set Type)
inferred Env
e Map ClassName (Set Type) -> ClassName -> Set Type
forall k a. Ord k => Map k a -> k -> a
! ClassName
tn
          -- since mutual recursive declarations will substitute the
          -- type back and forth, they need to be removed.
          Cxt
tn_context' <- Q Cxt -> StateT Env Q Cxt
forall (m :: * -> *) a. Monad m => m a -> StateT Env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q Cxt -> StateT Env Q Cxt) -> Q Cxt -> StateT Env Q Cxt
forall a b. (a -> b) -> a -> b
$ (Type -> Q Bool) -> Cxt -> Q Cxt
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM
            (\Type
x -> do
              Bool
is_data <- Type -> Q Bool
isLeftMostAppTDataNewtype Type
x
              Bool -> Q Bool
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Q Bool) -> Bool -> Q Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
is_data
            )
            Cxt
tn_context
          Set Type -> CIM (Set Type)
forall a. a -> StateT Env Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Set Type -> CIM (Set Type)) -> Set Type -> CIM (Set Type)
forall a b. (a -> b) -> a -> b
$ Cxt -> Set Type
forall a. Ord a => [a] -> Set a
S.fromList Cxt
tn_context'

apply_until_fix_point :: Name -> CIM ()
apply_until_fix_point :: ClassName -> StateT Env Q ()
apply_until_fix_point ClassName
tn = do
  Env
env <- StateT Env Q Env
forall s (m :: * -> *). MonadState s m => m s
get
  let tn_fields :: Set Type
tn_fields = Env -> Map ClassName (Set Type)
fields Env
env Map ClassName (Set Type) -> ClassName -> Set Type
forall k a. Ord k => Map k a -> k -> a
! ClassName
tn
  ClassName -> StateT Env Q ()
gen_subst ClassName
tn
  ClassName -> StateT Env Q ()
subst_data_newtype ClassName
tn
  Env
env' <- StateT Env Q Env
forall s (m :: * -> *). MonadState s m => m s
get
  let tn_fields' :: Set Type
tn_fields' = Env -> Map ClassName (Set Type)
fields Env
env' Map ClassName (Set Type) -> ClassName -> Set Type
forall k a. Ord k => Map k a -> k -> a
! ClassName
tn
  if Set Type
tn_fields Set Type -> Set Type -> Bool
forall a. Eq a => a -> a -> Bool
== Set Type
tn_fields' then () -> StateT Env Q ()
forall a. a -> StateT Env Q a
forall (m :: * -> *) a. Monad m => a -> m a
return () else ClassName -> StateT Env Q ()
apply_until_fix_point ClassName
tn

-- put fields of data or newtype fields into map
gen_subst :: Name -> CIM ()
gen_subst :: ClassName -> StateT Env Q ()
gen_subst ClassName
tn = do
  Env
env <- StateT Env Q Env
forall s (m :: * -> *). MonadState s m => m s
get
  let fs :: Cxt
fs = Set Type -> Cxt
forall a. Set a -> [a]
S.toList (Set Type -> Cxt) -> Set Type -> Cxt
forall a b. (a -> b) -> a -> b
$ Env -> Map ClassName (Set Type)
fields Env
env Map ClassName (Set Type) -> ClassName -> Set Type
forall k a. Ord k => Map k a -> k -> a
! ClassName
tn
  Cxt
context_type <- Q Cxt -> StateT Env Q Cxt
forall (m :: * -> *) a. Monad m => m a -> StateT Env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q Cxt -> StateT Env Q Cxt) -> Q Cxt -> StateT Env Q Cxt
forall a b. (a -> b) -> a -> b
$ (Type -> Q Bool) -> Cxt -> Q Cxt
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM
    (\Type
x ->
      Bool -> Bool -> Bool
(||)
        (Bool -> Bool -> Bool) -> Q Bool -> Q (Bool -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Type -> Q Bool
isLeftMostAppTDataNewtype Type
x)
        Q (Bool -> Bool) -> Q Bool -> Q Bool
forall a b. Q (a -> b) -> Q a -> Q b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> Q Bool
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Q Bool) -> Bool -> Q Bool
forall a b. (a -> b) -> a -> b
$ Type -> Bool
isLeftMostBuildInContextType Type
x)
    )
    Cxt
fs
  Cxt -> (Type -> StateT Env Q ()) -> StateT Env Q ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Cxt
context_type ((Type -> StateT Env Q ()) -> StateT Env Q ())
-> (Type -> StateT Env Q ()) -> StateT Env Q ()
forall a b. (a -> b) -> a -> b
$ \Type
t -> case Type -> Type
getLeftMostType Type
t of
    ConT ClassName
ctn -> do
      let it :: [ClassName]
it = Env -> [ClassName]
inferring Env
env
      Bool
is_recursive <- if ClassName -> [ClassName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ClassName
ctn [ClassName]
it
        then do
          Bool -> StateT Env Q Bool
forall a. a -> StateT Env Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        else do
          Set Type
_ <- ClassName -> CIM (Set Type)
inferContext ClassName
ctn
          Bool -> StateT Env Q Bool
forall a. a -> StateT Env Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      -- construct substitution map
      let args :: Cxt
args = Type -> Cxt
getConstrArgs Type
t
      Cxt
param_names <- (([ClassName] -> Cxt) -> CIM [ClassName] -> StateT Env Q Cxt
forall a b. (a -> b) -> StateT Env Q a -> StateT Env Q b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([ClassName] -> Cxt) -> CIM [ClassName] -> StateT Env Q Cxt)
-> ((ClassName -> Type) -> [ClassName] -> Cxt)
-> (ClassName -> Type)
-> CIM [ClassName]
-> StateT Env Q Cxt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ClassName -> Type) -> [ClassName] -> Cxt
forall a b. (a -> b) -> [a] -> [b]
map) ClassName -> Type
VarT (ClassName -> CIM [ClassName]
getParams ClassName
ctn)
      Bool -> StateT Env Q () -> StateT Env Q ()
forall a. HasCallStack => Bool -> a -> a
assert (Cxt -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Cxt
args Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Cxt -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Cxt
param_names)
             ((Env -> Env) -> StateT Env Q ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ClassName -> Type -> [(Type, Type)] -> Env -> Env
putSubst ClassName
tn Type
t (Cxt -> Cxt -> [(Type, Type)]
forall a b. [a] -> [b] -> [(a, b)]
zip Cxt
param_names Cxt
args)))
      -- remove recursive type from fields
      if Bool
is_recursive
        then do
          let new_fields :: Set Type
new_fields = Type -> Set Type -> Set Type
forall a. Ord a => a -> Set a -> Set a
S.delete Type
t (Cxt -> Set Type
forall a. Ord a => [a] -> Set a
S.fromList Cxt
fs)
          (Env -> Env) -> StateT Env Q ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ClassName -> Set Type -> Env -> Env
putFields ClassName
tn Set Type
new_fields)
        else () -> StateT Env Q ()
forall a. a -> StateT Env Q a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Type
ListT -> do
      let arg :: Cxt
arg             = Type -> Cxt
getConstrArgs Type
t
      let list_param_name :: Cxt
list_param_name = [ClassName -> Type
VarT (ClassName -> Type) -> ClassName -> Type
forall a b. (a -> b) -> a -> b
$ String -> ClassName
mkName String
"a"]
      Bool -> StateT Env Q () -> StateT Env Q ()
forall a. HasCallStack => Bool -> a -> a
assert (Cxt -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Cxt
arg Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Cxt -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Cxt
list_param_name)
             ((Env -> Env) -> StateT Env Q ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ClassName -> Type -> [(Type, Type)] -> Env -> Env
putSubst ClassName
tn Type
t (Cxt -> Cxt -> [(Type, Type)]
forall a b. [a] -> [b] -> [(a, b)]
zip Cxt
list_param_name Cxt
arg)))
    TupleT Int
n -> do
      let args :: Cxt
args = Type -> Cxt
getConstrArgs Type
t
      let tup_param_names :: Cxt
tup_param_names =
            (String -> Type) -> [String] -> Cxt
forall a b. (a -> b) -> [a] -> [b]
map (ClassName -> Type
VarT (ClassName -> Type) -> (String -> ClassName) -> String -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ClassName
mkName) [ Char
'a' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show Int
x | Int
x <- [Int
1 .. Int
n] ]
      Bool -> StateT Env Q () -> StateT Env Q ()
forall a. HasCallStack => Bool -> a -> a
assert (Cxt -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Cxt
args Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Cxt -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Cxt
tup_param_names)
             ((Env -> Env) -> StateT Env Q ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ClassName -> Type -> [(Type, Type)] -> Env -> Env
putSubst ClassName
tn Type
t (Cxt -> Cxt -> [(Type, Type)]
forall a b. [a] -> [b] -> [(a, b)]
zip Cxt
tup_param_names Cxt
args)))
    Type
err_t -> String -> StateT Env Q ()
forall a. HasCallStack => String -> a
error (String -> StateT Env Q ()) -> String -> StateT Env Q ()
forall a b. (a -> b) -> a -> b
$ String
"gen_subst does not support type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> String
forall a. Show a => a -> String
show Type
err_t

subst_data_newtype :: Name -> CIM ()
subst_data_newtype :: ClassName -> StateT Env Q ()
subst_data_newtype ClassName
tn = do
  Env
env <- StateT Env Q Env
forall s (m :: * -> *). MonadState s m => m s
get
  let tn_substs :: [(Type, [(Type, Type)])]
tn_substs = Map Type [(Type, Type)] -> [(Type, [(Type, Type)])]
forall k a. Map k a -> [(k, a)]
M.toList (Map Type [(Type, Type)] -> [(Type, [(Type, Type)])])
-> Map Type [(Type, Type)] -> [(Type, [(Type, Type)])]
forall a b. (a -> b) -> a -> b
$ Env -> Map ClassName (Map Type [(Type, Type)])
substitution Env
env Map ClassName (Map Type [(Type, Type)])
-> ClassName -> Map Type [(Type, Type)]
forall k a. Ord k => Map k a -> k -> a
! ClassName
tn
  [(Type, [(Type, Type)])]
-> ((Type, [(Type, Type)]) -> StateT Env Q ()) -> StateT Env Q ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Type, [(Type, Type)])]
tn_substs (((Type, [(Type, Type)]) -> StateT Env Q ()) -> StateT Env Q ())
-> ((Type, [(Type, Type)]) -> StateT Env Q ()) -> StateT Env Q ()
forall a b. (a -> b) -> a -> b
$ \(Type
t, [(Type, Type)]
t2t) -> case Type -> Type
getLeftMostType Type
t of
    ConT ClassName
ctn -> do
      Env
e <- StateT Env Q Env
forall s (m :: * -> *). MonadState s m => m s
get
      let tn_fields_map :: Map ClassName (Set Type)
tn_fields_map = Env -> Map ClassName (Set Type)
fields Env
e
      let tn_inferred :: Map ClassName (Set Type)
tn_inferred   = Env -> Map ClassName (Set Type)
inferred Env
e
      let ctn_context :: Set Type
ctn_context =
            Maybe (Set Type) -> Set Type
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Set Type) -> Set Type) -> Maybe (Set Type) -> Set Type
forall a b. (a -> b) -> a -> b
$ ClassName -> Map ClassName (Set Type) -> Maybe (Set Type)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ClassName
ctn Map ClassName (Set Type)
tn_fields_map Maybe (Set Type) -> Maybe (Set Type) -> Maybe (Set Type)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ClassName -> Map ClassName (Set Type) -> Maybe (Set Type)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ClassName
ctn Map ClassName (Set Type)
tn_inferred
      let new_context :: Cxt
new_context = [(Type, Type)] -> Cxt -> Cxt
substituteVarsTypes [(Type, Type)]
t2t (Set Type -> Cxt
forall a. Set a -> [a]
S.toList Set Type
ctn_context)
      Cxt
new_context' <- Q Cxt -> StateT Env Q Cxt
forall (m :: * -> *) a. Monad m => m a -> StateT Env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
        (Q Cxt -> StateT Env Q Cxt) -> Q Cxt -> StateT Env Q Cxt
forall a b. (a -> b) -> a -> b
$ (Type -> Q Bool) -> Cxt -> Q Cxt
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM Type -> Q Bool
doesFieldContainPotentialContext Cxt
new_context
      let new_tn_fields :: Set Type
new_tn_fields =
            Set Type -> Set Type -> Set Type
forall a. Ord a => Set a -> Set a -> Set a
S.union (Cxt -> Set Type
forall a. Ord a => [a] -> Set a
S.fromList Cxt
new_context') (Type -> Set Type -> Set Type
forall a. Ord a => a -> Set a -> Set a
S.delete Type
t (Env -> Map ClassName (Set Type)
fields Env
e Map ClassName (Set Type) -> ClassName -> Set Type
forall k a. Ord k => Map k a -> k -> a
! ClassName
tn))
      (Env -> Env) -> StateT Env Q ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Env -> Env) -> StateT Env Q ())
-> (Env -> Env) -> StateT Env Q ()
forall a b. (a -> b) -> a -> b
$ ClassName -> Set Type -> Env -> Env
putFields ClassName
tn Set Type
new_tn_fields
    Type
ListT -> do
      Env
e <- StateT Env Q Env
forall s (m :: * -> *). MonadState s m => m s
get
      let arg :: Cxt
arg = Type -> Cxt
getConstrArgs Type
t
      Cxt
new_context <- Q Cxt -> StateT Env Q Cxt
forall (m :: * -> *) a. Monad m => m a -> StateT Env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q Cxt -> StateT Env Q Cxt) -> Q Cxt -> StateT Env Q Cxt
forall a b. (a -> b) -> a -> b
$ (Type -> Q Bool) -> Cxt -> Q Cxt
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM Type -> Q Bool
doesFieldContainPotentialContext Cxt
arg
      let new_tn_fields :: Set Type
new_tn_fields =
            Set Type -> Set Type -> Set Type
forall a. Ord a => Set a -> Set a -> Set a
S.union (Cxt -> Set Type
forall a. Ord a => [a] -> Set a
S.fromList Cxt
new_context) (Type -> Set Type -> Set Type
forall a. Ord a => a -> Set a -> Set a
S.delete Type
t (Env -> Map ClassName (Set Type)
fields Env
e Map ClassName (Set Type) -> ClassName -> Set Type
forall k a. Ord k => Map k a -> k -> a
! ClassName
tn))
      (Env -> Env) -> StateT Env Q ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Env -> Env) -> StateT Env Q ())
-> (Env -> Env) -> StateT Env Q ()
forall a b. (a -> b) -> a -> b
$ ClassName -> Set Type -> Env -> Env
putFields ClassName
tn Set Type
new_tn_fields
    TupleT Int
_ -> do
      Env
e <- StateT Env Q Env
forall s (m :: * -> *). MonadState s m => m s
get
      let args :: Cxt
args = Type -> Cxt
getConstrArgs Type
t
      Cxt
new_context <- Q Cxt -> StateT Env Q Cxt
forall (m :: * -> *) a. Monad m => m a -> StateT Env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q Cxt -> StateT Env Q Cxt) -> Q Cxt -> StateT Env Q Cxt
forall a b. (a -> b) -> a -> b
$ (Type -> Q Bool) -> Cxt -> Q Cxt
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM Type -> Q Bool
doesFieldContainPotentialContext Cxt
args
      let new_tn_fields :: Set Type
new_tn_fields =
            Set Type -> Set Type -> Set Type
forall a. Ord a => Set a -> Set a -> Set a
S.union (Cxt -> Set Type
forall a. Ord a => [a] -> Set a
S.fromList Cxt
new_context) (Type -> Set Type -> Set Type
forall a. Ord a => a -> Set a -> Set a
S.delete Type
t (Env -> Map ClassName (Set Type)
fields Env
e Map ClassName (Set Type) -> ClassName -> Set Type
forall k a. Ord k => Map k a -> k -> a
! ClassName
tn))
      (Env -> Env) -> StateT Env Q ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Env -> Env) -> StateT Env Q ())
-> (Env -> Env) -> StateT Env Q ()
forall a b. (a -> b) -> a -> b
$ ClassName -> Set Type -> Env -> Env
putFields ClassName
tn Set Type
new_tn_fields
    Type
err_ty ->
      String -> StateT Env Q ()
forall a. HasCallStack => String -> a
error (String -> StateT Env Q ()) -> String -> StateT Env Q ()
forall a b. (a -> b) -> a -> b
$ String
"subst_data_newtype does not support type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> String
forall a. Show a => a -> String
show Type
err_ty

genInferredContext :: ClassName -> TypeName -> Q Cxt
genInferredContext :: ClassName -> ClassName -> Q Cxt
genInferredContext ClassName
cn ClassName
tn = if ClassName
cn ClassName -> ClassName -> Bool
forall a. Eq a => a -> a -> Bool
== ''Generic
  then Cxt -> Q Cxt
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return []
  else do
    Cxt
ts <- (Set Type -> Cxt) -> Q (Set Type) -> Q Cxt
forall a b. (a -> b) -> Q a -> Q b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Set Type -> Cxt
forall a. Set a -> [a]
S.toList (CIM (Set Type) -> Env -> Q (Set Type)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (ClassName -> CIM (Set Type)
inferContext ClassName
tn) Env
initEnv)
    Cxt -> Q Cxt
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Cxt -> Q Cxt) -> Cxt -> Q Cxt
forall a b. (a -> b) -> a -> b
$ (Type -> Type) -> Cxt -> Cxt
forall a b. (a -> b) -> [a] -> [b]
map (\Type
t -> Type -> Type -> Type
AppT (ClassName -> Type
ConT ClassName
cn) Type
t) Cxt
ts

-- | Generate wildcard context 
genHoleContext :: ClassName -> TypeName -> Q Cxt
genHoleContext :: ClassName -> ClassName -> Q Cxt
genHoleContext ClassName
_ ClassName
_ = Cxt -> Q Cxt
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return [Type
WildCardT]

-- | Put all possible type fields of the type into context
genAllFieldsContext :: ClassName -> TypeName -> Q Cxt
genAllFieldsContext :: ClassName -> ClassName -> Q Cxt
genAllFieldsContext ClassName
cn ClassName
tn = if ClassName
cn ClassName -> ClassName -> Bool
forall a. Eq a => a -> a -> Bool
== ''Generic
  then Cxt -> Q Cxt
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return []
  else do
    ([TyVarBndr ()]
_, Cxt
types) <- ClassName -> Q ([TyVarBndr ()], Cxt)
getTyVarFields ClassName
tn
    Cxt
ts         <- (Type -> Q Bool) -> Cxt -> Q Cxt
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM Type -> Q Bool
doesFieldContainPotentialContext Cxt
types
    let csts :: Cxt
csts = (Type -> Type) -> Cxt -> Cxt
forall a b. (a -> b) -> [a] -> [b]
map (\Type
t -> Type -> Type -> Type
AppT (ClassName -> Type
ConT ClassName
cn) Type
t) Cxt
ts
    Cxt -> Q Cxt
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Cxt
csts