{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE FlexibleInstances         #-}

{-# OPTIONS_GHC -Wno-incomplete-patterns #-} -- TODO(#1918): Only needed for GHC <9.0.1.

module Language.Haskell.Liquid.GHC.Play where

import Prelude hiding (error)

import           Control.Arrow       ((***))
import qualified Data.HashMap.Strict as M
import qualified Data.List           as L
import qualified Data.Maybe          as Mb

import Liquid.GHC.API as Ghc hiding (panic, showPpr)
import Language.Haskell.Liquid.GHC.Misc ()
import Language.Haskell.Liquid.Types.Errors
import Language.Haskell.Liquid.Types.Variance

-------------------------------------------------------------------------------
-- | Positivity Checker -------------------------------------------------------
-------------------------------------------------------------------------------

-- If the type constructor T is in the input list and its data constructors Di, Dj
-- use T in non strictly positive positions, 
-- then (T,(Di, Dj)) will appear in the result list.  

getNonPositivesTyCon :: [TyCon] -> [(TyCon, [DataCon])]
getNonPositivesTyCon :: [TyCon] -> [(TyCon, [DataCon])]
getNonPositivesTyCon [TyCon]
tcs = ((TyCon, [(DataCon, TyConOccurrence)]) -> Maybe (TyCon, [DataCon]))
-> [(TyCon, [(DataCon, TyConOccurrence)])] -> [(TyCon, [DataCon])]
forall a b. (a -> Maybe b) -> [a] -> [b]
Mb.mapMaybe (TyCon, [(DataCon, TyConOccurrence)]) -> Maybe (TyCon, [DataCon])
forall {b}. (TyCon, [(b, TyConOccurrence)]) -> Maybe (TyCon, [b])
go (OccurrenceMap -> [(TyCon, [(DataCon, TyConOccurrence)])]
forall k v. HashMap k v -> [(k, v)]
M.toList (OccurrenceMap -> [(TyCon, [(DataCon, TyConOccurrence)])])
-> OccurrenceMap -> [(TyCon, [(DataCon, TyConOccurrence)])]
forall a b. (a -> b) -> a -> b
$ [TyCon] -> OccurrenceMap
makeOccurrences [TyCon]
tcs)
  where
    go :: (TyCon, [(b, TyConOccurrence)]) -> Maybe (TyCon, [b])
go (TyCon
tc,[(b, TyConOccurrence)]
dcocs) = case ((b, TyConOccurrence) -> Bool)
-> [(b, TyConOccurrence)] -> [(b, TyConOccurrence)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(b
_,TyConOccurrence
occ) -> TyCon -> [TyCon] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem TyCon
tc (TyConOccurrence -> [TyCon]
negOcc TyConOccurrence
occ)) [(b, TyConOccurrence)]
dcocs of
                      [] -> Maybe (TyCon, [b])
forall a. Maybe a
Nothing
                      [(b, TyConOccurrence)]
xs -> (TyCon, [b]) -> Maybe (TyCon, [b])
forall a. a -> Maybe a
Just (TyCon
tc, (b, TyConOccurrence) -> b
forall a b. (a, b) -> a
fst ((b, TyConOccurrence) -> b) -> [(b, TyConOccurrence)] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(b, TyConOccurrence)]
xs)


-- OccurrenceMap maps type constructors to their TyConOccurrence. 
-- for each of their data constructor. For example, for the below data definition
-- data T a = P (T a) | N (T a -> Int) | Both (T a -> T a) | None 
-- the entry below should get generated
--  OccurrenceMap 
-- = T |-> [(P, [
--          (P,    TyConOcc [T] [])
--          (N,    TyConOcc [Int] [T])
--          (Both, TyConOcc [T] [T])
--          (None, TyConOcc [] [])
--         ])] 
-- For positivity check, ultimately we only care about self occurences, 
-- but we keep track of all the TyCons for the mutually inductive data types. 
-- We separate the occurences per data constructor only to provide better error messages. 
type OccurrenceMap = M.HashMap TyCon [(DataCon, TyConOccurrence)]

data TyConOccurrence
    = TyConOcc { TyConOccurrence -> [TyCon]
posOcc :: [TyCon] -- TyCons that occur in positive positions
               , TyConOccurrence -> [TyCon]
negOcc :: [TyCon] -- TyCons that occur in negative positions
               }
  deriving TyConOccurrence -> TyConOccurrence -> Bool
(TyConOccurrence -> TyConOccurrence -> Bool)
-> (TyConOccurrence -> TyConOccurrence -> Bool)
-> Eq TyConOccurrence
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TyConOccurrence -> TyConOccurrence -> Bool
== :: TyConOccurrence -> TyConOccurrence -> Bool
$c/= :: TyConOccurrence -> TyConOccurrence -> Bool
/= :: TyConOccurrence -> TyConOccurrence -> Bool
Eq

instance Monoid TyConOccurrence where
  mempty :: TyConOccurrence
mempty = [TyCon] -> [TyCon] -> TyConOccurrence
TyConOcc [TyCon]
forall a. Monoid a => a
mempty [TyCon]
forall a. Monoid a => a
mempty
instance Semigroup TyConOccurrence where
  TyConOcc [TyCon]
p1 [TyCon]
n1 <> :: TyConOccurrence -> TyConOccurrence -> TyConOccurrence
<> TyConOcc [TyCon]
p2 [TyCon]
n2 = [TyCon] -> [TyCon] -> TyConOccurrence
TyConOcc ([TyCon] -> [TyCon]
forall a. Eq a => [a] -> [a]
L.nub ([TyCon]
p1 [TyCon] -> [TyCon] -> [TyCon]
forall a. Semigroup a => a -> a -> a
<> [TyCon]
p2)) ([TyCon] -> [TyCon]
forall a. Eq a => [a] -> [a]
L.nub ([TyCon]
n1 [TyCon] -> [TyCon] -> [TyCon]
forall a. Semigroup a => a -> a -> a
<> [TyCon]
n2))
instance Outputable TyConOccurrence where
  ppr :: TyConOccurrence -> SDoc
ppr (TyConOcc [TyCon]
pos [TyCon]
neg) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"pos" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [TyCon] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [TyCon]
pos SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>  String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"neg" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [TyCon] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [TyCon]
neg


instance Outputable OccurrenceMap where
  ppr :: OccurrenceMap -> SDoc
ppr OccurrenceMap
m = [(TyCon, [(DataCon, TyConOccurrence)])] -> SDoc
forall a. Outputable a => a -> SDoc
ppr (OccurrenceMap -> [(TyCon, [(DataCon, TyConOccurrence)])]
forall k v. HashMap k v -> [(k, v)]
M.toList OccurrenceMap
m)


makeOccurrences :: [TyCon] -> OccurrenceMap
makeOccurrences :: [TyCon] -> OccurrenceMap
makeOccurrences [TyCon]
tycons
  = let m0 :: OccurrenceMap
m0 = [(TyCon, [(DataCon, TyConOccurrence)])] -> OccurrenceMap
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList [(TyCon
tc, (DataCon -> (DataCon, TyConOccurrence))
-> [DataCon] -> [(DataCon, TyConOccurrence)]
forall a b. (a -> b) -> [a] -> [b]
map (\DataCon
dc -> (DataCon
dc, HashMap TyCon VarianceInfo -> [Type] -> TyConOccurrence
makeOccurrence HashMap TyCon VarianceInfo
tcInfo (DataCon -> [Type]
dctypes DataCon
dc))) (TyCon -> [DataCon]
tyConDataCons TyCon
tc))
                        | TyCon
tc <- [TyCon]
tycons']
    -- fixpoint to find occurrences of mutually recursive data definitons
    in (OccurrenceMap -> OccurrenceMap) -> OccurrenceMap -> OccurrenceMap
forall {t}. Eq t => (t -> t) -> t -> t
fix (\OccurrenceMap
m -> (OccurrenceMap -> TyCon -> OccurrenceMap)
-> OccurrenceMap -> [TyCon] -> OccurrenceMap
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl OccurrenceMap -> TyCon -> OccurrenceMap
merge OccurrenceMap
m [TyCon]
tycons') OccurrenceMap
m0
  where
    fix :: (t -> t) -> t -> t
fix t -> t
f t
x = let x' :: t
x' = t -> t
f t
x in if t
x t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
x' then t
x else (t -> t) -> t -> t
fix t -> t
f t
x'
    tcInfo :: HashMap TyCon VarianceInfo
tcInfo = [(TyCon, VarianceInfo)] -> HashMap TyCon VarianceInfo
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList ([(TyCon, VarianceInfo)] -> HashMap TyCon VarianceInfo)
-> [(TyCon, VarianceInfo)] -> HashMap TyCon VarianceInfo
forall a b. (a -> b) -> a -> b
$ [TyCon] -> [VarianceInfo] -> [(TyCon, VarianceInfo)]
forall a b. [a] -> [b] -> [(a, b)]
zip [TyCon]
tycons' (TyCon -> VarianceInfo
makeTyConVariance (TyCon -> VarianceInfo) -> [TyCon] -> [VarianceInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TyCon]
tycons')
    merge :: OccurrenceMap -> TyCon -> OccurrenceMap
merge OccurrenceMap
m TyCon
tc = ([(DataCon, TyConOccurrence)]
 -> Maybe [(DataCon, TyConOccurrence)])
-> TyCon -> OccurrenceMap -> OccurrenceMap
forall k a.
(Eq k, Hashable k) =>
(a -> Maybe a) -> k -> HashMap k a -> HashMap k a
M.update (OccurrenceMap
-> [(DataCon, TyConOccurrence)]
-> Maybe [(DataCon, TyConOccurrence)]
forall {a}.
OccurrenceMap
-> [(a, TyConOccurrence)] -> Maybe [(a, TyConOccurrence)]
mergeList OccurrenceMap
m) TyCon
tc OccurrenceMap
m
    mergeList :: OccurrenceMap
-> [(a, TyConOccurrence)] -> Maybe [(a, TyConOccurrence)]
mergeList OccurrenceMap
m [(a, TyConOccurrence)]
xs = [(a, TyConOccurrence)] -> Maybe [(a, TyConOccurrence)]
forall a. a -> Maybe a
Just [(a
dc, OccurrenceMap -> TyConOccurrence -> TyConOccurrence
mergeApp OccurrenceMap
m TyConOccurrence
am) | (a
dc,TyConOccurrence
am) <- [(a, TyConOccurrence)]
xs]
    mergeApp :: OccurrenceMap -> TyConOccurrence -> TyConOccurrence
mergeApp OccurrenceMap
m (TyConOcc [TyCon]
pos [TyCon]
neg) =
        let TyConOcc [TyCon]
pospos [TyCon]
posneg = [TyConOccurrence] -> TyConOccurrence
forall a. Monoid a => [a] -> a
mconcat (OccurrenceMap -> TyCon -> TyConOccurrence
findOccurrence OccurrenceMap
m (TyCon -> TyConOccurrence) -> [TyCon] -> [TyConOccurrence]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TyCon]
pos)
            TyConOcc [TyCon]
negpos [TyCon]
negneg = [TyConOccurrence] -> TyConOccurrence
forall a. Monoid a => [a] -> a
mconcat (OccurrenceMap -> TyCon -> TyConOccurrence
findOccurrence OccurrenceMap
m (TyCon -> TyConOccurrence) -> [TyCon] -> [TyConOccurrence]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TyCon]
neg)
        -- Keep positive, flip negative 
        in [TyCon] -> [TyCon] -> TyConOccurrence
TyConOcc ([TyCon] -> [TyCon]
forall a. Eq a => [a] -> [a]
L.nub ([TyCon]
pos [TyCon] -> [TyCon] -> [TyCon]
forall a. Semigroup a => a -> a -> a
<> [TyCon]
pospos [TyCon] -> [TyCon] -> [TyCon]
forall a. Semigroup a => a -> a -> a
<> [TyCon]
negneg)) ([TyCon] -> [TyCon]
forall a. Eq a => [a] -> [a]
L.nub ([TyCon]
neg [TyCon] -> [TyCon] -> [TyCon]
forall a. Semigroup a => a -> a -> a
<> [TyCon]
negpos [TyCon] -> [TyCon] -> [TyCon]
forall a. Semigroup a => a -> a -> a
<> [TyCon]
posneg))


    tycontypes :: TyCon -> [Type]
tycontypes TyCon
tc = (DataCon -> [Type]) -> [DataCon] -> [Type]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap DataCon -> [Type]
dctypes ([DataCon] -> [Type]) -> [DataCon] -> [Type]
forall a b. (a -> b) -> a -> b
$ TyCon -> [DataCon]
tyConDataCons TyCon
tc
    dctypes :: DataCon -> [Type]
dctypes    DataCon
dc = Scaled Type -> Type
forall a. Scaled a -> a
irrelevantMult (Scaled Type -> Type) -> [Scaled Type] -> [Type]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DataCon -> [Scaled Type]
dataConOrigArgTys DataCon
dc

    -- Construct the map for all TyCons that appear in the definitions 
    tycons' :: [TyCon]
tycons' = [TyCon] -> [TyCon]
forall a. Eq a => [a] -> [a]
L.nub ((Type -> [TyCon]) -> [Type] -> [TyCon]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Type -> [TyCon]
tcs ((TyCon -> [Type]) -> [TyCon] -> [Type]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TyCon -> [Type]
tycontypes [TyCon]
tycons) [TyCon] -> [TyCon] -> [TyCon]
forall a. [a] -> [a] -> [a]
++ [TyCon]
tycons)

    tcs :: Type -> [TyCon]
tcs (TyConApp TyCon
tc' [Type]
ts) = TyCon
tc'TyCon -> [TyCon] -> [TyCon]
forall a. a -> [a] -> [a]
: (Type -> [TyCon]) -> [Type] -> [TyCon]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Type -> [TyCon]
tcs [Type]
ts
    tcs (AppTy Type
t1 Type
t2)     = Type -> [TyCon]
tcs Type
t1 [TyCon] -> [TyCon] -> [TyCon]
forall a. [a] -> [a] -> [a]
++ Type -> [TyCon]
tcs Type
t2
    tcs (ForAllTy ForAllTyBinder
_ Type
t)    = Type -> [TyCon]
tcs Type
t
    tcs (FunTy FunTyFlag
_ Type
_ Type
t1 Type
t2) = Type -> [TyCon]
tcs Type
t1 [TyCon] -> [TyCon] -> [TyCon]
forall a. [a] -> [a] -> [a]
++ Type -> [TyCon]
tcs Type
t2
    tcs (TyVarTy Var
_ )      = []
    tcs (LitTy TyLit
_)         = []
    tcs (CastTy Type
_ KindCoercion
_)      = []
    tcs (CoercionTy KindCoercion
_)    = []

makeOccurrence :: M.HashMap TyCon VarianceInfo -> [Type] -> TyConOccurrence
makeOccurrence :: HashMap TyCon VarianceInfo -> [Type] -> TyConOccurrence
makeOccurrence HashMap TyCon VarianceInfo
tcInfo = (TyConOccurrence -> Type -> TyConOccurrence)
-> TyConOccurrence -> [Type] -> TyConOccurrence
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (Variance -> TyConOccurrence -> Type -> TyConOccurrence
go Variance
Covariant) TyConOccurrence
forall a. Monoid a => a
mempty
  where
    go :: Variance -> TyConOccurrence -> Type -> TyConOccurrence
    go :: Variance -> TyConOccurrence -> Type -> TyConOccurrence
go Variance
p TyConOccurrence
m (TyConApp TyCon
tc [Type]
ts)  = Variance -> TyCon -> TyConOccurrence -> TyConOccurrence
addOccurrence Variance
p TyCon
tc
                             (TyConOccurrence -> TyConOccurrence)
-> TyConOccurrence -> TyConOccurrence
forall a b. (a -> b) -> a -> b
$ (TyConOccurrence -> (Type, Variance) -> TyConOccurrence)
-> TyConOccurrence -> [(Type, Variance)] -> TyConOccurrence
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\TyConOccurrence
m' (Type
t, Variance
v) -> Variance -> TyConOccurrence -> Type -> TyConOccurrence
go (Variance
v Variance -> Variance -> Variance
forall a. Semigroup a => a -> a -> a
<> Variance
p) TyConOccurrence
m' Type
t) TyConOccurrence
m
                                ([Type] -> VarianceInfo -> [(Type, Variance)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Type]
ts (VarianceInfo -> TyCon -> HashMap TyCon VarianceInfo -> VarianceInfo
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
M.lookupDefault (Variance -> VarianceInfo
forall a. a -> [a]
repeat Variance
Bivariant) TyCon
tc HashMap TyCon VarianceInfo
tcInfo))
    go Variance
