{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Language.Haskell.Liquid.Types.PrettyPrint
(
OkRT
, rtypeDoc
, pprManyOrdered
, pprintLongList
, pprintSymbol
, printWarning
, Filter(..)
, getFilters
, reduceFilters
, defaultFilterReporter
, FilterReportErrorsArgs(..)
, filterReportErrorsWith
, filterReportErrors
) where
import qualified Data.HashMap.Strict as M
import qualified Data.List as L
import qualified Data.Set as Set
import Data.String
import Language.Fixpoint.Misc
import qualified Language.Fixpoint.Types as F
import qualified Liquid.GHC.API as Ghc
import Liquid.GHC.API as Ghc ( Class
, SrcSpan
, PprPrec
, Type
, Var
, Name
, SourceError
, topPrec
, funPrec
, srcSpanStartLine
, srcSpanStartCol
)
import Language.Haskell.Liquid.GHC.Logging
import Language.Haskell.Liquid.GHC.Misc
import Language.Haskell.Liquid.Misc
import Language.Haskell.Liquid.Types.Errors
import Language.Haskell.Liquid.Types.RType
import Language.Haskell.Liquid.Types.RTypeOp
import Language.Haskell.Liquid.Types.Types
import Language.Haskell.Liquid.UX.Config
import Prelude hiding (error)
import Text.PrettyPrint.HughesPJ hiding ((<>))
data Filter = StringFilter String
| AnyFilter
deriving (Filter -> Filter -> Bool
(Filter -> Filter -> Bool)
-> (Filter -> Filter -> Bool) -> Eq Filter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Filter -> Filter -> Bool
== :: Filter -> Filter -> Bool
$c/= :: Filter -> Filter -> Bool
/= :: Filter -> Filter -> Bool
Eq, Eq Filter
Eq Filter =>
(Filter -> Filter -> Ordering)
-> (Filter -> Filter -> Bool)
-> (Filter -> Filter -> Bool)
-> (Filter -> Filter -> Bool)
-> (Filter -> Filter -> Bool)
-> (Filter -> Filter -> Filter)
-> (Filter -> Filter -> Filter)
-> Ord Filter
Filter -> Filter -> Bool
Filter -> Filter -> Ordering
Filter -> Filter -> Filter
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
$ccompare :: Filter -> Filter -> Ordering
compare :: Filter -> Filter -> Ordering
$c< :: Filter -> Filter -> Bool
< :: Filter -> Filter -> Bool
$c<= :: Filter -> Filter -> Bool
<= :: Filter -> Filter -> Bool
$c> :: Filter -> Filter -> Bool
> :: Filter -> Filter -> Bool
$c>= :: Filter -> Filter -> Bool
>= :: Filter -> Filter -> Bool
$cmax :: Filter -> Filter -> Filter
max :: Filter -> Filter -> Filter
$cmin :: Filter -> Filter -> Filter
min :: Filter -> Filter -> Filter
Ord, Int -> Filter -> ShowS
[Filter] -> ShowS
Filter -> String
(Int -> Filter -> ShowS)
-> (Filter -> String) -> ([Filter] -> ShowS) -> Show Filter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Filter -> ShowS
showsPrec :: Int -> Filter -> ShowS
$cshow :: Filter -> String
show :: Filter -> String
$cshowList :: [Filter] -> ShowS
showList :: [Filter] -> ShowS
Show)
pprManyOrdered :: (PPrint a, Ord a) => F.Tidy -> String -> [a] -> [Doc]
pprManyOrdered :: forall a. (PPrint a, Ord a) => Tidy -> String -> [a] -> [Doc]
pprManyOrdered Tidy
k String
msg = (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> Doc
text String
msg Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (a -> Doc) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tidy -> a -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k) ([a] -> [Doc]) -> ([a] -> [a]) -> [a] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. Ord a => [a] -> [a]
L.sort
pprintLongList :: PPrint a => F.Tidy -> [a] -> Doc
pprintLongList :: forall a. PPrint a => Tidy -> [a] -> Doc
pprintLongList Tidy
k = Doc -> Doc
brackets (Doc -> Doc) -> ([a] -> Doc) -> [a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
vcat ([Doc] -> Doc) -> ([a] -> [Doc]) -> [a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Tidy -> a -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k)
pprintSymbol :: F.Symbol -> Doc
pprintSymbol :: Symbol -> Doc
pprintSymbol Symbol
x = Char -> Doc
char Char
'‘' Doc -> Doc -> Doc
<-> Symbol -> Doc
forall a. PPrint a => a -> Doc
pprint Symbol
x Doc -> Doc -> Doc
<-> Char -> Doc
char Char
'’'
instance PPrint SourceError where
pprintTidy :: Tidy -> SourceError -> Doc
pprintTidy Tidy
_ = String -> Doc
text (String -> Doc) -> (SourceError -> String) -> SourceError -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceError -> String
forall a. Show a => a -> String
show
instance PPrint Var where
pprintTidy :: Tidy -> Var -> Doc
pprintTidy Tidy
_ = Var -> Doc
forall a. Outputable a => a -> Doc
pprDoc
instance PPrint (Ghc.Expr Var) where
pprintTidy :: Tidy -> Expr Var -> Doc
pprintTidy Tidy
_ = Expr Var -> Doc
forall a. Outputable a => a -> Doc
pprDoc
instance PPrint (Ghc.Bind Var) where
pprintTidy :: Tidy -> Bind Var -> Doc
pprintTidy Tidy
_ = Bind Var -> Doc
forall a. Outputable a => a -> Doc
pprDoc
instance PPrint Name where
pprintTidy :: Tidy -> Name -> Doc
pprintTidy Tidy
_ = Name -> Doc
forall a. Outputable a => a -> Doc
pprDoc
instance PPrint Type where
pprintTidy :: Tidy -> Type -> Doc
pprintTidy Tidy
_ = Type -> Doc
forall a. Outputable a => a -> Doc
pprDoc
instance PPrint Class where
pprintTidy :: Tidy -> Class -> Doc
pprintTidy Tidy
F.Lossy = Doc -> Doc
shortModules (Doc -> Doc) -> (Class -> Doc) -> Class -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> Doc
forall a. Outputable a => a -> Doc
pprDoc
pprintTidy Tidy
F.Full = Class -> Doc
forall a. Outputable a => a -> Doc
pprDoc
instance Show Predicate where
show :: Predicate -> String
show = Predicate -> String
forall a. PPrint a => a -> String
showpp
instance (PPrint t) => PPrint (Annot t) where
pprintTidy :: Tidy -> Annot t -> Doc
pprintTidy Tidy
k (AnnUse t
t) = String -> Doc
text String
"AnnUse" Doc -> Doc -> Doc
<+> Tidy -> t -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k t
t
pprintTidy Tidy
k (AnnDef t
t) = String -> Doc
text String
"AnnDef" Doc -> Doc -> Doc
<+> Tidy -> t -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k t
t
pprintTidy Tidy
k (AnnRDf t
t) = String -> Doc
text String
"AnnRDf" Doc -> Doc -> Doc
<+> Tidy -> t -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k t
t
pprintTidy Tidy
_ (AnnLoc SrcSpan
l) = String -> Doc
text String
"AnnLoc" Doc -> Doc -> Doc
<+> SrcSpan -> Doc
forall a. Outputable a => a -> Doc
pprDoc SrcSpan
l
instance PPrint a => PPrint (AnnInfo a) where
pprintTidy :: Tidy -> AnnInfo a -> Doc
pprintTidy Tidy
k (AI HashMap SrcSpan [(Maybe Text, a)]
m) = [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Tidy -> (SrcSpan, [(Maybe Text, a)]) -> Doc
forall a b.
(PPrint a, PPrint b) =>
Tidy -> (SrcSpan, [(Maybe a, b)]) -> Doc
pprAnnInfoBinds Tidy
k ((SrcSpan, [(Maybe Text, a)]) -> Doc)
-> [(SrcSpan, [(Maybe Text, a)])] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap SrcSpan [(Maybe Text, a)] -> [(SrcSpan, [(Maybe Text, a)])]
forall k v. HashMap k v -> [(k, v)]
M.toList HashMap SrcSpan [(Maybe Text, a)]
m
instance PPrint a => Show (AnnInfo a) where
show :: AnnInfo a -> String
show = AnnInfo a -> String
forall a. PPrint a => a -> String
showpp
pprAnnInfoBinds :: (PPrint a, PPrint b) => F.Tidy -> (SrcSpan, [(Maybe a, b)]) -> Doc
pprAnnInfoBinds :: forall a b.
(PPrint a, PPrint b) =>
Tidy -> (SrcSpan, [(Maybe a, b)]) -> Doc
pprAnnInfoBinds Tidy
k (SrcSpan
l, [(Maybe a, b)]
xvs)
= [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Tidy -> (SrcSpan, (Maybe a, b)) -> Doc
forall a b.
(PPrint a, PPrint b) =>
Tidy -> (SrcSpan, (Maybe a, b)) -> Doc
pprAnnInfoBind Tidy
k ((SrcSpan, (Maybe a, b)) -> Doc)
-> ((Maybe a, b) -> (SrcSpan, (Maybe a, b))) -> (Maybe a, b) -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SrcSpan
l,) ((Maybe a, b) -> Doc) -> [(Maybe a, b)] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Maybe a, b)]
xvs
pprAnnInfoBind :: (PPrint a, PPrint b) => F.Tidy -> (SrcSpan, (Maybe a, b)) -> Doc
pprAnnInfoBind :: forall a b.
(PPrint a, PPrint b) =>
Tidy -> (SrcSpan, (Maybe a, b)) -> Doc
pprAnnInfoBind Tidy
k (Ghc.RealSrcSpan RealSrcSpan
sp Maybe BufSpan
_, (Maybe a, b)
xv)
= Doc
xd Doc -> Doc -> Doc
$$ Int -> Doc
forall a. Outputable a => a -> Doc
pprDoc Int
l Doc -> Doc -> Doc
$$ Int -> Doc
forall a. Outputable a => a -> Doc
pprDoc Int
c Doc -> Doc -> Doc
$$ Tidy -> Int -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k Int
n Doc -> Doc -> Doc
$$ Doc
vd Doc -> Doc -> Doc
$$ String -> Doc
text String
"\n\n\n"
where
l :: Int
l = RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
sp
c :: Int
c = RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
sp
(Doc
xd, Doc
vd) = Tidy -> (Maybe a, b) -> (Doc, Doc)
forall a a1.
(PPrint a, PPrint a1) =>
Tidy -> (Maybe a, a1) -> (Doc, Doc)
pprXOT Tidy
k (Maybe a, b)
xv
n :: Int
n = [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> Int) -> [String] -> Int
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ Doc -> String
render Doc
vd
pprAnnInfoBind Tidy
_ (SrcSpan
_, (Maybe a, b)
_)
= Doc
empty
pprXOT :: (PPrint a, PPrint a1) => F.Tidy -> (Maybe a, a1) -> (Doc, Doc)
pprXOT :: forall a a1.
(PPrint a, PPrint a1) =>
Tidy -> (Maybe a, a1) -> (Doc, Doc)
pprXOT Tidy
k (Maybe a
x, a1
v) = (Doc
xd, Tidy -> a1 -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k a1
v)
where
xd :: Doc
xd = Doc -> (a -> Doc) -> Maybe a -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
"unknown" (Tidy -> a -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k) Maybe a
x
instance (Ord v, F.Fixpoint v, PPrint v) => PPrint (LMapV v) where
pprintTidy :: Tidy -> LMapV v -> Doc
pprintTidy Tidy
_ (LMap LocSymbol
x [Symbol]
xs ExprV v
e) = [Doc] -> Doc
hcat [LocSymbol -> Doc
forall a. PPrint a => a -> Doc
pprint LocSymbol
x, [Symbol] -> Doc
forall a. PPrint a => a -> Doc
pprint [Symbol]
xs, String -> Doc
text String
"|->", ExprV v -> Doc
forall a. PPrint a => a -> Doc
pprint ExprV v
e ]
instance PPrint LogicMap where
pprintTidy :: Tidy -> LogicMap -> Doc
pprintTidy Tidy
_ (LM HashMap Symbol LMap
lm HashMap Var (Maybe Symbol)
am) = [Doc] -> Doc
vcat [ String -> Doc
text String
"Logic Map"
, Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"logic-map"
, Int -> Doc -> Doc
nest Int
4 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ HashMap Symbol LMap -> Doc
forall a. PPrint a => a -> Doc
pprint HashMap Symbol LMap
lm
, Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"axiom-map"
, Int -> Doc -> Doc
nest Int
4 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ HashMap Var (Maybe Symbol) -> Doc
forall a. PPrint a => a -> Doc
pprint HashMap Var (Maybe Symbol)
am
]
instance (OkRT c tv r) => PPrint (RType c tv r) where
pprintTidy :: Tidy -> RType c tv r -> Doc
pprintTidy Tidy
_ = Tidy -> RType c tv r -> Doc
forall c tv r. OkRT c tv r => Tidy -> RType c tv r -> Doc
rtypeDoc Tidy
F.Lossy
instance (PPrint tv, PPrint ty) => PPrint (RTAlias tv ty) where
pprintTidy :: Tidy -> RTAlias tv ty -> Doc
pprintTidy = Tidy -> RTAlias tv ty -> Doc
forall tv ty.
(PPrint tv, PPrint ty) =>
Tidy -> RTAlias tv ty -> Doc
ppAlias
ppAlias :: (PPrint tv, PPrint ty) => F.Tidy -> RTAlias tv ty -> Doc
ppAlias :: forall tv ty.
(PPrint tv, PPrint ty) =>
Tidy -> RTAlias tv ty -> Doc
ppAlias Tidy
k RTAlias tv ty
a = Symbol -> Doc
forall a. PPrint a => a -> Doc
pprint (RTAlias tv ty -> Symbol
forall x a. RTAlias x a -> Symbol
rtName RTAlias tv ty
a)
Doc -> Doc -> Doc
<+> Tidy -> Doc -> [tv] -> Doc
forall a. PPrint a => Tidy -> Doc -> [a] -> Doc
pprints Tidy
k Doc
space (RTAlias tv ty -> [tv]
forall x a. RTAlias x a -> [x]
rtTArgs RTAlias tv ty
a)
Doc -> Doc -> Doc
<+> Tidy -> Doc -> [Symbol] -> Doc
forall a. PPrint a => Tidy -> Doc -> [a] -> Doc
pprints Tidy
k Doc
space (RTAlias tv ty -> [Symbol]
forall x a. RTAlias x a -> [Symbol]
rtVArgs RTAlias tv ty
a)
Doc -> Doc -> Doc
<+> String -> Doc
text String
" = "
Doc -> Doc -> Doc
<+> ty -> Doc
forall a. PPrint a => a -> Doc
pprint (RTAlias tv ty -> ty
forall x a. RTAlias x a -> a
rtBody RTAlias tv ty
a)
instance (F.PPrint tv, F.PPrint t) => F.PPrint (RTEnv tv t) where
pprintTidy :: Tidy -> RTEnv tv t -> Doc
pprintTidy Tidy
k RTEnv tv t
rte
= String -> Doc
text String
"** Type Aliaes *********************"
Doc -> Doc -> Doc
$+$ Int -> Doc -> Doc
nest Int
4 (Tidy -> HashMap Symbol (Located (RTAlias tv t)) -> Doc
forall a. PPrint a => Tidy -> a -> Doc
F.pprintTidy Tidy
k (RTEnv tv t -> HashMap Symbol (Located (RTAlias tv t))
forall tv t. RTEnv tv t -> HashMap Symbol (Located (RTAlias tv t))
typeAliases RTEnv tv t
rte))
Doc -> Doc -> Doc
$+$ String -> Doc
text String
"** Expr Aliases ********************"
Doc -> Doc -> Doc
$+$ Int -> Doc -> Doc
nest Int
4 (Tidy -> HashMap Symbol (Located (RTAlias Symbol Expr)) -> Doc
forall a. PPrint a => Tidy -> a -> Doc
F.pprintTidy Tidy
k (RTEnv tv t -> HashMap Symbol (Located (RTAlias Symbol Expr))
forall tv t.
RTEnv tv t -> HashMap Symbol (Located (RTAlias Symbol Expr))
exprAliases RTEnv tv t
rte))
pprints :: (PPrint a) => F.Tidy -> Doc -> [a] -> Doc
pprints :: forall a. PPrint a => Tidy -> Doc -> [a] -> Doc
pprints Tidy
k Doc
c = [Doc] -> Doc
sep ([Doc] -> Doc) -> ([a] -> [Doc]) -> [a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
c ([Doc] -> [Doc]) -> ([a] -> [Doc]) -> [a] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Tidy -> a -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k)
rtypeDoc :: (OkRT c tv r) => F.Tidy -> RType c tv r -> Doc
rtypeDoc :: forall c tv r. OkRT c tv r => Tidy -> RType c tv r -> Doc
rtypeDoc Tidy
k = PPEnv -> Prec -> RType c tv r -> Doc
forall c tv r. OkRT c tv r => PPEnv -> Prec -> RType c tv r -> Doc
pprRtype (Tidy -> PPEnv
ppE Tidy
k) Prec
topPrec
where
ppE :: Tidy -> PPEnv
ppE Tidy
F.Lossy = PPEnv -> PPEnv
ppEnvShort PPEnv
ppEnv
ppE Tidy
F.Full = PPEnv
ppEnv
instance PPrint F.Tidy where
pprintTidy :: Tidy -> Tidy -> Doc
pprintTidy Tidy
_ Tidy
F.Full = Doc
"Full"
pprintTidy Tidy
_ Tidy
F.Lossy = Doc
"Lossy"
type Prec = PprPrec
pprRtype :: (OkRT c tv r) => PPEnv -> Prec -> RType c tv r -> Doc
pprRtype :: forall c tv r. OkRT c tv r => PPEnv -> Prec -> RType c tv r -> Doc
pprRtype PPEnv
bb Prec
p t :: RType c tv r
t@(RAllT RTVUV Symbol c tv
_ RType c tv r
_ r
r)
= r -> Doc -> Doc
forall r. Reftable r => r -> Doc -> Doc
ppTy r
r (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ PPEnv -> Prec -> RType c tv r -> Doc
forall c tv r. OkRT c tv r => PPEnv -> Prec -> RType c tv r -> Doc
pprForall PPEnv
bb Prec
p RType c tv r
t
pprRtype PPEnv
bb Prec
p t :: RType c tv r
t@(RAllP PVUV Symbol c tv
_ RType c tv r
_)
= PPEnv -> Prec -> RType c tv r -> Doc
forall c tv r. OkRT c tv r => PPEnv -> Prec -> RType c tv r -> Doc
pprForall PPEnv
bb Prec
p RType c tv r
t
pprRtype PPEnv
_ Prec
_ (RVar tv
a r
r)
= r -> Doc -> Doc
forall r. Reftable r => r -> Doc -> Doc
ppTy r
r (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ tv -> Doc
forall a. PPrint a => a -> Doc
pprint tv
a
pprRtype PPEnv
bb Prec
p t :: RType c tv r
t@RFun{}
= Prec -> Prec -> Doc -> Doc
maybeParen Prec
p Prec
funPrec (PPEnv -> Doc -> RType c tv r -> Doc
forall c tv r.
(OkRT c tv r, PPrint (RType c tv r), PPrint (RType c tv ())) =>
PPEnv -> Doc -> RType c tv r -> Doc
pprRtyFun PPEnv
bb Doc
empty RType c tv r
t)
pprRtype PPEnv
bb Prec
p (RApp c
c [RType c tv r
t] [Ref (RType c tv ()) (RType c tv r)]
rs r
r)
| c -> Bool
forall c. TyConable c => c -> Bool
isList c
c
= r -> Doc -> Doc
forall r. Reftable r => r -> Doc -> Doc
ppTy r
r (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
brackets (PPEnv -> Prec -> RType c tv r -> Doc
forall c tv r. OkRT c tv r => PPEnv -> Prec -> RType c tv r -> Doc
pprRtype PPEnv
bb Prec
p RType c tv r
t) Doc -> Doc -> Doc
<-> PPEnv -> Prec -> [Ref (RType c tv ()) (RType c tv r)] -> Doc
forall c tv r t t1.
(OkRT c tv r, PPrint (RType c tv r), PPrint (RType c tv ()),
Reftable (Ref (RType c tv ()) (RType c tv r))) =>
t -> t1 -> [Ref (RType c tv ()) (RType c tv r)] -> Doc
ppReftPs PPEnv
bb Prec
p [Ref (RType c tv ()) (RType c tv r)]
rs
pprRtype PPEnv
bb Prec
p (RApp c
c [RType c tv r]
ts [Ref (RType c tv ()) (RType c tv r)]
rs r
r)
| c -> Bool
forall c. TyConable c => c -> Bool
isTuple c
c
= r -> Doc -> Doc
forall r. Reftable r => r -> Doc -> Doc
ppTy r
r (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
parens (Doc -> [Doc] -> Doc
intersperse Doc
comma (PPEnv -> Prec -> RType c tv r -> Doc
forall c tv r. OkRT c tv r => PPEnv -> Prec -> RType c tv r -> Doc
pprRtype PPEnv
bb Prec
p (RType c tv r -> Doc) -> [RType c tv r] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RType c tv r]
ts)) Doc -> Doc -> Doc
<-> PPEnv -> Prec -> [Ref (RType c tv ()) (RType c tv r)] -> Doc
forall c tv r t t1.
(OkRT c tv r, PPrint (RType c tv r), PPrint (RType c tv ()),
Reftable (Ref (RType c tv ()) (RType c tv r))) =>
t -> t1 -> [Ref (RType c tv ()) (RType c tv r)] -> Doc
ppReftPs PPEnv
bb Prec
p [Ref (RType c tv ()) (RType c tv r)]
rs
pprRtype PPEnv
bb Prec
p (RApp c
c [RType c tv r]
ts [Ref (RType c tv ()) (RType c tv r)]
rs r
r)
| Doc -> Bool
isEmpty Doc
rsDoc Bool -> Bool -> Bool
&& Doc -> Bool
isEmpty Doc
tsDoc
= r -> Doc -> Doc
forall r. Reftable r => r -> Doc -> Doc
ppTy r
r (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ c -> Doc
ppT c
c
| Bool
otherwise
= r -> Doc -> Doc
forall r. Reftable r => r -> Doc -> Doc
ppTy r
r (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ c -> Doc
ppT c
c Doc -> Doc -> Doc
<+> Doc
rsDoc Doc -> Doc -> Doc
<+> Doc
tsDoc
where
rsDoc :: Doc
rsDoc = PPEnv -> Prec -> [Ref (RType c tv ()) (RType c tv r)] -> Doc
forall c tv r t t1.
(OkRT c tv r, PPrint (RType c tv r), PPrint (RType c tv ()),
Reftable (Ref (RType c tv ()) (RType c tv r))) =>
t -> t1 -> [Ref (RType c tv ()) (RType c tv r)] -> Doc
ppReftPs PPEnv
bb Prec
p [Ref (RType c tv ()) (RType c tv r)]
rs
tsDoc :: Doc
tsDoc = [Doc] -> Doc
hsep (PPEnv -> Prec -> RType c tv r -> Doc
forall c tv r. OkRT c tv r => PPEnv -> Prec -> RType c tv r -> Doc
pprRtype PPEnv
bb Prec
p (RType c tv r -> Doc) -> [RType c tv r] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RType c tv r]
ts)
ppT :: c -> Doc
ppT = PPEnv -> c -> Doc
forall c. TyConable c => PPEnv -> c -> Doc
ppTyConB PPEnv
bb
pprRtype PPEnv
bb Prec
p t :: RType c tv r
t@REx{}
= PPEnv -> Prec -> RType c tv r -> Doc
forall c tv r.
(OkRT c tv r, PPrint c, PPrint tv, PPrint (RType c tv r),
PPrint (RType c tv ())) =>
PPEnv -> Prec -> RType c tv r -> Doc
ppExists PPEnv
bb Prec
p RType c tv r
t
pprRtype PPEnv
bb Prec
p t :: RType c tv r
t@RAllE{}
= PPEnv -> Prec -> RType c tv r -> Doc
forall c tv r.
(OkRT c tv r, PPrint (RType c tv r), PPrint (RType c tv ())) =>
PPEnv -> Prec -> RType c tv r -> Doc
ppAllExpr PPEnv
bb Prec
p RType c tv r
t
pprRtype PPEnv
_ Prec
_ (RExprArg Located Expr
e)
= Doc -> Doc
braces (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Located Expr -> Doc
forall a. PPrint a => a -> Doc
pprint Located Expr
e
pprRtype PPEnv
bb Prec
p (RAppTy RType c tv r
t RType c tv r
t' r
r)
= r -> Doc -> Doc
forall r. Reftable r => r -> Doc -> Doc
ppTy r
r (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ PPEnv -> Prec -> RType c tv r -> Doc
forall c tv r. OkRT c tv r => PPEnv -> Prec -> RType c tv r -> Doc
pprRtype PPEnv
bb Prec
p RType c tv r
t Doc -> Doc -> Doc
<+> PPEnv -> Prec -> RType c tv r -> Doc
forall c tv r. OkRT c tv r => PPEnv -> Prec -> RType c tv r -> Doc
pprRtype PPEnv
bb Prec
p RType c tv r
t'
pprRtype PPEnv
bb Prec
p (RRTy [(Symbol, RType c tv r)]
e r
_ Oblig
OCons RType c tv r
t)
= [Doc] -> Doc
sep [Doc -> Doc
braces (PPEnv -> Prec -> [(Symbol, RType c tv r)] -> Doc
forall c tv r a.
(OkRT c tv r, PPrint a, PPrint (RType c tv r),
PPrint (RType c tv ())) =>
PPEnv -> Prec -> [(a, RType c tv r)] -> Doc
pprRsubtype PPEnv
bb Prec
p [(Symbol, RType c tv r)]
e) Doc -> Doc -> Doc
<+> Doc
"=>", PPEnv -> Prec -> RType c tv r -> Doc
forall c tv r. OkRT c tv r => PPEnv -> Prec -> RType c tv r -> Doc
pprRtype PPEnv
bb Prec
p RType c tv r
t]
pprRtype PPEnv
bb Prec
p (RRTy [(Symbol, RType c tv r)]
e r
r Oblig
o RType c tv r
rt)
= [Doc] -> Doc
sep [Doc -> Doc
ppp (Oblig -> Doc
forall a. PPrint a => a -> Doc
pprint Oblig
o Doc -> Doc -> Doc
<+> Doc
ppe Doc -> Doc -> Doc
<+> r -> Doc
forall a. PPrint a => a -> Doc
pprint r
r), PPEnv -> Prec -> RType c tv r -> Doc
forall c tv r. OkRT c tv r => PPEnv -> Prec -> RType c tv r -> Doc
pprRtype PPEnv
bb Prec
p RType c tv r
rt]
where
ppe :: Doc
ppe = [Doc] -> Doc
hsep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ((Symbol, RType c tv r) -> Doc
ppxt ((Symbol, RType c tv r) -> Doc)
-> [(Symbol, RType c tv r)] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Symbol, RType c tv r)]
e)) Doc -> Doc -> Doc
<+> Doc
dcolon
ppp :: Doc -> Doc
ppp Doc
doc = String -> Doc
text String
"<<" Doc -> Doc -> Doc
<+> Doc
doc Doc -> Doc -> Doc
<+> String -> Doc
text String
">>"
ppxt :: (Symbol, RType c tv r) -> Doc
ppxt (Symbol
x, RType c tv r
t) = Symbol -> Doc
forall a. PPrint a => a -> Doc
pprint Symbol
x Doc -> Doc -> Doc
<+> Doc
":" Doc -> Doc -> Doc
<+> PPEnv -> Prec -> RType c tv r -> Doc
forall c tv r. OkRT c tv r => PPEnv -> Prec -> RType c tv r -> Doc
pprRtype PPEnv
bb Prec
p RType c tv r
t
pprRtype PPEnv
_ Prec
_ (RHole r
r)
= r -> Doc -> Doc
forall r. Reftable r => r -> Doc -> Doc
ppTy r
r (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"_"
ppTyConB :: TyConable c => PPEnv -> c -> Doc
ppTyConB :: forall c. TyConable c => PPEnv -> c -> Doc
ppTyConB PPEnv
bb
| PPEnv -> Bool
ppShort PPEnv
bb = c -> Doc
forall c. TyConable c => c -> Doc
ppTycon
| Bool
otherwise = c -> Doc
forall c. TyConable c => c -> Doc
ppTycon
shortModules :: Doc -> Doc
shortModules :: Doc -> Doc
shortModules = String -> Doc
text (String -> Doc) -> (Doc -> String) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> String
F.symbolString (Symbol -> String) -> (Doc -> Symbol) -> Doc -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Symbol
dropModuleNames (Symbol -> Symbol) -> (Doc -> Symbol) -> Doc -> Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Symbol
forall a. Symbolic a => a -> Symbol
F.symbol (String -> Symbol) -> (Doc -> String) -> Doc -> Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> String
render
pprRsubtype
:: (OkRT c tv r, PPrint a, PPrint (RType c tv r), PPrint (RType c tv ()))
=> PPEnv -> Prec -> [(a, RType c tv r)] -> Doc
pprRsubtype :: forall c tv r a.
(OkRT c tv r, PPrint a, PPrint (RType c tv r),
PPrint (RType c tv ())) =>
PPEnv -> Prec -> [(a, RType c tv r)] -> Doc
pprRsubtype PPEnv
bb Prec
p [(a, RType c tv r)]
e
= Doc
pprint_env Doc -> Doc -> Doc
<+> String -> Doc
text String
"|-" Doc -> Doc -> Doc
<+> PPEnv -> Prec -> RType c tv r -> Doc
forall c tv r. OkRT c tv r => PPEnv -> Prec -> RType c tv r -> Doc
pprRtype PPEnv
bb Prec
p RType c tv r
tl Doc -> Doc -> Doc
<+> Doc
"<:" Doc -> Doc -> Doc
<+> PPEnv -> Prec -> RType c tv r -> Doc
forall c tv r. OkRT c tv r => PPEnv -> Prec -> RType c tv r -> Doc
pprRtype PPEnv
bb Prec
p RType c tv r
tr
where
([(a, RType c tv r)]
el, (a, RType c tv r)
r) = ([(a, RType c tv r)] -> [(a, RType c tv r)]
forall a. HasCallStack => [a] -> [a]
init [(a, RType c tv r)]
e, [(a, RType c tv r)] -> (a, RType c tv r)
forall a. HasCallStack => [a] -> a
last [(a, RType c tv r)]
e)
([(a, RType c tv r)]
env, (a, RType c tv r)
l) = ([(a, RType c tv r)] -> [(a, RType c tv r)]
forall a. HasCallStack => [a] -> [a]
init [(a, RType c tv r)]
el, [(a, RType c tv r)] -> (a, RType c tv r)
forall a. HasCallStack => [a] -> a
last [(a, RType c tv r)]
el)
tr :: RType c tv r
tr = (a, RType c tv r) -> RType c tv r
forall a b. (a, b) -> b
snd (a, RType c tv r)
r
tl :: RType c tv r
tl = (a, RType c tv r) -> RType c tv r
forall a b. (a, b) -> b
snd (a, RType c tv r)
l
pprint_bind :: (a, RType c tv r) -> Doc
pprint_bind (a
x, RType c tv r
t) = a -> Doc
forall a. PPrint a => a -> Doc
pprint a
x Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<-> Doc
colon Doc -> Doc -> Doc
<+> PPEnv -> Prec -> RType c tv r -> Doc
forall c tv r. OkRT c tv r => PPEnv -> Prec -> RType c tv r -> Doc
pprRtype PPEnv
bb Prec
p RType c tv r
t
pprint_env :: Doc
pprint_env = [Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma ((a, RType c tv r) -> Doc
pprint_bind ((a, RType c tv r) -> Doc) -> [(a, RType c tv r)] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, RType c tv r)]
env)
maybeParen :: Prec -> Prec -> Doc -> Doc
maybeParen :: Prec -> Prec -> Doc -> Doc
maybeParen Prec
ctxt_prec Prec
inner_prec Doc
pretty
| Prec
ctxt_prec Prec -> Prec -> Bool
forall a. Ord a => a -> a -> Bool
< Prec
inner_prec = Doc
pretty
| Bool
otherwise = Doc -> Doc
parens Doc
pretty
ppExists
:: (OkRT c tv r, PPrint c, PPrint tv, PPrint (RType c tv r),
PPrint (RType c tv ()))
=> PPEnv -> Prec -> RType c tv r -> Doc
ppExists :: forall c tv r.
(OkRT c tv r, PPrint c, PPrint tv, PPrint (RType c tv r),
PPrint (RType c tv ())) =>
PPEnv -> Prec -> RType c tv r -> Doc
ppExists PPEnv
bb Prec
p RType c tv r
rt
= String -> Doc
text String
"exists" Doc -> Doc -> Doc
<+> Doc -> Doc
brackets (Doc -> [Doc] -> Doc
intersperse Doc
comma [PPEnv -> Prec -> Symbol -> RType c tv r -> Doc
forall c tv r.
(OkRT c tv r, PPrint (RType c tv r), PPrint (RType c tv ())) =>
PPEnv -> Prec -> Symbol -> RType c tv r -> Doc
pprDbind PPEnv
bb Prec
topPrec Symbol
x RType c tv r
t | (Symbol
x, RType c tv r
t) <- [(Symbol, RType c tv r)]
ws]) Doc -> Doc -> Doc
<-> Doc
dot Doc -> Doc -> Doc
<-> PPEnv -> Prec -> RType c tv r -> Doc
forall c tv r. OkRT c tv r => PPEnv -> Prec -> RType c tv r -> Doc
pprRtype PPEnv
bb Prec
p RType c tv r
rt'
where ([(Symbol, RType c tv r)]
ws, RType c tv r
rt') = [(Symbol, RType c tv r)]
-> RType c tv r -> ([(Symbol, RType c tv r)], RType c tv r)
forall {v} {c} {tv} {r}.
[(Symbol, RTypeV v c tv r)]
-> RTypeV v c tv r
-> ([(Symbol, RTypeV v c tv r)], RTypeV v c tv r)
split [] RType c tv r
rt
split :: [(Symbol, RTypeV v c tv r)]
-> RTypeV v c tv r
-> ([(Symbol, RTypeV v c tv r)], RTypeV v c tv r)
split [(Symbol, RTypeV v c tv r)]
zs (REx Symbol
x RTypeV v c tv r
t RTypeV v c tv r
t') = [(Symbol, RTypeV v c tv r)]
-> RTypeV v c tv r
-> ([(Symbol, RTypeV v c tv r)], RTypeV v c tv r)
split ((Symbol
x,RTypeV v c tv r
t)(Symbol, RTypeV v c tv r)
-> [(Symbol, RTypeV v c tv r)] -> [(Symbol, RTypeV v c tv r)]
forall a. a -> [a] -> [a]
:[(Symbol, RTypeV v c tv r)]
zs) RTypeV v c tv r
t'
split [(Symbol, RTypeV v c tv r)]
zs RTypeV v c tv r
t = ([(Symbol, RTypeV v c tv r)] -> [(Symbol, RTypeV v c tv r)]
forall a. [a] -> [a]
reverse [(Symbol, RTypeV v c tv r)]
zs, RTypeV v c tv r
t)
ppAllExpr
:: (OkRT c tv r, PPrint (RType c tv r), PPrint (RType c tv ()))
=> PPEnv -> Prec -> RType c tv r -> Doc
ppAllExpr :: forall c tv r.
(OkRT c tv r, PPrint (RType c tv r), PPrint (RType c tv ())) =>
PPEnv -> Prec -> RType c tv r -> Doc
ppAllExpr PPEnv
bb Prec
p RType c tv r
rt
= String -> Doc
text String
"forall" Doc -> Doc -> Doc
<+> Doc -> Doc
brackets (Doc -> [Doc] -> Doc
intersperse Doc
comma [PPEnv -> Prec -> Symbol -> RType c tv r -> Doc
forall c tv r.
(OkRT c tv r, PPrint (RType c tv r), PPrint (RType c tv ())) =>
PPEnv -> Prec -> Symbol -> RType c tv r -> Doc
pprDbind PPEnv
bb Prec
topPrec Symbol
x RType c tv r
t | (Symbol
x, RType c tv r
t) <- [(Symbol, RType c tv r)]
ws]) Doc -> Doc -> Doc
<-> Doc
dot Doc -> Doc -> Doc
<-> PPEnv -> Prec -> RType c tv r -> Doc
forall c tv r. OkRT c tv r => PPEnv -> Prec -> RType c tv r -> Doc
pprRtype PPEnv
bb Prec
p RType c tv r
rt'
where
([(Symbol, RType c tv r)]
ws, RType c tv r
rt') = [(Symbol, RType c tv r)]
-> RType c tv r -> ([(Symbol, RType c tv r)], RType c tv r)
forall {v} {c} {tv} {r}.
[(Symbol, RTypeV v c tv r)]
-> RTypeV v c tv r
-> ([(Symbol, RTypeV v c tv r)], RTypeV v c tv r)
split [] RType c tv r
rt
split :: [(Symbol, RTypeV v c tv r)]
-> RTypeV v c tv r
-> ([(Symbol, RTypeV v c tv r)], RTypeV v c tv r)
split [(Symbol, RTypeV v c tv r)]
zs (RAllE Symbol
x RTypeV v c tv r
t RTypeV v c tv r
t') = [(Symbol, RTypeV v c tv r)]
-> RTypeV v c tv r
-> ([(Symbol, RTypeV v c tv r)], RTypeV v c tv r)
split ((Symbol
x,RTypeV v c tv r
t)(Symbol, RTypeV v c tv r)
-> [(Symbol, RTypeV v c tv r)] -> [(Symbol, RTypeV v c tv r)]
forall a. a -> [a] -> [a]
:[(Symbol, RTypeV v c tv r)]
zs) RTypeV v c tv r
t'
split [(Symbol, RTypeV v c tv r)]
zs RTypeV v c tv r
t = ([(Symbol, RTypeV v c tv r)] -> [(Symbol, RTypeV v c tv r)]
forall a. [a] -> [a]
reverse [(Symbol, RTypeV v c tv r)]
zs, RTypeV v c tv r
t)
ppReftPs
:: (OkRT c tv r, PPrint (RType c tv r), PPrint (RType c tv ()),
Reftable (Ref (RType c tv ()) (RType c tv r)))
=> t -> t1 -> [Ref (RType c tv ()) (RType c tv r)] -> Doc
ppReftPs :: forall c tv r t t1.
(OkRT c tv r, PPrint (RType c tv r), PPrint (RType c tv ()),
Reftable (Ref (RType c tv ()) (RType c tv r))) =>
t -> t1 -> [Ref (RType c tv ()) (RType c tv r)] -> Doc
ppReftPs t
_ t1
_ [Ref (RType c tv ()) (RType c tv r)]
rs
| (Ref (RType c tv ()) (RType c tv r) -> Bool)
-> [Ref (RType c tv ()) (RType c tv r)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Ref (RType c tv ()) (RType c tv r) -> Bool
forall r. Reftable r => r -> Bool
isTauto [Ref (RType c tv ()) (RType c tv r)]
rs = Doc
empty
| Bool -> Bool
not (PPEnv -> Bool
ppPs PPEnv
ppEnv) = Doc
empty
| Bool
otherwise = Doc -> Doc
angleBrackets (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ Ref (RType c tv ()) (RType c tv r) -> Doc
forall c tv r.
OkRT c tv r =>
Ref (RType c tv ()) (RType c tv r) -> Doc
pprRef (Ref (RType c tv ()) (RType c tv r) -> Doc)
-> [Ref (RType c tv ()) (RType c tv r)] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Ref (RType c tv ()) (RType c tv r)]
rs
pprDbind
:: (OkRT c tv r, PPrint (RType c tv r), PPrint (RType c tv ()))
=> PPEnv -> Prec -> F.Symbol -> RType c tv r -> Doc
pprDbind :: forall c tv r.
(OkRT c tv r, PPrint (RType c tv r), PPrint (RType c tv ())) =>
PPEnv -> Prec -> Symbol -> RType c tv r -> Doc
pprDbind PPEnv
bb Prec
p Symbol
x RType c tv r
t
| Symbol -> Bool
F.isNonSymbol Symbol
x Bool -> Bool -> Bool
|| (Symbol
x Symbol -> Symbol -> Bool
forall a. Eq a => a -> a -> Bool
== Symbol
F.dummySymbol)
= PPEnv -> Prec -> RType c tv r -> Doc
forall c tv r. OkRT c tv r => PPEnv -> Prec -> RType c tv r -> Doc
pprRtype PPEnv
bb Prec
p RType c tv r
t
| Bool
otherwise
= Symbol -> Doc
forall a. PPrint a => a -> Doc
pprint Symbol
x Doc -> Doc -> Doc
<-> Doc
colon Doc -> Doc -> Doc
<-> PPEnv -> Prec -> RType c tv r -> Doc
forall c tv r. OkRT c tv r => PPEnv -> Prec -> RType c tv r -> Doc
pprRtype PPEnv
bb Prec
p RType c tv r
t
pprRtyFun
:: ( OkRT c tv r, PPrint (RType c tv r), PPrint (RType c tv ()))
=> PPEnv -> Doc -> RType c tv r -> Doc
pprRtyFun :: forall c tv r.
(OkRT c tv r, PPrint (RType c tv r), PPrint (RType c tv ())) =>
PPEnv -> Doc -> RType c tv r -> Doc
pprRtyFun PPEnv
bb Doc
prefix RType c tv r
rt = [Doc] -> Doc
hsep (Doc
prefix Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: [Doc]
dArgs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc
dOut])
where
dArgs :: [Doc]
dArgs = ((Symbol, RType c tv r, Doc) -> [Doc])
-> [(Symbol, RType c tv r, Doc)] -> [Doc]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Symbol, RType c tv r, Doc) -> [Doc]
ppArg [(Symbol, RType c tv r, Doc)]
args
dOut :: Doc
dOut = PPEnv -> Prec -> RType c tv r -> Doc
forall c tv r. OkRT c tv r => PPEnv -> Prec -> RType c tv r -> Doc
pprRtype PPEnv
bb Prec
topPrec RType c tv r
out
ppArg :: (Symbol, RType c tv r, Doc) -> [Doc]
ppArg (Symbol
b, RType c tv r
t, Doc
a) = [PPEnv -> Prec -> Symbol -> RType c tv r -> Doc
forall c tv r.
(OkRT c tv r, PPrint (RType c tv r), PPrint (RType c tv ())) =>
PPEnv -> Prec -> Symbol -> RType c tv r -> Doc
pprDbind PPEnv
bb Prec
funPrec Symbol
b RType c tv r
t, Doc
a]
([(Symbol, RType c tv r, Doc)]
args, RType c tv r
out) = RType c tv r -> ([(Symbol, RType c tv r, Doc)], RType c tv r)
forall c tv r.
RType c tv r -> ([(Symbol, RType c tv r, Doc)], RType c tv r)
brkFun RType c tv r
rt
brkFun :: RType c tv r -> ([(F.Symbol, RType c tv r, Doc)], RType c tv r)
brkFun :: forall c tv r.
RType c tv r -> ([(Symbol, RType c tv r, Doc)], RType c tv r)
brkFun (RFun Symbol
b RFInfo
_ RTypeV Symbol c tv r
t RTypeV Symbol c tv r
t' r
_) = ((Symbol
b, RTypeV Symbol c tv r
t, String -> Doc
text String
"->") (Symbol, RTypeV Symbol c tv r, Doc)
-> [(Symbol, RTypeV Symbol c tv r, Doc)]
-> [(Symbol, RTypeV Symbol c tv r, Doc)]
forall a. a -> [a] -> [a]
: [(Symbol, RTypeV Symbol c tv r, Doc)]
args, RTypeV Symbol c tv r
out)
where ([(Symbol, RTypeV Symbol c tv r, Doc)]
args, RTypeV Symbol c tv r
out) = RTypeV Symbol c tv r
-> ([(Symbol, RTypeV Symbol c tv r, Doc)], RTypeV Symbol c tv r)
forall c tv r.
RType c tv r -> ([(Symbol, RType c tv r, Doc)], RType c tv r)
brkFun RTypeV Symbol c tv r
t'
brkFun RTypeV Symbol c tv r
out = ([], RTypeV Symbol c tv r
out)
pprForall :: (OkRT c tv r) => PPEnv -> Prec -> RType c tv r -> Doc
pprForall :: forall c tv r. OkRT c tv r => PPEnv -> Prec -> RType c tv r -> Doc
pprForall PPEnv
bb Prec
p RType c tv r
t = Prec -> Prec -> Doc -> Doc
maybeParen Prec
p Prec
funPrec (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
sep [
Bool -> [RTVar tv (RType c tv ())] -> [PVar (RType c tv ())] -> Doc
pprForalls (PPEnv -> Bool
ppPs PPEnv
bb) ((RTVar tv (RType c tv ()), r) -> RTVar tv (RType c tv ())
forall a b. (a, b) -> a
fst ((RTVar tv (RType c tv ()), r) -> RTVar tv (RType c tv ()))
-> [(RTVar tv (RType c tv ()), r)] -> [RTVar tv (RType c tv ())]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RTypeRepV Symbol c tv r -> [(RTVar tv (RType c tv ()), r)]
forall v c tv r.
RTypeRepV v c tv r -> [(RTVar tv (RTypeV v c tv ()), r)]
ty_vars RTypeRepV Symbol c tv r
trep) (RTypeRepV Symbol c tv r -> [PVar (RType c tv ())]
forall v c tv r. RTypeRepV v c tv r -> [PVarV v (RTypeV v c tv ())]
ty_preds RTypeRepV Symbol c tv r
trep)
, [(c, [RType c tv r])] -> Doc
pprClss [(c, [RType c tv r])]
cls
, PPEnv -> Prec -> RType c tv r -> Doc
forall c tv r. OkRT c tv r => PPEnv -> Prec -> RType c tv r -> Doc
pprRtype PPEnv
bb Prec
topPrec RType c tv r
t'
]
where
trep :: RTypeRepV Symbol c tv r
trep = RType c tv r -> RTypeRepV Symbol c tv r
forall v c tv r. RTypeV v c tv r -> RTypeRepV v c tv r
toRTypeRep RType c tv r
t
([(c, [RType c tv r])]
cls, RType c tv r
t') = RType c tv r -> ([(c, [RType c tv r])], RType c tv r)
forall c tv r.
(PPrint c, TyConable c) =>
RType c tv r -> ([(c, [RType c tv r])], RType c tv r)
bkClass (RType c tv r -> ([(c, [RType c tv r])], RType c tv r))
-> RType c tv r -> ([(c, [RType c tv r])], RType c tv r)
forall a b. (a -> b) -> a -> b
$ RTypeRepV Symbol c tv r -> RType c tv r
forall v c tv r. RTypeRepV v c tv r -> RTypeV v c tv r
fromRTypeRep (RTypeRepV Symbol c tv r -> RType c tv r)
-> RTypeRepV Symbol c tv r -> RType c tv r
forall a b. (a -> b) -> a -> b
$ RTypeRepV Symbol c tv r
trep {ty_vars = [], ty_preds = []}
pprForalls :: Bool -> [RTVar tv (RType c tv ())] -> [PVar (RType c tv ())] -> Doc
pprForalls Bool
False [RTVar tv (RType c tv ())]
_ [PVar (RType c tv ())]
_ = Doc
empty
pprForalls Bool
_ [] [] = Doc
empty
pprForalls Bool
True [RTVar tv (RType c tv ())]
αs [PVar (RType c tv ())]
πs = String -> Doc
text String
"forall" Doc -> Doc -> Doc
<+> [RTVar tv (RType c tv ())] -> Doc
forall {tv} {c}. PPrint tv => [RTVar tv (RType c tv ())] -> Doc
dαs [RTVar tv (RType c tv ())]
αs Doc -> Doc -> Doc
<+> Bool -> [PVar (RType c tv ())] -> Doc
dπs (PPEnv -> Bool
ppPs PPEnv
bb) [PVar (RType c tv ())]
πs Doc -> Doc -> Doc
<-> Doc
dot
pprClss :: [(c, [RType c tv r])] -> Doc
pprClss [] = Doc
empty
pprClss [(c, [RType c tv r])]
cs = Doc -> Doc
parens ([Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma ((c -> [RType c tv r] -> Doc) -> (c, [RType c tv r]) -> Doc
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (PPEnv -> Prec -> c -> [RType c tv r] -> Doc
forall c tv r a.
(OkRT c tv r, PPrint a, PPrint (RType c tv r),
PPrint (RType c tv ())) =>
PPEnv -> Prec -> a -> [RType c tv r] -> Doc
pprCls PPEnv
bb Prec
p) ((c, [RType c tv r]) -> Doc) -> [(c, [RType c tv r])] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(c, [RType c tv r])]
cs)) Doc -> Doc -> Doc
<+> String -> Doc
text String
"=>"
dαs :: [RTVar tv (RType c tv ())] -> Doc
dαs [RTVar tv (RType c tv ())]
αs = [RTVar tv (RType c tv ())] -> Doc
forall {tv} {c}. PPrint tv => [RTVar tv (RType c tv ())] -> Doc
pprRtvarDef [RTVar tv (RType c tv ())]
αs
dπs :: Bool -> [PVar (RType c tv ())] -> Doc
dπs Bool
_ [] = Doc
empty
dπs Bool
False [PVar (RType c tv ())]
_ = Doc
empty
dπs Bool
True [PVar (RType c tv ())]
πs = Doc -> Doc
angleBrackets (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> Doc
intersperse Doc
comma ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ PPEnv -> Prec -> PVar (RType c tv ()) -> Doc
forall c tv.
OkRT c tv () =>
PPEnv -> Prec -> PVar (RType c tv ()) -> Doc
pprPvarDef PPEnv
bb Prec
p (PVar (RType c tv ()) -> Doc) -> [PVar (RType c tv ())] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PVar (RType c tv ())]
πs
pprRtvarDef :: (PPrint tv) => [RTVar tv (RType c tv ())] -> Doc
pprRtvarDef :: forall {tv} {c}. PPrint tv => [RTVar tv (RType c tv ())] -> Doc
pprRtvarDef = [Doc] -> Doc
sep ([Doc] -> Doc)
-> ([RTVar tv (RType c tv ())] -> [Doc])
-> [RTVar tv (RType c tv ())]
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RTVar tv (RType c tv ()) -> Doc)
-> [RTVar tv (RType c tv ())] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (tv -> Doc
forall a. PPrint a => a -> Doc
pprint (tv -> Doc)
-> (RTVar tv (RType c tv ()) -> tv)
-> RTVar tv (RType c tv ())
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTVar tv (RType c tv ()) -> tv
forall tv s. RTVar tv s -> tv
ty_var_value)
pprCls
:: (OkRT c tv r, PPrint a, PPrint (RType c tv r),
PPrint (RType c tv ()))
=> PPEnv -> Prec -> a -> [RType c tv r] -> Doc
pprCls :: forall c tv r a.
(OkRT c tv r, PPrint a, PPrint (RType c tv r),
PPrint (RType c tv ())) =>
PPEnv -> Prec -> a -> [RType c tv r] -> Doc
pprCls PPEnv
bb Prec
p a
c [RType c tv r]
ts
= a -> Doc
pp a
c Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep ((RType c tv r -> Doc) -> [RType c tv r] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PPEnv -> Prec -> RType c tv r -> Doc
forall c tv r. OkRT c tv r => PPEnv -> Prec -> RType c tv r -> Doc
pprRtype PPEnv
bb Prec
p) [RType c tv r]
ts)
where
pp :: a -> Doc
pp | PPEnv -> Bool
ppShort PPEnv
bb = String -> Doc
text (String -> Doc) -> (a -> String) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> String
F.symbolString (Symbol -> String) -> (a -> Symbol) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Symbol
dropModuleNames (Symbol -> Symbol) -> (a -> Symbol) -> a -> Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Symbol
forall a. Symbolic a => a -> Symbol
F.symbol (String -> Symbol) -> (a -> String) -> a -> Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> String
render (Doc -> String) -> (a -> Doc) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc
forall a. PPrint a => a -> Doc
pprint
| Bool
otherwise = a -> Doc
forall a. PPrint a => a -> Doc
pprint
pprPvarDef :: (OkRT c tv ()) => PPEnv -> Prec -> PVar (RType c tv ()) -> Doc
pprPvarDef :: forall c tv.
OkRT c tv () =>
PPEnv -> Prec -> PVar (RType c tv ()) -> Doc
pprPvarDef PPEnv
bb Prec
p (PV Symbol
s RType c tv ()
t Symbol
_ [(RType c tv (), Symbol, Expr)]
xts)
= Symbol -> Doc
forall a. PPrint a => a -> Doc
pprint Symbol
s Doc -> Doc -> Doc
<+> Doc
dcolon Doc -> Doc -> Doc
<+> Doc -> [Doc] -> Doc
intersperse Doc
arrow [Doc]
dargs Doc -> Doc -> Doc
<+> PPEnv -> Prec -> RType c tv () -> Doc
forall c tv. OkRT c tv () => PPEnv -> Prec -> RType c tv () -> Doc
pprPvarKind PPEnv
bb Prec
p RType c tv ()
t
where
dargs :: [Doc]
dargs = [PPEnv -> Prec -> RType c tv () -> Doc
forall c tv. OkRT c tv () => PPEnv -> Prec -> RType c tv () -> Doc
pprPvarSort PPEnv
bb Prec
p RType c tv ()
xt | (RType c tv ()
xt,Symbol
_,Expr
_) <- [(RType c tv (), Symbol, Expr)]
xts]
pprPvarKind :: (OkRT c tv ()) => PPEnv -> Prec -> RType c tv () -> Doc
pprPvarKind :: forall c tv. OkRT c tv () => PPEnv -> Prec -> RType c tv () -> Doc
pprPvarKind PPEnv
bb Prec
p RType c tv ()
t = PPEnv -> Prec -> RType c tv () -> Doc
forall c tv. OkRT c tv () => PPEnv -> Prec -> RType c tv () -> Doc
pprPvarSort PPEnv
bb Prec
p RType c tv ()
t Doc -> Doc -> Doc
<+> Doc
arrow Doc -> Doc -> Doc
<+> Symbol -> Doc
pprName Symbol
F.boolConName
pprName :: F.Symbol -> Doc
pprName :: Symbol -> Doc
pprName = String -> Doc
text (String -> Doc) -> (Symbol -> String) -> Symbol -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> String
F.symbolString
pprPvarSort :: (OkRT c tv ()) => PPEnv -> Prec -> RType c tv () -> Doc
pprPvarSort :: forall c tv. OkRT c tv () => PPEnv -> Prec -> RType c tv () -> Doc
pprPvarSort PPEnv
bb Prec
p RType c tv ()
t = PPEnv -> Prec -> RType c tv () -> Doc
forall c tv r. OkRT c tv r => PPEnv -> Prec -> RType c tv r -> Doc
pprRtype PPEnv
bb Prec
p RType c tv ()
t
pprRef :: (OkRT c tv r) => Ref (RType c tv ()) (RType c tv r) -> Doc
pprRef :: forall c tv r.
OkRT c tv r =>
Ref (RType c tv ()) (RType c tv r) -> Doc
pprRef (RProp [(Symbol, RType c tv ())]
ss RType c tv r
s) = [Symbol] -> Doc
ppRefArgs ((Symbol, RType c tv ()) -> Symbol
forall a b. (a, b) -> a
fst ((Symbol, RType c tv ()) -> Symbol)
-> [(Symbol, RType c tv ())] -> [Symbol]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Symbol, RType c tv ())]
ss) Doc -> Doc -> Doc
<+> RType c tv r -> Doc
forall a. PPrint a => a -> Doc
pprint RType c tv r
s
ppRefArgs :: [F.Symbol] -> Doc
ppRefArgs :: [Symbol] -> Doc
ppRefArgs [] = Doc
empty
ppRefArgs [Symbol]
ss = String -> Doc
text String
"\\" Doc -> Doc -> Doc
<-> [Doc] -> Doc
hsep (Symbol -> Doc
forall a. (Eq a, IsString a, PPrint a) => a -> Doc
ppRefSym (Symbol -> Doc) -> [Symbol] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Symbol]
ss [Symbol] -> [Symbol] -> [Symbol]
forall a. [a] -> [a] -> [a]
++ [Maybe Integer -> Symbol
F.vv Maybe Integer
forall a. Maybe a
Nothing]) Doc -> Doc -> Doc
<+> Doc
arrow
ppRefSym :: (Eq a, IsString a, PPrint a) => a -> Doc
ppRefSym :: forall a. (Eq a, IsString a, PPrint a) => a -> Doc
ppRefSym a
"" = String -> Doc
text String
"_"
ppRefSym a
s = a -> Doc
forall a. PPrint a => a -> Doc
pprint a
s
dot :: Doc
dot :: Doc
dot = Char -> Doc
char Char
'.'
instance (PPrint (PredicateV v), Reftable (PredicateV v), PPrint r, Reftable r) => PPrint (UReftV v r) where
pprintTidy :: Tidy -> UReftV v r -> Doc
pprintTidy Tidy
k (MkUReft r
r PredicateV v
p)
| r -> Bool
forall r. Reftable r => r -> Bool
isTauto r
r = Tidy -> PredicateV v -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k PredicateV v
p
| PredicateV v -> Bool
forall r. Reftable r => r -> Bool
isTauto PredicateV v
p = Tidy -> r -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k r
r
| Bool
otherwise = Tidy -> PredicateV v -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k PredicateV v
p Doc -> Doc -> Doc
<-> String -> Doc
text String
" & " Doc -> Doc -> Doc
<-> Tidy -> r -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k r
r
filterReportErrors :: forall e' a. (Show e', F.PPrint e') => FilePath -> Ghc.TcRn a -> Ghc.TcRn a -> [Filter] -> F.Tidy -> [TError e'] -> Ghc.TcRn a
filterReportErrors :: forall e' a.
(Show e', PPrint e') =>
String
-> TcRn a -> TcRn a -> [Filter] -> Tidy -> [TError e'] -> TcRn a
filterReportErrors String
path TcRn a
failure TcRn a
continue [Filter]
filters Tidy
k =
FilterReportErrorsArgs
(IOEnv (Env TcGblEnv TcLclEnv)) Filter Any (TError e') a
-> [TError e'] -> TcRn a
forall (m :: * -> *) filter msg e a.
(Monad m, Ord filter) =>
FilterReportErrorsArgs m filter msg e a -> [e] -> m a
filterReportErrorsWith
FilterReportErrorsArgs { errorReporter :: [TError e'] -> IOEnv (Env TcGblEnv TcLclEnv) ()
errorReporter = \[TError e']
errs ->
[(SrcSpan, Doc)] -> IOEnv (Env TcGblEnv TcLclEnv) ()
addTcRnUnknownMessages [(TError e' -> SrcSpan
forall t. TError t -> SrcSpan
pos TError e'
err, Tidy -> Doc -> TError e' -> Doc
forall a. (PPrint a, Show a) => Tidy -> Doc -> TError a -> Doc
ppError Tidy
k Doc
empty TError e'
err) | TError e'
err <- [TError e']
errs]
, filterReporter :: [Filter] -> IOEnv (Env TcGblEnv TcLclEnv) ()
filterReporter = String -> [Filter] -> IOEnv (Env TcGblEnv TcLclEnv) ()
defaultFilterReporter String
path
, failure :: TcRn a
failure = TcRn a
failure
, continue :: TcRn a
continue = TcRn a
continue
, matchingFilters :: TError e' -> [Filter]
matchingFilters = (TError e' -> String) -> [Filter] -> TError e' -> [Filter]
forall e. (e -> String) -> [Filter] -> e -> [Filter]
reduceFilters TError e' -> String
renderer [Filter]
filters
, filters :: [Filter]
filters = [Filter]
filters
}
where
renderer :: TError e' -> String
renderer TError e'
e = Doc -> String
render (Tidy -> Doc -> TError e' -> Doc
forall a. (PPrint a, Show a) => Tidy -> Doc -> TError a -> Doc
ppError Tidy
k Doc
empty TError e'
e Doc -> Doc -> Doc
$+$ SrcSpan -> Doc
forall a. PPrint a => a -> Doc
pprint (TError e' -> SrcSpan
forall t. TError t -> SrcSpan
pos TError e'
e))
getFilters :: Config -> [Filter]
getFilters :: Config -> [Filter]
getFilters Config
cfg = [Filter]
anyFilter [Filter] -> [Filter] -> [Filter]
forall a. Semigroup a => a -> a -> a
<> [Filter]
stringFilters
where
anyFilter :: [Filter]
anyFilter = [Filter
AnyFilter | Config -> Bool
expectAnyError Config
cfg]
stringFilters :: [Filter]
stringFilters = String -> Filter
StringFilter (String -> Filter) -> [String] -> [Filter]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Config -> [String]
expectErrorContaining Config
cfg
reduceFilters :: (e -> String) -> [Filter] -> e -> [Filter]
reduceFilters :: forall e. (e -> String) -> [Filter] -> e -> [Filter]
reduceFilters e -> String
renderer [Filter]
fs e
err = (Filter -> Bool) -> [Filter] -> [Filter]
forall a. (a -> Bool) -> [a] -> [a]
filter ((e -> String) -> e -> Filter -> Bool
forall e. (e -> String) -> e -> Filter -> Bool
filterDoesMatchErr e -> String
renderer e
err) [Filter]
fs
filterDoesMatchErr :: (e -> String) -> e -> Filter -> Bool
filterDoesMatchErr :: forall e. (e -> String) -> e -> Filter -> Bool
filterDoesMatchErr e -> String
_ e
_ Filter
AnyFilter = Bool
True
filterDoesMatchErr e -> String
renderer e
e (StringFilter String
filter') = String -> String -> Bool
stringMatch String
filter' (e -> String
renderer e
e)
stringMatch :: String -> String -> Bool
stringMatch :: String -> String -> Bool
stringMatch String
filter' String
str = String
filter' String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isInfixOf` String
str
data FilterReportErrorsArgs m filter msg e a =
FilterReportErrorsArgs
{
forall (m :: * -> *) filter msg e a.
FilterReportErrorsArgs m filter msg e a -> [e] -> m ()
errorReporter :: [e] -> m ()
,
forall (m :: * -> *) filter msg e a.
FilterReportErrorsArgs m filter msg e a -> [filter] -> m ()
filterReporter :: [filter] -> m ()
,
forall (m :: * -> *) filter msg e a.
FilterReportErrorsArgs m filter msg e a -> m a
failure :: m a
,
forall (m :: * -> *) filter msg e a.
FilterReportErrorsArgs m filter msg e a -> m a
continue :: m a
,
forall (m :: * -> *) filter msg e a.
FilterReportErrorsArgs m filter msg e a -> e -> [filter]
matchingFilters :: e -> [filter]
,
forall (m :: * -> *) filter msg e a.
FilterReportErrorsArgs m filter msg e a -> [filter]
filters :: [filter]
}
filterReportErrorsWith :: (Monad m, Ord filter) => FilterReportErrorsArgs m filter msg e a -> [e] -> m a
filterReportErrorsWith :: forall (m :: * -> *) filter msg e a.
(Monad m, Ord filter) =>
FilterReportErrorsArgs m filter msg e a -> [e] -> m a
filterReportErrorsWith FilterReportErrorsArgs {m a
[filter]
e -> [filter]
[filter] -> m ()
[e] -> m ()
errorReporter :: forall (m :: * -> *) filter msg e a.
FilterReportErrorsArgs m filter msg e a -> [e] -> m ()
filterReporter :: forall (m :: * -> *) filter msg e a.
FilterReportErrorsArgs m filter msg e a -> [filter] -> m ()
failure :: forall (m :: * -> *) filter msg e a.
FilterReportErrorsArgs m filter msg e a -> m a
continue :: forall (m :: * -> *) filter msg e a.
FilterReportErrorsArgs m filter msg e a -> m a
matchingFilters :: forall (m :: * -> *) filter msg e a.
FilterReportErrorsArgs m filter msg e a -> e -> [filter]
filters :: forall (m :: * -> *) filter msg e a.
FilterReportErrorsArgs m filter msg e a -> [filter]
errorReporter :: [e] -> m ()
filterReporter :: [filter] -> m ()
failure :: m a
continue :: m a
matchingFilters :: e -> [filter]
filters :: [filter]
..} [e]
errs =
let
([(e, [filter])]
unmatchedErrors, [(e, [filter])]
matchedFilters) =
((e, [filter]) -> Bool)
-> [(e, [filter])] -> ([(e, [filter])], [(e, [filter])])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition ([filter] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([filter] -> Bool)
-> ((e, [filter]) -> [filter]) -> (e, [filter]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e, [filter]) -> [filter]
forall a b. (a, b) -> b
snd) [ (e
e, [filter]
fs) | e
e <- [e]
errs, let fs :: [filter]
fs = e -> [filter]
matchingFilters e
e ]
unmatchedFilters :: [filter]
unmatchedFilters = Set filter -> [filter]
forall a. Set a -> [a]
Set.toList (Set filter -> [filter]) -> Set filter -> [filter]
forall a b. (a -> b) -> a -> b
$
[filter] -> Set filter
forall a. Ord a => [a] -> Set a
Set.fromList [filter]
filters Set filter -> Set filter -> Set filter
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` [filter] -> Set filter
forall a. Ord a => [a] -> Set a
Set.fromList (((e, [filter]) -> [filter]) -> [(e, [filter])] -> [filter]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (e, [filter]) -> [filter]
forall a b. (a, b) -> b
snd [(e, [filter])]
matchedFilters)
in
if [(e, [filter])] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(e, [filter])]
unmatchedErrors then
if [filter] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [filter]
unmatchedFilters then
m a
continue
else do
[filter] -> m ()
filterReporter [filter]
unmatchedFilters
m a
failure
else do
[e] -> m ()
errorReporter ([e] -> m ()) -> [e] -> m ()
forall a b. (a -> b) -> a -> b
$ ((e, [filter]) -> e) -> [(e, [filter])] -> [e]
forall a b. (a -> b) -> [a] -> [b]
map (e, [filter]) -> e
forall a b. (a, b) -> a
fst [(e, [filter])]
unmatchedErrors
m a
failure
defaultFilterReporter :: FilePath -> [Filter] -> Ghc.TcRn ()
defaultFilterReporter :: String -> [Filter] -> IOEnv (Env TcGblEnv TcLclEnv) ()
defaultFilterReporter String
_ [] = () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
defaultFilterReporter String
path [Filter]
fs = SrcSpan -> Doc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addTcRnUnknownMessage SrcSpan
srcSpan ([Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
leaderMsg Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Int -> Doc -> Doc
nest Int
4 (Doc -> Doc) -> [Doc] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Doc]
filterMsgs))
where
leaderMsg :: Doc
leaderMsg :: Doc
leaderMsg = String -> Doc
text String
"Could not match the following expected errors with actual thrown errors:"
filterToMsg :: Filter -> Doc
filterToMsg :: Filter -> Doc
filterToMsg Filter
AnyFilter = String -> Doc
text String
"<Any Liquid error>"
filterToMsg (StringFilter String
s) = String -> Doc
text String
"String filter: " Doc -> Doc -> Doc
<-> Doc -> Doc
quotes (String -> Doc
text String
s)
filterMsgs :: [Doc]
filterMsgs :: [Doc]
filterMsgs = Filter -> Doc
filterToMsg (Filter -> Doc) -> [Filter] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Filter]
fs
beginningOfFile :: Ghc.SrcLoc
beginningOfFile :: SrcLoc
beginningOfFile = FastString -> Int -> Int -> SrcLoc
Ghc.mkSrcLoc (String -> FastString
forall a. IsString a => String -> a
fromString String
path) Int
1 Int
1
srcSpan :: SrcSpan
srcSpan :: SrcSpan
srcSpan = SrcLoc -> SrcLoc -> SrcSpan
Ghc.mkSrcSpan SrcLoc
beginningOfFile SrcLoc
beginningOfFile