-- |
-- Module      :  Cryptol.ModuleSystem.Renamer
-- Copyright   :  (c) 2013-2016 Galois, Inc.
-- License     :  BSD3
-- Maintainer  :  cryptol@galois.com
-- Stability   :  provisional
-- Portability :  portable

{-# 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

-- Errors ----------------------------------------------------------------------

data RenamerError
  = MultipleSyms (Located PName) [Name]
    -- ^ Multiple imported symbols contain this name

  | UnboundName Namespace (Located PName)
    -- ^ Some name not bound to any definition

  | OverlappingSyms [Name]
    -- ^ An environment has produced multiple overlapping symbols

  | WrongNamespace Namespace Namespace (Located PName)
    -- ^ expected, actual.
    -- When a name is missing from the expected namespace, but exists in another

  | FixityError (Located Name) Fixity (Located Name) Fixity
    -- ^ When the fixity of two operators conflict

  | OverlappingRecordUpdate (Located [Selector]) (Located [Selector])
    -- ^ When record updates overlap (e.g., @{ r | x = e1, x.y = e2 }@)

  | InvalidDependency [DepName]
    -- ^ Things that can't depend on each other

  | MultipleModParams Ident [Range]
    -- ^ Module parameters with the same name

  | InvalidFunctorImport (ImpName Name)
    -- ^ Can't import functors directly

  | UnexpectedNest Range PName
    -- ^ Nested modules were not supposed to appear here

  | ModuleKindMismatch Range (ImpName Name) ModKind ModKind
    -- ^ Exepcted one kind (first one) but found the other (second one)

    deriving (Int -> RenamerError -> ShowS
[RenamerError] -> ShowS
RenamerError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RenamerError] -> ShowS
$cshowList :: [RenamerError] -> ShowS
show :: RenamerError -> String
$cshow :: RenamerError -> String
showsPrec :: Int -> RenamerError -> ShowS
$cshowsPrec :: Int -> RenamerError -> ShowS
Show, 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
$cto :: forall x. Rep RenamerError x -> RenamerError
$cfrom :: forall x. RenamerError -> Rep RenamerError x
Generic, RenamerError -> ()
forall a. (a -> ()) -> NFData a
rnf :: RenamerError -> ()
$crnf :: RenamerError -> ()
NFData, RenamerError -> RenamerError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RenamerError -> RenamerError -> Bool
$c/= :: RenamerError -> RenamerError -> Bool
== :: RenamerError -> RenamerError -> Bool
$c== :: RenamerError -> RenamerError -> Bool
Eq, Eq 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
min :: RenamerError -> RenamerError -> RenamerError
$cmin :: RenamerError -> RenamerError -> RenamerError
max :: RenamerError -> RenamerError -> RenamerError
$cmax :: RenamerError -> RenamerError -> RenamerError
>= :: RenamerError -> RenamerError -> Bool
$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
compare :: RenamerError -> RenamerError -> Ordering
$ccompare :: RenamerError -> RenamerError -> Ordering
Ord)


{- | We use this to name dependencies.
In addition to normal names we have a way to refer to module parameters
and top-level module constraints, which have no explicit names -}
data DepName = NamedThing Name
               -- ^ Something with a name

             | ModPath ModPath
               -- ^ The module at this path

             | ModParamName Range Ident
               {- ^ Note that the range is important not just for error
                    reporting but to distinguish module parameters with
                    the same name (e.g., in nested functors) -}
             | ConstratintAt Range
               -- ^ Identifed by location in source
               deriving (DepName -> DepName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DepName -> DepName -> Bool
$c/= :: DepName -> DepName -> Bool
== :: DepName -> DepName -> Bool
$c== :: DepName -> DepName -> Bool
Eq,Eq 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
min :: DepName -> DepName -> DepName
$cmin :: DepName -> DepName -> DepName
max :: DepName -> DepName -> DepName
$cmax :: DepName -> DepName -> DepName
>= :: DepName -> DepName -> Bool
$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
compare :: DepName -> DepName -> Ordering
$ccompare :: DepName -> DepName -> Ordering
Ord,Int -> DepName -> ShowS
[DepName] -> ShowS
DepName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DepName] -> ShowS
$cshowList :: [DepName] -> ShowS
show :: DepName -> String
$cshow :: DepName -> String
showsPrec :: Int -> DepName -> ShowS
$cshowsPrec :: Int -> DepName -> ShowS
Show,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
$cto :: forall x. Rep DepName x -> DepName
$cfrom :: forall x. DepName -> Rep DepName x
Generic,DepName -> ()
forall a. (a -> ()) -> NFData a
rnf :: DepName -> ()
$crnf :: DepName -> ()
NFData)

depNameLoc :: DepName -> Maybe Range
depNameLoc :: DepName -> Maybe Range
depNameLoc DepName
x =
  case DepName
x of
    NamedThing Name