_ TyConOccurrence
m (TyVarTy Var
_ )      = TyConOccurrence
m
    go Variance
_ TyConOccurrence
m (AppTy Type
t1 Type
t2)     = Variance -> TyConOccurrence -> Type -> TyConOccurrence
go Variance
Bivariant (Variance -> TyConOccurrence -> Type -> TyConOccurrence
go Variance
Bivariant TyConOccurrence
m Type
t1) Type
t2
    go Variance
p TyConOccurrence
m (ForAllTy ForAllTyBinder
_ Type
t)    = Variance -> TyConOccurrence -> Type -> TyConOccurrence
go Variance
p TyConOccurrence
m Type
t
    go Variance
p TyConOccurrence
m (FunTy FunTyFlag
_ Type
_ Type
t1 Type
t2) = Variance -> TyConOccurrence -> Type -> TyConOccurrence
go Variance
p (Variance -> TyConOccurrence -> Type -> TyConOccurrence
go (Variance -> Variance
flipVariance Variance
p) TyConOccurrence
m Type
t1) Type
t2
    go Variance
_ TyConOccurrence
m (LitTy TyLit
_)         = TyConOccurrence
m
    go Variance
_ TyConOccurrence
m (CastTy Type
_ KindCoercion
_)      = TyConOccurrence
m
    go Variance
