    -- |
    -- 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
    (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)

    {- | 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
    (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"

        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
    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, 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 recursive 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)

        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
          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))

    -- 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
    (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

    -- 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]
    _) ->
            (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)