n -> forall a. a -> Maybe a
Just (Name -> Range
nameLoc Name
n)
    ConstratintAt Range
r -> forall a. a -> Maybe a
Just Range
r
    ModParamName Range
r Ident
_ -> forall a. a -> Maybe a
Just Range
r
    ModPath {} -> forall a. Maybe a
Nothing


data ModKind = AFunctor | ASignature | AModule
    deriving (Int -> ModKind -> ShowS
[ModKind] -> ShowS
ModKind -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModKind] -> ShowS
$cshowList :: [ModKind] -> ShowS
show :: ModKind -> String
$cshow :: ModKind -> String
showsPrec :: Int -> ModKind -> ShowS
$cshowsPrec :: Int -> ModKind -> ShowS
Show, 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
$cto :: forall x. Rep ModKind x -> ModKind
$cfrom :: forall x. ModKind -> Rep ModKind x
Generic, ModKind -> ()
forall a. (a -> ()) -> NFData a
rnf :: ModKind -> ()
$crnf :: ModKind -> ()
NFData, ModKind -> ModKind -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModKind -> ModKind -> Bool
$c/= :: ModKind -> ModKind -> Bool
== :: ModKind -> ModKind -> Bool
$c== :: ModKind -> ModKind -> Bool
Eq, Eq 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
min :: ModKind -> ModKind -> ModKind
$cmin :: ModKind -> ModKind -> ModKind
max :: ModKind -> ModKind -> ModKind
$cmax :: ModKind -> ModKind -> ModKind
>= :: ModKind -> ModKind -> Bool
$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
compare :: ModKind -> ModKind -> Ordering
$ccompare :: ModKind -> ModKind -> Ordering
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
<+> forall a. PP a => a -> Doc
pp (forall a. Located a -> Range
srcRange Located PName
lqn))
         Int
4 forall a b. (a -> b) -> a -> b
$ (String -> Doc
text String
"Multiple definitions for symbol:" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp (forall a. Located a -> a
thing Located PName
lqn))
          Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat (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
<+> forall a. PP a => a -> Doc
pp (forall a. Located a -> Range
srcRange Located PName
lqn))
         Int