_ TyConOccurrence
m (CoercionTy KindCoercion
_)    = TyConOccurrence
m

    addOccurrence :: Variance -> TyCon -> TyConOccurrence -> TyConOccurrence
addOccurrence Variance
p TyCon
tc (TyConOcc [TyCon]
pos [TyCon]
neg)
      = case Variance
p of
         Variance
Covariant     -> [TyCon] -> [TyCon] -> TyConOccurrence
TyConOcc ([TyCon] -> [TyCon]
forall a. Eq a => [a] -> [a]
L.nub (TyCon
tcTyCon -> [TyCon] -> [TyCon]
forall a. a -> [a] -> [a]
:[TyCon]
pos)) [TyCon]
neg
         Variance
Contravariant -> [TyCon] -> [TyCon] -> TyConOccurrence
TyConOcc [TyCon]
pos ([TyCon] -> [TyCon]
forall a. Eq a => [a] -> [a]
L.nub (TyCon
tcTyCon -> [TyCon] -> [TyCon]
forall a. a -> [a] -> [a]
:[TyCon]
neg))
         Variance
Bivariant     -> [TyCon] -> [TyCon] -> TyConOccurrence
TyConOcc ([TyCon] -> [TyCon]
forall a. Eq a => [a] -> [a]
L.nub (TyCon
tcTyCon -> [TyCon] -> [TyCon]
forall a. a -> [a] -> [a]
:[TyCon]
pos)) ([TyCon] -> [TyCon]
forall a. Eq a => [a] -> [a]
L.nub (TyCon
tcTyCon -> [TyCon] -> [TyCon]
forall a. a -> [a] -> [a]
:[TyCon]
neg))
         Variance
