{-# Language DeriveGeneric, DeriveAnyClass #-}
{-# Language OverloadedStrings #-}
module Cryptol.ModuleSystem.Renamer.Error where
import Data.List(intersperse)
import Cryptol.ModuleSystem.Name
import Cryptol.Parser.AST
import Cryptol.Parser.Position
import Cryptol.Parser.Selector(ppNestedSels)
import Cryptol.Utils.PP
import Cryptol.Utils.Ident(modPathSplit)
import GHC.Generics (Generic)
import Control.DeepSeq
import Prelude ()
import Prelude.Compat
data RenamerError
= MultipleSyms (Located PName) [Name]
| UnboundName Namespace (Located PName)
| OverlappingSyms [Name]
| WrongNamespace Namespace Namespace (Located PName)
| FixityError (Located Name) Fixity (Located Name) Fixity
| OverlappingRecordUpdate (Located [Selector]) (Located [Selector])
| InvalidDependency [DepName]
| MultipleModParams Ident [Range]
| InvalidFunctorImport (ImpName Name)
| UnexpectedNest Range PName
| ModuleKindMismatch Range (ImpName Name) ModKind ModKind
deriving (Int -> RenamerError -> ShowS
[RenamerError] -> ShowS
RenamerError -> String
(Int -> RenamerError -> ShowS)
-> (RenamerError -> String)
-> ([RenamerError] -> ShowS)
-> Show RenamerError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RenamerError -> ShowS
showsPrec :: Int -> RenamerError -> ShowS
$cshow :: RenamerError -> String
show :: RenamerError -> String
$cshowList :: [RenamerError] -> ShowS
showList :: [RenamerError] -> ShowS
Show, (forall x. RenamerError -> Rep RenamerError x)
-> (forall x. Rep RenamerError x -> RenamerError)
-> Generic RenamerError
forall x. Rep RenamerError x -> RenamerError
forall x. RenamerError -> Rep RenamerError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RenamerError -> Rep RenamerError x
from :: forall x. RenamerError -> Rep RenamerError x
$cto :: forall x. Rep RenamerError x -> RenamerError
to :: forall x. Rep RenamerError x -> RenamerError
Generic, RenamerError -> ()
(RenamerError -> ()) -> NFData RenamerError
forall a. (a -> ()) -> NFData a
$crnf :: RenamerError -> ()
rnf :: RenamerError -> ()
NFData, RenamerError -> RenamerError -> Bool
(RenamerError -> RenamerError -> Bool)
-> (RenamerError -> RenamerError -> Bool) -> Eq RenamerError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RenamerError -> RenamerError -> Bool
== :: RenamerError -> RenamerError -> Bool
$c/= :: RenamerError -> RenamerError -> Bool
/= :: RenamerError -> RenamerError -> Bool
Eq, Eq RenamerError
Eq RenamerError =>
(RenamerError -> RenamerError -> Ordering)
-> (RenamerError -> RenamerError -> Bool)
-> (RenamerError -> RenamerError -> Bool)
-> (RenamerError -> RenamerError -> Bool)
-> (RenamerError -> RenamerError -> Bool)
-> (RenamerError -> RenamerError -> RenamerError)
-> (RenamerError -> RenamerError -> RenamerError)
-> Ord RenamerError
RenamerError -> RenamerError -> Bool
RenamerError -> RenamerError -> Ordering
RenamerError -> RenamerError -> RenamerError
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 :: RenamerError -> RenamerError -> Ordering
compare :: RenamerError -> RenamerError -> Ordering
$c< :: RenamerError -> RenamerError -> Bool
< :: RenamerError -> RenamerError -> Bool
$c<= :: RenamerError -> RenamerError -> Bool
<= :: RenamerError -> RenamerError -> Bool
$c> :: RenamerError -> RenamerError -> Bool
> :: RenamerError -> RenamerError -> Bool
$c>= :: RenamerError -> RenamerError -> Bool
>= :: RenamerError -> RenamerError -> Bool
$cmax :: RenamerError -> RenamerError -> RenamerError
max :: RenamerError -> RenamerError -> RenamerError
$cmin :: RenamerError -> RenamerError -> RenamerError
min :: RenamerError -> RenamerError -> RenamerError
Ord)
data DepName = NamedThing Name
| ModPath ModPath
| ModParamName Range Ident
| ConstratintAt Range
deriving (DepName -> DepName -> Bool
(DepName -> DepName -> Bool)
-> (DepName -> DepName -> Bool) -> Eq DepName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DepName -> DepName -> Bool
== :: DepName -> DepName -> Bool
$c/= :: DepName -> DepName -> Bool
/= :: DepName -> DepName -> Bool
Eq,Eq DepName
Eq DepName =>
(DepName -> DepName -> Ordering)
-> (DepName -> DepName -> Bool)
-> (DepName -> DepName -> Bool)
-> (DepName -> DepName -> Bool)
-> (DepName -> DepName -> Bool)
-> (DepName -> DepName -> DepName)
-> (DepName -> DepName -> DepName)
-> Ord DepName
DepName -> DepName -> Bool
DepName -> DepName -> Ordering
DepName -> DepName -> DepName
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 :: DepName -> DepName -> Ordering
compare :: DepName -> DepName -> Ordering
$c< :: DepName -> DepName -> Bool
< :: DepName -> DepName -> Bool
$c<= :: DepName -> DepName -> Bool
<= :: DepName -> DepName -> Bool
$c> :: DepName -> DepName -> Bool
> :: DepName -> DepName -> Bool
$c>= :: DepName -> DepName -> Bool
>= :: DepName -> DepName -> Bool
$cmax :: DepName -> DepName -> DepName
max :: DepName -> DepName -> DepName
$cmin :: DepName -> DepName -> DepName
min :: DepName -> DepName -> DepName
Ord,Int -> DepName -> ShowS
[DepName] -> ShowS
DepName -> String
(Int -> DepName -> ShowS)
-> (DepName -> String) -> ([DepName] -> ShowS) -> Show DepName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DepName -> ShowS
showsPrec :: Int -> DepName -> ShowS
$cshow :: DepName -> String
show :: DepName -> String
$cshowList :: [DepName] -> ShowS
showList :: [DepName] -> ShowS
Show,(forall x. DepName -> Rep DepName x)
-> (forall x. Rep DepName x -> DepName) -> Generic DepName
forall x. Rep DepName x -> DepName
forall x. DepName -> Rep DepName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DepName -> Rep DepName x
from :: forall x. DepName -> Rep DepName x
$cto :: forall x. Rep DepName x -> DepName
to :: forall x. Rep DepName x -> DepName
Generic,DepName -> ()
(DepName -> ()) -> NFData DepName
forall a. (a -> ()) -> NFData a
$crnf :: DepName -> ()
rnf :: DepName -> ()
NFData)
depNameLoc :: DepName -> Maybe Range
depNameLoc :: DepName -> Maybe Range
depNameLoc DepName
x =
case DepName
x of
NamedThing Name
n -> Range -> Maybe Range
forall a. a -> Maybe a
Just (Name -> Range
nameLoc Name
n)
ConstratintAt Range
r -> Range -> Maybe Range
forall a. a -> Maybe a
Just Range
r
ModParamName Range
r Ident
_ -> Range -> Maybe Range
forall a. a -> Maybe a
Just Range
r
ModPath {} -> Maybe Range
forall a. Maybe a
Nothing
data ModKind = AFunctor | ASignature | AModule
deriving (Int -> ModKind -> ShowS
[ModKind] -> ShowS
ModKind -> String
(Int -> ModKind -> ShowS)
-> (ModKind -> String) -> ([ModKind] -> ShowS) -> Show ModKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModKind -> ShowS
showsPrec :: Int -> ModKind -> ShowS
$cshow :: ModKind -> String
show :: ModKind -> String
$cshowList :: [ModKind] -> ShowS
showList :: [ModKind] -> ShowS
Show, (forall x. ModKind -> Rep ModKind x)
-> (forall x. Rep ModKind x -> ModKind) -> Generic ModKind
forall x. Rep ModKind x -> ModKind
forall x. ModKind -> Rep ModKind x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ModKind -> Rep ModKind x
from :: forall x. ModKind -> Rep ModKind x
$cto :: forall x. Rep ModKind x -> ModKind
to :: forall x. Rep ModKind x -> ModKind
Generic, ModKind -> ()
(ModKind -> ()) -> NFData ModKind
forall a. (a -> ()) -> NFData a
$crnf :: ModKind -> ()
rnf :: ModKind -> ()
NFData, ModKind -> ModKind -> Bool
(ModKind -> ModKind -> Bool)
-> (ModKind -> ModKind -> Bool) -> Eq ModKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModKind -> ModKind -> Bool
== :: ModKind -> ModKind -> Bool
$c/= :: ModKind -> ModKind -> Bool
/= :: ModKind -> ModKind -> Bool
Eq, Eq ModKind
Eq ModKind =>
(ModKind -> ModKind -> Ordering)
-> (ModKind -> ModKind -> Bool)
-> (ModKind -> ModKind -> Bool)
-> (ModKind -> ModKind -> Bool)
-> (ModKind -> ModKind -> Bool)
-> (ModKind -> ModKind -> ModKind)
-> (ModKind -> ModKind -> ModKind)
-> Ord ModKind
ModKind -> ModKind -> Bool
ModKind -> ModKind -> Ordering
ModKind -> ModKind -> ModKind
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 :: ModKind -> ModKind -> Ordering
compare :: ModKind -> ModKind -> Ordering
$c< :: ModKind -> ModKind -> Bool
< :: ModKind -> ModKind -> Bool
$c<= :: ModKind -> ModKind -> Bool
<= :: ModKind -> ModKind -> Bool
$c> :: ModKind -> ModKind -> Bool
> :: ModKind -> ModKind -> Bool
$c>= :: ModKind -> ModKind -> Bool
>= :: ModKind -> ModKind -> Bool
$cmax :: ModKind -> ModKind -> ModKind
max :: ModKind -> ModKind -> ModKind
$cmin :: ModKind -> ModKind -> ModKind
min :: ModKind -> ModKind -> ModKind
Ord)
instance PP ModKind where
ppPrec :: Int -> ModKind -> Doc
ppPrec Int
_ ModKind
e =
case ModKind
e of
ModKind
AFunctor -> Doc
"a functor"
ModKind
ASignature -> Doc
"an interface"
ModKind
AModule -> Doc
"a module"
instance PP RenamerError where
ppPrec :: Int -> RenamerError -> Doc
ppPrec Int
_ RenamerError
e = case RenamerError
e of
MultipleSyms Located PName
lqn [Name]
qns ->
Doc -> Int -> Doc -> Doc
hang (String -> Doc
text String
"[error] at" Doc -> Doc -> Doc
<+> Range -> Doc
forall a. PP a => a -> Doc
pp (Located PName -> Range
forall a. Located a -> Range
srcRange Located PName
lqn))
Int
4 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc
text String
"Multiple definitions for symbol:" Doc -> Doc -> Doc
<+> PName -> Doc
forall a. PP a => a -> Doc
pp (Located PName -> PName
forall a. Located a -> a
thing Located PName
lqn))
Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat ((Name -> Doc) -> [Name] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc
ppLocName [Name]
qns)
UnboundName Namespace
ns Located PName
lqn ->
Doc -> Int -> Doc -> Doc
hang (String -> Doc
text String
"[error] at" Doc -> Doc -> Doc
<+> Range -> Doc
forall a. PP a => a -> Doc
pp (Located PName -> Range
forall a. Located a -> Range
srcRange Located PName
lqn))
Int
4 (Doc
something Doc -> Doc -> Doc
<+> Doc
"not in scope:" Doc -> Doc -> Doc
<+> PName -> Doc
forall a. PP a => a -> Doc
pp (Located PName -> PName
forall a. Located a -> a
thing Located PName
lqn))
where
something :: Doc
something = case Namespace
ns of
Namespace
NSValue -> Doc
"Value"
Namespace
NSType -> Doc
"Type"
Namespace
NSModule -> Doc
"Module"
Namespace
NSConstructor -> Doc
"Constructor"
OverlappingSyms [Name]
qns ->
Doc -> Int -> Doc -> Doc
hang (String -> Doc
text String
"[error]")
Int
4 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"Overlapping symbols defined:"
Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat ((Name -> Doc) -> [Name] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc
ppLocName [Name]
qns)
WrongNamespace Namespace
expected Namespace
actual Located PName
lqn ->
Doc -> Int -> Doc -> Doc
hang (Doc
"[error] at" Doc -> Doc -> Doc
<+> Range -> Doc
forall a. PP a => a -> Doc
pp (Located PName -> Range
forall a. Located a -> Range
srcRange Located PName
lqn ))
Int
4 ([Doc] -> Doc
fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
[ Doc
"Expected a", Namespace -> Doc
forall {a}. IsString a => Namespace -> a
sayNS Namespace
expected, Doc
"named", Doc -> Doc
quotes (PName -> Doc
forall a. PP a => a -> Doc
pp (Located PName -> PName
forall a. Located a -> a
thing Located PName
lqn))
, Doc
"but found a", Namespace -> Doc
forall {a}. IsString a => Namespace -> a
sayNS Namespace
actual, Doc
"instead"
] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc]
suggestion)
where
sayNS :: Namespace -> a
sayNS Namespace
ns = case Namespace
ns of
Namespace
NSValue -> a
"value"
Namespace
NSConstructor -> a
"constructor"
Namespace
NSType -> a
"type"
Namespace
NSModule -> a
"module"
suggestion :: [Doc]
suggestion =
case (Namespace
expected,Namespace
actual) of
(Namespace
NSValue,Namespace
NSType) ->
[Doc
"Did you mean `(" Doc -> Doc -> Doc
<.> PName -> Doc
forall a. PP a => a -> Doc
pp (Located PName -> PName
forall a. Located a -> a
thing Located PName
lqn) Doc -> Doc -> Doc
<.> String -> Doc
textString
")?"]
(Namespace
NSConstructor,Namespace
NSValue) ->
[Doc
"Perhaps the constructor got shadowed?"]
(Namespace, Namespace)
_ -> []
FixityError Located Name
o1 Fixity
f1 Located Name
o2 Fixity
f2 ->
Doc -> Int -> Doc -> Doc
hang (String -> Doc
text String
"[error] at" Doc -> Doc -> Doc
<+> Range -> Doc
forall a. PP a => a -> Doc
pp (Located Name -> Range
forall a. Located a -> Range
srcRange Located Name
o1) Doc -> Doc -> Doc
<+> String -> Doc
text String
"and" Doc -> Doc -> Doc
<+> Range -> Doc
forall a. PP a => a -> Doc
pp (Located Name -> Range
forall a. Located a -> Range
srcRange Located Name
o2))
Int
4 ([Doc] -> Doc
vsep [ String -> Doc
text String
"The fixities of"
, Int -> Doc -> Doc
indent Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat
[ Doc
"•" Doc -> Doc -> Doc
<+> Name -> Doc
forall a. PP a => a -> Doc
pp (Located Name -> Name
forall a. Located a -> a
thing Located Name
o1) Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Fixity -> Doc
forall a. PP a => a -> Doc
pp Fixity
f1)
, Doc
"•" Doc -> Doc -> Doc
<+> Name -> Doc
forall a. PP a => a -> Doc
pp (Located Name -> Name
forall a. Located a -> a
thing Located Name
o2) Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Fixity -> Doc
forall a. PP a => a -> Doc
pp Fixity
f2) ]
, String -> Doc
text String
"are not compatible."
, String -> Doc
text String
"You may use explicit parentheses to disambiguate." ])
OverlappingRecordUpdate Located [Selector]
xs Located [Selector]
ys ->
Doc -> Int -> Doc -> Doc
hang Doc
"[error] Overlapping record updates:"
Int
4 ([Doc] -> Doc
vcat [ Located [Selector] -> Doc
ppLab Located [Selector]
xs, Located [Selector] -> Doc
ppLab Located [Selector]
ys ])
where
ppLab :: Located [Selector] -> Doc
ppLab Located [Selector]
as = [Selector] -> Doc
ppNestedSels (Located [Selector] -> [Selector]
forall a. Located a -> a
thing Located [Selector]
as) Doc -> Doc -> Doc
<+> Doc
"at" Doc -> Doc -> Doc
<+> Range -> Doc
forall a. PP a => a -> Doc
pp (Located [Selector] -> Range
forall a. Located a -> Range
srcRange Located [Selector]
as)
InvalidDependency [DepName]
ds ->
Doc -> Int -> Doc -> Doc
hang (Doc
"[error] Invalid" Doc -> Doc -> Doc
<+> Doc
self Doc -> Doc -> Doc
<+>Doc
"dependency:")
Int
4 ([Doc] -> Doc
vcat [ Doc
"•" Doc -> Doc -> Doc
<+> DepName -> Doc
forall a. PP a => a -> Doc
pp DepName
x Doc -> Doc -> Doc
<.>
case DepName -> Maybe Range
depNameLoc DepName
x of
Just Range
r -> Doc
", defined at" Doc -> Doc -> Doc
<+> Range -> Doc
ppR Range
r
Maybe Range
Nothing -> Doc
forall a. Monoid a => a
mempty
| DepName
x <- [DepName]
ds ])
where ppR :: Range -> Doc
ppR Range
r = Position -> Doc
forall a. PP a => a -> Doc
pp (Range -> Position
from Range
r) Doc -> Doc -> Doc
<.> Doc
"--" Doc -> Doc -> Doc
<.> Position -> Doc
forall a. PP a => a -> Doc
pp (Range -> Position
to Range
r)
self :: Doc
self = case [DepName]
ds of
[DepName
_] -> Doc
"self"
[DepName]
_ -> Doc
"recursive"
MultipleModParams Ident
x [Range]
rs ->
Doc -> Int -> Doc -> Doc
hang (Doc
"[error] Multiple parameters with name" Doc -> Doc -> Doc
<+> Doc -> Doc
backticks (Ident -> Doc
forall a. PP a => a -> Doc
pp Ident
x))
Int
4 ([Doc] -> Doc
vcat [ Doc
"•" Doc -> Doc -> Doc
<+> Range -> Doc
forall a. PP a => a -> Doc
pp Range
r | Range
r <- [Range]
rs ])
InvalidFunctorImport ImpName Name
x ->
Doc -> Int -> Doc -> Doc
hang (Doc
"[error] Invalid import of functor" Doc -> Doc -> Doc
<+> Doc -> Doc
backticks (ImpName Name -> Doc
forall a. PP a => a -> Doc
pp ImpName Name
x))
Int
4 Doc
"• Functors need to be instantiated before they can be imported."
UnexpectedNest Range
s PName
x ->
Doc -> Int -> Doc -> Doc
hang (Doc
"[error] at" Doc -> Doc -> Doc
<+> Range -> Doc
forall a. PP a => a -> Doc
pp Range
s)
Int
4 (Doc
"submodule" Doc -> Doc -> Doc
<+> Doc -> Doc
backticks (PName -> Doc
forall a. PP a => a -> Doc
pp PName
x) Doc -> Doc -> Doc
<+> Doc
"may not be defined here.")
ModuleKindMismatch Range
r ImpName Name
x ModKind
expected ModKind
actual ->
Doc -> Int -> Doc -> Doc
hang (Doc
"[error] at" Doc -> Doc -> Doc
<+> Range -> Doc
forall a. PP a => a -> Doc
pp Range
r)
Int
4 ([Doc] -> Doc
vcat [ Doc
"• Expected" Doc -> Doc -> Doc
<+> ModKind -> Doc
forall a. PP a => a -> Doc
pp ModKind
expected
, Doc
"•" Doc -> Doc -> Doc
<+> Doc -> Doc
backticks (ImpName Name -> Doc
forall a. PP a => a -> Doc
pp ImpName Name
x) Doc -> Doc -> Doc
<+> Doc
"is" Doc -> Doc -> Doc
<+> ModKind -> Doc
forall a. PP a => a -> Doc
pp ModKind
actual
])
instance PP DepName where
ppPrec :: Int -> DepName -> Doc
ppPrec Int
_ DepName
d =
case DepName
d of
ConstratintAt Range
r -> Doc
"constraint at" Doc -> Doc -> Doc
<+> Range -> Doc
forall a. PP a => a -> Doc
pp Range
r
NamedThing Name
n ->
case Name -> Namespace
nameNamespace Name
n of
Namespace
NSModule -> Doc
"submodule" Doc -> Doc -> Doc
<+> Name -> Doc
forall a. PP a => a -> Doc
pp Name
n
Namespace
NSType -> Doc
"type" Doc -> Doc -> Doc
<+> Name -> Doc
forall a. PP a => a -> Doc
pp Name
n
Namespace
NSValue -> Name -> Doc
forall a. PP a => a -> Doc
pp Name
n
Namespace
NSConstructor -> Doc
"constructor" Doc -> Doc -> Doc
<+> Name -> Doc
forall a. PP a => a -> Doc
pp Name
n
ModParamName Range
_r Ident
i -> Doc
"module parameter" Doc -> Doc -> Doc
<+> Ident -> Doc
forall a. PP a => a -> Doc
pp Ident
i
ModPath ModPath
mp ->
case ModPath -> (ModName, [Ident])
modPathSplit ModPath
mp of
(ModName
m,[]) -> Doc
"module" Doc -> Doc -> Doc
<+> ModName -> Doc
forall a. PP a => a -> Doc
pp ModName
m
(ModName
_,[Ident]
is) -> Doc
"submodule" Doc -> Doc -> Doc
<+> [Doc] -> Doc
hcat (Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse Doc
"::" ((Ident -> Doc) -> [Ident] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Ident -> Doc
forall a. PP a => a -> Doc
pp [Ident]
is))
data RenamerWarning
= SymbolShadowed PName Name [Name]
| UnusedName Name
| PrefixAssocChanged PrefixOp (Expr Name) (Located Name) Fixity (Expr Name)
deriving (Int -> RenamerWarning -> ShowS
[RenamerWarning] -> ShowS
RenamerWarning -> String
(Int -> RenamerWarning -> ShowS)
-> (RenamerWarning -> String)
-> ([RenamerWarning] -> ShowS)
-> Show RenamerWarning
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RenamerWarning -> ShowS
showsPrec :: Int -> RenamerWarning -> ShowS
$cshow :: RenamerWarning -> String
show :: RenamerWarning -> String
$cshowList :: [RenamerWarning] -> ShowS
showList :: [RenamerWarning] -> ShowS
Show, (forall x. RenamerWarning -> Rep RenamerWarning x)
-> (forall x. Rep RenamerWarning x -> RenamerWarning)
-> Generic RenamerWarning
forall x. Rep RenamerWarning x -> RenamerWarning
forall x. RenamerWarning -> Rep RenamerWarning x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RenamerWarning -> Rep RenamerWarning x
from :: forall x. RenamerWarning -> Rep RenamerWarning x
$cto :: forall x. Rep RenamerWarning x -> RenamerWarning
to :: forall x. Rep RenamerWarning x -> RenamerWarning
Generic, RenamerWarning -> ()
(RenamerWarning -> ()) -> NFData RenamerWarning
forall a. (a -> ()) -> NFData a
$crnf :: RenamerWarning -> ()
rnf :: RenamerWarning -> ()
NFData)
instance Eq RenamerWarning where
RenamerWarning
x == :: RenamerWarning -> RenamerWarning -> Bool
== RenamerWarning
y = RenamerWarning -> RenamerWarning -> Ordering
forall a. Ord a => a -> a -> Ordering
compare RenamerWarning
x RenamerWarning
y Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ
instance Ord RenamerWarning where
compare :: RenamerWarning -> RenamerWarning -> Ordering
compare RenamerWarning
w1 RenamerWarning
w2 =
case (RenamerWarning
w1, RenamerWarning
w2) of
(SymbolShadowed PName
x Name
y [Name]
_, SymbolShadowed PName
x' Name
y' [Name]
_) ->
(Position, PName) -> (Position, PName) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Name -> Position
byStart Name
y, PName
x) (Name -> Position
byStart Name
y', PName
x')
(UnusedName Name
x, UnusedName Name
x') ->
Position -> Position -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Name -> Position
byStart Name
x) (Name -> Position
byStart Name
x')
(PrefixAssocChanged PrefixOp
_ Expr Name
_ Located Name
op Fixity
_ Expr Name
_, PrefixAssocChanged PrefixOp
_ Expr Name
_ Located Name
op' Fixity
_ Expr Name
_) ->
Position -> Position -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Range -> Position
from (Range -> Position) -> Range -> Position
forall a b. (a -> b) -> a -> b
$ Located Name -> Range
forall a. Located a -> Range
srcRange Located Name
op) (Range -> Position
from (Range -> Position) -> Range -> Position
forall a b. (a -> b) -> a -> b
$ Located Name -> Range
forall a. Located a -> Range
srcRange Located Name
op')
(RenamerWarning, RenamerWarning)
_ -> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (RenamerWarning -> Int
priority RenamerWarning
w1) (RenamerWarning -> Int
priority RenamerWarning
w2)
where
byStart :: Name -> Position
byStart = Range -> Position
from (Range -> Position) -> (Name -> Range) -> Name -> Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Range
nameLoc
priority :: RenamerWarning -> Int
priority SymbolShadowed {} = Int
0 :: Int
priority UnusedName {} = Int
1
priority PrefixAssocChanged {} = Int
2
instance PP RenamerWarning where
ppPrec :: Int -> RenamerWarning -> Doc
ppPrec Int
_ (SymbolShadowed PName
k Name
x [Name]
os) =
Doc -> Int -> Doc -> Doc
hang (String -> Doc
text String
"[warning] at" Doc -> Doc -> Doc
<+> Doc
loc)
Int
4 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
fsep [ Doc
"This binding for" Doc -> Doc -> Doc
<+> Doc -> Doc
backticks (PName -> Doc
forall a. PP a => a -> Doc
pp PName
k)
, Doc
"shadows the existing binding" Doc -> Doc -> Doc
<.> Doc
plural
, String -> Doc
text String
"at" ]
Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat ((Name -> Doc) -> [Name] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Range -> Doc
forall a. PP a => a -> Doc
pp (Range -> Doc) -> (Name -> Range) -> Name -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Range
nameLoc) [Name]
os)
where
plural :: Doc
plural | [Name] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name]
os Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = Char -> Doc
char Char
's'
| Bool
otherwise = Doc
forall a. Monoid a => a
mempty
loc :: Doc
loc = Range -> Doc
forall a. PP a => a -> Doc
pp (Name -> Range
nameLoc Name
x)
ppPrec Int
_ (UnusedName Name
x) =
Doc -> Int -> Doc -> Doc
hang (String -> Doc
text String
"[warning] at" Doc -> Doc -> Doc
<+> Range -> Doc
forall a. PP a => a -> Doc
pp (Name -> Range
nameLoc Name
x))
Int
4 (String -> Doc
text String
"Unused name:" Doc -> Doc -> Doc
<+> Name -> Doc
forall a. PP a => a -> Doc
pp Name
x)
ppPrec Int
_ (PrefixAssocChanged PrefixOp
prefixOp Expr Name
x Located Name
infixOp Fixity
infixFixity Expr Name
y) =
Doc -> Int -> Doc -> Doc
hang (String -> Doc
text String
"[warning] at" Doc -> Doc -> Doc
<+> Range -> Doc
forall a. PP a => a -> Doc
pp (Located Name -> Range
forall a. Located a -> Range
srcRange Located Name
infixOp))
Int
4 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
fsep [ Doc -> Doc
backticks (Expr Name -> Doc
forall a. PP a => a -> Doc
pp Expr Name
old)
, Doc
"is now parsed as"
, Doc -> Doc
backticks (Expr Name -> Doc
forall a. PP a => a -> Doc
pp Expr Name
new) ]
where
old :: Expr Name
old = Expr Name -> Located Name -> Fixity -> Expr Name -> Expr Name
forall n. Expr n -> Located n -> Fixity -> Expr n -> Expr n
EInfix (PrefixOp -> Expr Name -> Expr Name
forall n. PrefixOp -> Expr n -> Expr n
EPrefix PrefixOp
prefixOp Expr Name
x) Located Name
infixOp Fixity
infixFixity Expr Name
y
new :: Expr Name
new = PrefixOp -> Expr Name -> Expr Name
forall n. PrefixOp -> Expr n -> Expr n
EPrefix PrefixOp
prefixOp (Expr Name -> Located Name -> Fixity -> Expr Name -> Expr Name
forall n. Expr n -> Located n -> Fixity -> Expr n -> Expr n
EInfix Expr Name
x Located Name
infixOp Fixity
infixFixity Expr Name
y)