4 (Doc
something Doc -> Doc -> Doc
<+> Doc
"not in scope:" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp (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"

    OverlappingSyms [Name]
qns ->
      Doc -> Int -> Doc -> Doc
hang (String -> Doc
text String
"[error]")
         Int
4 forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"Overlapping symbols defined:"
          Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat (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
<+> forall a. PP a => a -> Doc
pp (forall a. Located a -> Range
srcRange Located PName
lqn ))
         Int
4 ([Doc] -> Doc
fsep forall a b. (a -> b) -> a -> b
$
            [ Doc
"Expected a", forall {a}. IsString a => Namespace -> a
sayNS Namespace
expected, Doc
"named", Doc -> Doc
quotes (forall a. PP a => a -> Doc
pp (forall a. Located a -> a
thing Located PName
lqn))
            , Doc
"but found a", forall {a}. IsString a => Namespace -> a
sayNS Namespace
actual, Doc
"instead"
            ] forall a. [a] -> [a] -> [a]
++ [Doc]
suggestion)
        where
        sayNS :: Namespace -> a
sayNS Namespace
ns = case Namespace
ns of
                     Namespace
NSValue  -> a
"value"
                     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
<.> forall a. PP a => a -> Doc
pp (forall a. Located a -> a
thing Located PName
lqn) Doc -> Doc -> Doc
<.> String -> Doc
textString
")?"]
            (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
<+> forall a. PP a => a -> Doc
pp (forall a. Located a -> Range
srcRange Located Name
o1) Doc -> Doc -> Doc
<+> String -> Doc
text String
"and" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp (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 forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat
                   [ Doc
"•" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp (forall a. Located a -> a
thing Located Name
o1) Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall a. PP a => a -> Doc
pp Fixity
f1)
                   , Doc
"•" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp (forall a. Located a -> a
thing Located Name
o2) Doc -> Doc -> Doc
<+> Doc -> Doc
parens (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 (forall a. Located a -> a
thing Located [Selector]
as) Doc -> Doc -> Doc
<+> Doc
"at" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp (forall a. Located a -> Range
srcRange Located [Selector]
as)

    InvalidDependency [DepName]
ds ->
      Doc -> Int -> Doc -> Doc
hang Doc
"[error] Invalid recursive dependency:"
         Int
4 ([Doc] -> Doc
vcat [ Doc
"•" Doc -> Doc -> 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 -> forall a. Monoid a => a
mempty
                 | DepName
x <- [DepName]
ds ])
      where ppR :: Range -> Doc
ppR Range
r = forall a. PP a => a -> Doc
pp (Range -> Position
from Range
r) Doc -> Doc -> Doc
<.> Doc
"--" Doc -> Doc -> Doc
<.> forall a. PP a => a -> Doc
pp (Range -> Position
to Range
r)

    MultipleModParams Ident
x [Range]
rs ->
      Doc -> Int -> Doc -> Doc
hang (Doc
"[error] Multiple parameters with name" Doc -> Doc -> Doc
<+> Doc -> Doc
backticks (forall a. PP a => a -> Doc
pp Ident
x))
         Int
4 ([Doc] -> Doc
vcat [ Doc
"•" Doc -> Doc -> 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 (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
<+> forall a. PP a => a -> Doc
pp Range
s)
        Int
4 (Doc
"submodule" Doc -> Doc -> Doc
<+> Doc -> Doc
backticks (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
<+> forall a. PP a => a -> Doc
pp Range
r)
        Int
4 ([Doc] -> Doc
vcat [ Doc
"• Expected" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp ModKind
expected
                , Doc
"•" Doc -> Doc -> Doc
<+> Doc -> Doc
backticks (forall a. PP a => a -> Doc
pp ImpName Name
x) Doc -> Doc -> Doc
<+> Doc
"is" Doc -> Doc -> 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
<+> 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
<+> forall a. PP a => a -> Doc
pp Name
n
          Namespace
NSType   -> Doc
"type" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp Name
n
          Namespace
NSValue  -> forall a. PP a => a -> Doc
pp Name
n
      ModParamName Range
_r Ident
i -> Doc
"module parameter" Doc -> Doc -> 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
<+> forall a. PP a => a -> Doc
pp ModName
m
          (ModName
_,[Ident]
is) -> Doc
"submodule" Doc -> Doc -> Doc
<+> [Doc] -> Doc
hcat (forall a. a -> [a] -> [a]
intersperse Doc
"::" (forall a b. (a -> b) -> [a] -> [b]
map forall a. PP a => a -> Doc
pp [Ident]
is))



-- Warnings --------------------------------------------------------------------

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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RenamerWarning] -> ShowS
$cshowList :: [RenamerWarning] -> ShowS
show :: RenamerWarning -> String
$cshow :: RenamerWarning -> String
showsPrec :: Int -> RenamerWarning -> ShowS
$cshowsPrec :: Int -> RenamerWarning -> ShowS
Show, 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
$cto :: forall x. Rep RenamerWarning x -> RenamerWarning
$cfrom :: forall x. RenamerWarning -> Rep RenamerWarning x
Generic, RenamerWarning -> ()
forall a. (a -> ()) -> NFData a
rnf :: RenamerWarning -> ()
$crnf :: RenamerWarning -> ()
NFData)

instance Eq RenamerWarning where
  RenamerWarning
x == :: RenamerWarning -> RenamerWarning -> Bool
== RenamerWarning
y = forall a. Ord a => a -> a -> Ordering
compare RenamerWarning
x RenamerWarning
y forall a. Eq a => a -> a -> Bool
== Ordering
EQ

-- used to determine in what order to show things
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]
_) ->
        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') ->
        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
_) ->
        forall a. Ord a => a -> a -> Ordering
compare (Range -> Position
from forall a b. (a -> b) -> a -> b
$ forall a. Located a -> Range
srcRange Located Name
op) (Range -> Position
from forall a b. (a -> b) -> a -> b
$ forall a. Located a -> Range
srcRange Located Name
op')
      (RenamerWarning, RenamerWarning)
_ -> 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 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 forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
fsep [ Doc
"This binding for" Doc -> Doc -> Doc
<+> Doc -> Doc
backticks (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 (forall a b. (a -> b) -> [a] -> [b]
map (forall a. PP a => a -> Doc
pp forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Range
nameLoc) [Name]
os)

    where
    plural :: Doc
plural | forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name]
os forall a. Ord a => a -> a -> Bool
> Int
1 = Char -> Doc
char Char
's'
           | Bool
otherwise     = forall a. Monoid a => a
mempty

    loc :: Doc
loc = 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
<+> forall a. PP a => a -> Doc
pp (Name -> Range
nameLoc Name
x))
       Int
4 (String -> Doc
text String
"Unused name:" Doc -> Doc -> 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
<+> forall a. PP a => a -> Doc
pp (forall a. Located a -> Range
srcRange Located Name
infixOp))
       Int
4 forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
fsep [ Doc -> Doc
backticks (forall a. PP a => a -> Doc
pp Expr Name
old)
                , Doc
"is now parsed as"
                , Doc -> Doc
backticks (forall a. PP a => a -> Doc
pp Expr Name
new) ]

    where
    old :: Expr Name
old = forall n. Expr n -> Located n -> Fixity -> Expr n -> Expr n
EInfix (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 = forall n. PrefixOp -> Expr n -> Expr n
EPrefix PrefixOp
prefixOp (forall n. Expr n -> Located n -> Fixity -> Expr n -> Expr n
EInfix Expr Name
x Located Name
infixOp Fixity
infixFixity Expr Name
y)