Invariant     -> [TyCon] -> [TyCon] -> TyConOccurrence
TyConOcc [TyCon]
pos [TyCon]
neg

findOccurrence :: OccurrenceMap -> TyCon -> TyConOccurrence
findOccurrence :: OccurrenceMap -> TyCon -> TyConOccurrence
findOccurrence OccurrenceMap
m TyCon
tc = [TyConOccurrence] -> TyConOccurrence
forall a. Monoid a => [a] -> a
mconcat ((DataCon, TyConOccurrence) -> TyConOccurrence
forall a b. (a, b) -> b
snd ((DataCon, TyConOccurrence) -> TyConOccurrence)
-> [(DataCon, TyConOccurrence)] -> [TyConOccurrence]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(DataCon, TyConOccurrence)]
-> TyCon -> OccurrenceMap -> [(DataCon, TyConOccurrence)]
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
M.lookupDefault [(DataCon, TyConOccurrence)]
forall a. Monoid a => a
mempty TyCon
tc OccurrenceMap
m)




isRecursivenewTyCon :: TyCon -> Bool
isRecursivenewTyCon :: TyCon -> Bool
isRecursivenewTyCon TyCon
c
  | Bool -> Bool
not (TyCon -> Bool
isNewTyCon TyCon
c)
  = Bool
False
isRecursivenewTyCon TyCon
c
  = Type -> Bool
go Type
t
  where
    t :: Type
t = ([Var], Type) -> Type
forall a b. (a, b) -> b
snd (([Var], Type) -> Type) -> ([Var], Type) -> Type
forall a b. (a -> b) -> a -> b
$ TyCon -> ([Var], Type)
newTyConRhs TyCon
c
    go :: Type -> Bool
go (AppTy Type
t1 Type
t2)      = Type -> Bool
go Type
t1 Bool -> Bool -> Bool
|| Type -> Bool
go Type
t2
    go (TyConApp TyCon
c' [Type]
ts)   = TyCon
c TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
c' Bool -> Bool -> Bool
|| (Type -> Bool) -> [Type] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Type -> Bool
go [Type]
ts
    go (ForAllTy ForAllTyBinder
_ Type
t1)    = Type -> Bool
go Type
t1
    go (FunTy FunTyFlag
_ Type
_ Type
t1 Type
t2)  = Type -> Bool
go Type
t1 Bool -> Bool -> Bool
|| Type -> Bool
go Type
t2
    go (CastTy Type
t1 KindCoercion
_)      = Type -> Bool
go Type
t1
    go Type
_                  = Bool
False


dataConImplicitIds :: DataCon -> [Id]
dataConImplicitIds :: DataCon -> [Var]
dataConImplicitIds DataCon
dc = [ Var
x | AnId Var
x <- DataCon -> [TyThing]
dataConImplicitTyThings DataCon
dc]

class Subable a where
  sub   :: M.HashMap CoreBndr CoreExpr -> a -> a
  subTy :: M.HashMap TyVar Type -> a -> a

instance Subable CoreExpr where
  sub :: HashMap Var CoreExpr -> CoreExpr -> CoreExpr
sub HashMap Var CoreExpr
s (Var Var
v)        = CoreExpr -> Var -> HashMap Var CoreExpr -> CoreExpr
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
M.lookupDefault (Var -> CoreExpr
forall b. Var -> Expr b
Var Var
v) Var
v HashMap Var CoreExpr
s
  sub HashMap Var CoreExpr
_ (Lit Literal
l)        = Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
l
  sub HashMap Var CoreExpr
s (App CoreExpr
e1 CoreExpr
e2)    = CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
App (HashMap Var CoreExpr -> CoreExpr -> CoreExpr
forall a. Subable a => HashMap Var CoreExpr -> a -> a
sub HashMap Var CoreExpr
s CoreExpr
e1) (HashMap Var CoreExpr -> CoreExpr -> CoreExpr
forall a. Subable a => HashMap Var CoreExpr -> a -> a
sub HashMap Var CoreExpr
s CoreExpr
e2)
  sub HashMap Var CoreExpr
s (Lam Var
b CoreExpr
e)      = Var -> CoreExpr -> CoreExpr
forall b. b -> Expr b -> Expr b
Lam Var
b (HashMap Var CoreExpr -> CoreExpr -> CoreExpr
forall a. Subable a => HashMap Var CoreExpr -> a -> a
sub HashMap Var CoreExpr
s CoreExpr
e)
  sub HashMap Var CoreExpr
s (Let Bind Var
b CoreExpr
e)      = Bind Var -> CoreExpr -> CoreExpr
forall b. Bind b -> Expr b -> Expr b
Let (HashMap Var CoreExpr -> Bind Var -> Bind Var
forall a. Subable a => HashMap Var CoreExpr -> a -> a
sub HashMap Var CoreExpr
s Bind Var
b) (HashMap Var CoreExpr -> CoreExpr -> CoreExpr
forall a. Subable a => HashMap Var CoreExpr -> a -> a
sub HashMap Var CoreExpr
s CoreExpr
e)
  sub HashMap Var CoreExpr
s (Case CoreExpr
e Var
b Type
t [Alt Var]
a) = CoreExpr -> Var -> Type -> [Alt Var] -> CoreExpr
forall b. Expr b -> b -> Type -> [Alt b] -> Expr b
Case (HashMap Var CoreExpr -> CoreExpr -> CoreExpr
forall a. Subable a => HashMap Var CoreExpr -> a -> a
sub HashMap Var CoreExpr
s CoreExpr
e) (HashMap Var CoreExpr -> Var -> Var
forall a. Subable a => HashMap Var CoreExpr -> a -> a
sub HashMap Var CoreExpr
s Var
b) Type
t ((Alt Var -> Alt Var) -> [Alt Var] -> [Alt Var]
forall a b. (a -> b) -> [a] -> [b]
map (HashMap Var CoreExpr -> Alt Var -> Alt Var
forall a. Subable a => HashMap Var CoreExpr -> a -> a
sub HashMap Var CoreExpr
s) [Alt Var]
a)
  sub HashMap Var CoreExpr
s (Cast CoreExpr
e KindCoercion
c)     = CoreExpr -> KindCoercion -> CoreExpr
forall b. Expr b -> KindCoercion -> Expr b
Cast (HashMap Var CoreExpr -> CoreExpr -> CoreExpr
forall a. Subable a => HashMap Var CoreExpr -> a -> a
sub HashMap Var CoreExpr
s CoreExpr
e) KindCoercion
c
  sub HashMap Var CoreExpr
s (Tick CoreTickish
t CoreExpr
e)     = CoreTickish -> CoreExpr -> CoreExpr
forall b. CoreTickish -> Expr b -> Expr b
Tick CoreTickish
t (HashMap Var CoreExpr -> CoreExpr -> CoreExpr
forall a. Subable a => HashMap Var CoreExpr -> a -> a
sub HashMap Var CoreExpr
s CoreExpr
e)
  sub HashMap Var CoreExpr
_ (Type Type
t)       = Type -> CoreExpr
forall b. Type -> Expr b
Type Type
t
  sub HashMap Var CoreExpr
_ (Coercion KindCoercion
c)   = KindCoercion -> CoreExpr
forall b. KindCoercion -> Expr b
Coercion KindCoercion
c

  subTy :: HashMap Var Type -> CoreExpr -> CoreExpr
subTy HashMap Var Type
s (Var Var
v)      = Var -> CoreExpr
forall b. Var -> Expr b
Var (HashMap Var Type -> Var -> Var
forall a. Subable a => HashMap Var Type -> a -> a
subTy HashMap Var Type
s Var
v)
  subTy HashMap Var Type
_ (Lit Literal
l)      = Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
l
  subTy HashMap Var Type
s (App CoreExpr
e1 CoreExpr
e2)  = CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
App (HashMap Var Type -> CoreExpr -> CoreExpr
forall a. Subable a => HashMap Var Type -> a -> a
subTy HashMap Var Type
s CoreExpr
e1) (HashMap Var Type -> CoreExpr -> CoreExpr
forall a. Subable a => HashMap Var Type -> a -> a
subTy HashMap Var Type
s CoreExpr
e2)
  subTy HashMap Var Type
s (Lam Var
b CoreExpr
e)    | Var -> Bool
isTyVar Var
b = Var -> CoreExpr -> CoreExpr
forall b. b -> Expr b -> Expr b
Lam Var
v' (HashMap Var Type -> CoreExpr -> CoreExpr
forall a. Subable a => HashMap Var Type -> a -> a
subTy HashMap Var Type
s CoreExpr
e)
   where v' :: Var
v' = case Var -> HashMap Var Type -> Maybe Type
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup Var
b HashMap Var Type
s of
               Just (TyVarTy Var
v) -> Var
v
               Maybe Type
_                -> Var
b

  subTy HashMap Var Type
s (Lam Var
b CoreExpr
e)      = Var -> CoreExpr -> CoreExpr
forall b. b -> Expr b -> Expr b
Lam (HashMap Var Type -> Var -> Var
forall a. Subable a => HashMap Var Type -> a -> a
subTy HashMap Var Type
s Var
b) (HashMap Var Type -> CoreExpr -> CoreExpr
forall a. Subable a => HashMap Var Type -> a -> a
subTy HashMap Var Type
s CoreExpr
e)
  subTy HashMap Var Type
s (Let Bind Var
b CoreExpr
e)      = Bind Var -> CoreExpr -> CoreExpr
forall b. Bind b -> Expr b -> Expr b
Let (HashMap Var Type -> Bind Var -> Bind Var
forall a. Subable a => HashMap Var Type -> a -> a
subTy HashMap Var Type
s Bind Var
b) (HashMap Var Type -> CoreExpr -> CoreExpr
forall a. Subable a => HashMap Var Type -> a -> a
subTy HashMap Var Type
s CoreExpr
e)
  subTy HashMap Var Type
s (Case CoreExpr
e Var
b Type
t [Alt Var]
a) = CoreExpr -> Var -> Type -> [Alt Var] -> CoreExpr
forall b. Expr b -> b -> Type -> [Alt b] -> Expr b
Case (HashMap Var Type -> CoreExpr -> CoreExpr
forall a. Subable a => HashMap Var Type -> a -> a
subTy HashMap Var Type
s CoreExpr
e) (HashMap Var Type -> Var -> Var
forall a. Subable a => HashMap Var Type -> a -> a
subTy HashMap Var Type
s Var
b) (HashMap Var Type -> Type -> Type
forall a. Subable a => HashMap Var Type -> a -> a
subTy HashMap Var Type
s Type
t) ((Alt Var -> Alt Var) -> [Alt Var] -> [Alt Var]
forall a b. (a -> b) -> [a] -> [b]
map (HashMap Var Type -> Alt Var -> Alt Var
forall a. Subable a => HashMap Var Type -> a -> a
subTy HashMap Var Type
s) [Alt Var]
a)
  subTy HashMap Var Type
s (Cast CoreExpr
e KindCoercion
_c)    = CoreExpr -> KindCoercion -> CoreExpr
forall b. Expr b -> KindCoercion -> Expr b
Cast (HashMap Var Type -> CoreExpr -> CoreExpr
forall a. Subable a => HashMap Var Type -> a -> a
subTy HashMap Var Type
s CoreExpr
e) (KindCoercion -> CoreExpr) -> KindCoercion -> CoreExpr
forall a b. (a -> b) -> a -> b
$ Maybe SrcSpan -> String -> KindCoercion
forall a. HasCallStack => Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"subTy Coercion"
  subTy HashMap Var Type
s (Tick CoreTickish
t CoreExpr
e)     = CoreTickish -> CoreExpr -> CoreExpr
forall b. CoreTickish -> Expr b -> Expr b
Tick CoreTickish
t (HashMap Var Type -> CoreExpr -> CoreExpr
forall a. Subable a => HashMap Var Type -> a -> a
subTy HashMap Var Type
s CoreExpr
e)
  subTy HashMap Var Type
s (Type Type
t)       = Type -> CoreExpr
forall b. Type -> Expr b
Type (HashMap Var Type -> Type -> Type
forall a. Subable a => HashMap Var Type -> a -> a
subTy HashMap Var Type
s Type
t)
  subTy HashMap Var Type
_s (Coercion KindCoercion
_c) = KindCoercion -> CoreExpr
forall b. KindCoercion -> Expr b
Coercion (KindCoercion -> CoreExpr) -> KindCoercion -> CoreExpr
forall a b. (a -> b) -> a -> b
$ Maybe SrcSpan -> String -> KindCoercion
forall a. HasCallStack => Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"subTy Coercion"

instance Subable (Alt Var) where
 sub :: HashMap Var CoreExpr -> Alt Var -> Alt Var
sub HashMap Var CoreExpr
s (Alt AltCon
a [Var]
b CoreExpr
e)   = AltCon -> [Var] -> CoreExpr -> Alt Var
forall b. AltCon -> [b] -> Expr b -> Alt b
Alt AltCon
a ((Var -> Var) -> [Var] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
map (HashMap Var CoreExpr -> Var -> Var
forall a. Subable a => HashMap Var CoreExpr -> a -> a
sub HashMap Var CoreExpr
s) [Var]
b)   (HashMap Var CoreExpr -> CoreExpr -> CoreExpr
forall a. Subable a => HashMap Var CoreExpr -> a -> a
sub HashMap Var CoreExpr
s CoreExpr
e)
 subTy :: HashMap Var Type -> Alt Var -> Alt Var
subTy HashMap Var Type
s (Alt AltCon
a [Var]
b CoreExpr
e) = AltCon -> [Var] -> CoreExpr -> Alt Var
forall b. AltCon -> [b] -> Expr b -> Alt b
Alt AltCon
a ((Var -> Var) -> [Var] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
map (HashMap Var Type -> Var -> Var
forall a. Subable a => HashMap Var Type -> a -> a
subTy HashMap Var Type
s) [Var]
b) (HashMap Var Type -> CoreExpr -> CoreExpr
forall a. Subable a => HashMap Var Type -> a -> a
subTy HashMap Var Type
s CoreExpr
e)

instance Subable Var where
 sub :: HashMap Var CoreExpr -> Var -> Var
sub HashMap Var CoreExpr
s Var
v   | Var -> HashMap Var CoreExpr -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
M.member Var
v HashMap Var CoreExpr
s = CoreExpr -> Var
forall t. Expr t -> Var
subVar (CoreExpr -> Var) -> CoreExpr -> Var
forall a b. (a -> b) -> a -> b
$ HashMap Var CoreExpr
s HashMap Var CoreExpr -> Var -> CoreExpr
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
M.! Var
v
           | Bool
otherwise    = Var
v
 subTy :: HashMap Var Type -> Var -> Var
subTy HashMap Var Type
s Var
v = Var -> Type -> Var
setVarType Var
v (HashMap Var Type -> Type -> Type
forall a. Subable a => HashMap Var Type -> a -> a
subTy HashMap Var Type
s (Var -> Type
varType Var
v))

subVar :: Expr t -> Id
subVar :: forall t. Expr t -> Var
subVar (Var Var
x) = Var
x
subVar  Expr t
_      = Maybe SrcSpan -> String -> Var
forall a. HasCallStack => Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"sub Var"

instance Subable (Bind Var) where
 sub :: HashMap Var CoreExpr -> Bind Var -> Bind Var
sub HashMap Var CoreExpr
s (NonRec Var
x CoreExpr
e)   = Var -> CoreExpr -> Bind Var
forall b. b -> Expr b -> Bind b
NonRec (HashMap Var CoreExpr -> Var -> Var
forall a. Subable a => HashMap Var CoreExpr -> a -> a
sub HashMap Var CoreExpr
s Var
x) (HashMap Var CoreExpr -> CoreExpr -> CoreExpr
forall a. Subable a => HashMap Var CoreExpr -> a -> a
sub HashMap Var CoreExpr
s CoreExpr
e)
 sub HashMap Var CoreExpr
s (Rec [(Var, CoreExpr)]
xes)      = [(Var, CoreExpr)] -> Bind Var
forall b. [(b, Expr b)] -> Bind b
Rec ((HashMap Var CoreExpr -> Var -> Var
forall a. Subable a => HashMap Var CoreExpr -> a -> a
sub HashMap Var CoreExpr
s (Var -> Var)
-> (CoreExpr -> CoreExpr) -> (Var, CoreExpr) -> (Var, CoreExpr)
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** HashMap Var CoreExpr -> CoreExpr -> CoreExpr
forall a. Subable a => HashMap Var CoreExpr -> a -> a
sub HashMap Var CoreExpr
s) ((Var, CoreExpr) -> (Var, CoreExpr))
-> [(Var, CoreExpr)] -> [(Var, CoreExpr)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Var, CoreExpr)]
xes)

 subTy :: HashMap Var Type -> Bind Var -> Bind Var
subTy HashMap Var Type
s (NonRec Var
x CoreExpr
e) = Var -> CoreExpr -> Bind Var
forall b. b -> Expr b -> Bind b
NonRec (HashMap Var Type -> Var -> Var
forall a. Subable a => HashMap Var Type -> a -> a
subTy HashMap Var Type
s Var
x) (HashMap Var Type -> CoreExpr -> CoreExpr
forall a. Subable a => HashMap Var Type -> a -> a
subTy HashMap Var Type
s CoreExpr
e)
 subTy HashMap Var Type
s (Rec [(Var, CoreExpr)]
xes)    = [(Var, CoreExpr)] -> Bind Var
forall b. [(b, Expr b)] -> Bind b
Rec ((HashMap Var Type -> Var -> Var
forall a. Subable a => HashMap Var Type -> a -> a
subTy HashMap Var Type
s  (Var -> Var)
-> (CoreExpr -> CoreExpr) -> (Var, CoreExpr) -> (Var, CoreExpr)
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** HashMap Var Type -> CoreExpr -> CoreExpr
forall a. Subable a => HashMap Var Type -> a -> a
subTy HashMap Var Type
s) ((Var, CoreExpr) -> (Var, CoreExpr))
-> [(Var, CoreExpr)] -> [(Var, CoreExpr)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Var, CoreExpr)]
xes)

instance Subable Type where
 sub :: HashMap Var CoreExpr -> Type -> Type
sub HashMap Var CoreExpr
_ Type
e   = Type
e
 subTy :: HashMap Var Type -> Type -> Type
subTy     = HashMap Var Type -> Type -> Type
substTysWith

substTysWith :: M.HashMap Var Type -> Type -> Type
substTysWith :: HashMap Var Type -> Type -> Type
substTysWith HashMap Var Type
s tv :: Type
tv@(TyVarTy Var
v)      = Type -> Var -> HashMap Var Type -> Type
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
M.lookupDefault Type
tv Var
v HashMap Var Type
s
substTysWith HashMap Var Type
s (FunTy FunTyFlag
aaf Type
m Type
t1 Type
t2) = FunTyFlag -> Type -> Type -> Type -> Type
FunTy FunTyFlag
aaf Type
m (HashMap Var Type -> Type -> Type
substTysWith HashMap Var Type
s Type
t1) (HashMap Var Type -> Type -> Type
substTysWith HashMap Var Type
s Type
t2)
substTysWith HashMap Var Type
s (ForAllTy ForAllTyBinder
v Type
t)      = ForAllTyBinder -> Type -> Type
ForAllTy ForAllTyBinder
v (HashMap Var Type -> Type -> Type
substTysWith (Var -> HashMap Var Type -> HashMap Var Type
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
M.delete (ForAllTyBinder -> Var
forall tv argf. VarBndr tv argf -> tv
binderVar ForAllTyBinder
v) HashMap Var Type
s) Type
t)
substTysWith HashMap Var Type
s (TyConApp TyCon
c [Type]
ts)     = TyCon -> [Type] -> Type
TyConApp TyCon
c ((Type -> Type) -> [Type] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map (HashMap Var Type -> Type -> Type
substTysWith HashMap Var Type
s) [Type]
ts)
substTysWith HashMap Var Type
s (AppTy Type
t1 Type
t2)       = Type -> Type -> Type
AppTy (HashMap Var Type -> Type -> Type
substTysWith HashMap Var Type
s Type
t1) (HashMap Var Type -> Type -> Type
substTysWith HashMap Var Type
s Type
t2)
substTysWith HashMap Var Type
_ (LitTy TyLit
t)           = TyLit -> Type
LitTy TyLit
t
substTysWith HashMap Var Type
s (CastTy Type
t KindCoercion
c)        = Type -> KindCoercion -> Type
CastTy (HashMap Var Type -> Type -> Type
substTysWith HashMap Var Type
s Type
t) KindCoercion
c
substTysWith HashMap Var Type
_ (CoercionTy KindCoercion
c)      = KindCoercion -> Type
CoercionTy KindCoercion
c

substExpr :: M.HashMap Var Var -> CoreExpr -> CoreExpr
substExpr :: HashMap Var Var -> CoreExpr -> CoreExpr
substExpr HashMap Var Var
s = CoreExpr -> CoreExpr
go
  where
    subsVar :: Var -> Var
subsVar Var
v                = Var -> Var -> HashMap Var Var -> Var
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
M.lookupDefault Var
v Var
v HashMap Var Var
s
    go :: CoreExpr -> CoreExpr
go (Var Var
v)               = Var -> CoreExpr
forall b. Var -> Expr b
Var (Var -> CoreExpr) -> Var -> CoreExpr
forall a b. (a -> b) -> a -> b
$ Var -> Var
subsVar Var
v
    go (Lit Literal
l)               = Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
l
    go (App CoreExpr
e1 CoreExpr
e2)           = CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
App (CoreExpr -> CoreExpr
go CoreExpr
e1) (CoreExpr -> CoreExpr
go CoreExpr
e2)
    go (Lam Var
x CoreExpr
e)             = Var -> CoreExpr -> CoreExpr
forall b. b -> Expr b -> Expr b
Lam (Var -> Var
subsVar Var
x) (CoreExpr -> CoreExpr
go CoreExpr
e)
    go (Let (NonRec Var
x CoreExpr
ex) CoreExpr
e) = Bind Var -> CoreExpr -> CoreExpr
forall b. Bind b -> Expr b -> Expr b
Let (Var -> CoreExpr -> Bind Var
forall b. b -> Expr b -> Bind b
NonRec (Var -> Var
subsVar Var
x) (CoreExpr -> CoreExpr
go CoreExpr
ex)) (CoreExpr -> CoreExpr
go CoreExpr
e)
    go (Let (Rec [(Var, CoreExpr)]
xes) CoreExpr
e)     = Bind Var -> CoreExpr -> CoreExpr
forall b. Bind b -> Expr b -> Expr b
Let ([(Var, CoreExpr)] -> Bind Var
forall b. [(b, Expr b)] -> Bind b
Rec [(Var -> Var
subsVar Var
x', CoreExpr -> CoreExpr
go CoreExpr
e') | (Var
x',CoreExpr
e') <- [(Var, CoreExpr)]
xes]) (CoreExpr -> CoreExpr
go CoreExpr
e)
    go (Case CoreExpr
e Var
b Type
t [Alt Var]
alts)     = CoreExpr -> Var -> Type -> [Alt Var] -> CoreExpr
forall b. Expr b -> b -> Type -> [Alt b] -> Expr b
Case (CoreExpr -> CoreExpr
go CoreExpr
e) (Var -> Var
subsVar Var
b) Type
t [AltCon -> [Var] -> CoreExpr -> Alt Var
forall b. AltCon -> [b] -> Expr b -> Alt b
Alt AltCon
c (Var -> Var
subsVar (Var -> Var) -> [Var] -> [Var]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Var]
xs) (CoreExpr -> CoreExpr
go CoreExpr
e') | Alt AltCon
c [Var]
xs CoreExpr
e' <- [Alt Var]
alts]
    go (Cast CoreExpr
e KindCoercion
c)            = CoreExpr -> KindCoercion -> CoreExpr
forall b. Expr b -> KindCoercion -> Expr b
Cast (CoreExpr -> CoreExpr
go CoreExpr
e) KindCoercion
c
    go (Tick CoreTickish
t CoreExpr
e)            = CoreTickish -> CoreExpr -> CoreExpr
forall b. CoreTickish -> Expr b -> Expr b
Tick CoreTickish
t (CoreExpr -> CoreExpr
go CoreExpr
e)
    go (Type Type
t)              = Type -> CoreExpr
forall b. Type -> Expr b
Type Type
t
    go (Coercion KindCoercion
c)          = KindCoercion -> CoreExpr
forall b. KindCoercion -> Expr b
Coercion KindCoercion
c

mapType :: (Type -> Type) -> Type -> Type
mapType :: (Type -> Type) -> Type -> Type
mapType Type -> Type
f = Type -> Type
go
  where
    go :: Type -> Type
go t :: Type
t@(TyVarTy Var
_)        = Type -> Type
f Type
t
    go (AppTy Type
t1 Type
t2)        = Type -> Type
f (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type -> Type
AppTy (Type -> Type
go Type
t1) (Type -> Type
go Type
t2)
    go (TyConApp TyCon
c [Type]
ts)      = Type -> Type
f (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ TyCon -> [Type] -> Type
TyConApp TyCon
c (Type -> Type
go (Type -> Type) -> [Type] -> [Type]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Type]
ts)
    go (FunTy FunTyFlag
aaf Type
m Type
t1 Type
t2)  = Type -> Type
f (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ FunTyFlag -> Type -> Type -> Type -> Type
FunTy FunTyFlag
aaf Type
m (Type -> Type
go Type
t1) (Type -> Type
go Type
t2)
    go (ForAllTy ForAllTyBinder
v Type
t)       = Type -> Type
f (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ ForAllTyBinder -> Type -> Type
ForAllTy ForAllTyBinder
v (Type -> Type
go Type
t)
    go t :: Type
t@(LitTy TyLit
_)          = Type -> Type
f Type
t
    go (CastTy Type
t KindCoercion
c)         = Type -> KindCoercion -> Type
CastTy (Type -> Type
go Type
t) KindCoercion
c
    go (CoercionTy KindCoercion
c)       = Type -> Type
f (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ KindCoercion -> Type
CoercionTy KindCoercion
c


stringClassArg :: Type -> Maybe Type
stringClassArg :: Type -> Maybe Type
stringClassArg Type
t | Type -> Bool
isFunTy Type
t
  = Maybe Type
forall a. Maybe a
Nothing
stringClassArg Type
t
  = case (Type -> Maybe TyCon
tyConAppTyCon_maybe Type
t, Type -> Maybe [Type]
tyConAppArgs_maybe Type
t) of
      (Just TyCon
c, Just [Type
t']) | Name
isStringClassName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon -> Name
tyConName TyCon
c
           -> Type -> Maybe Type
forall a. a -> Maybe a
Just Type
t'
      (Maybe TyCon, Maybe [Type])
_    -> Maybe Type
forall a. Maybe a
Nothing