{-

Raise a warning if negation precedence may appear ambiguous to human readers.

<TEST>
yes = -1 ^ 2 -- @Suggestion -(1 ^ 2)
yes = -x ^ y -- @Suggestion -(x ^ y)
yes = -5 `plus` 3 -- @Suggestion -(5 `plus` 3)
yes = -f x `mod` y -- @Suggestion -(f x `mod` y)
yes = -x `mod` y -- @Suggestion -(x `mod` y)
no = -(5 + 3)
no = -5 + 3
no = -(f x)
no = -x
</TEST>
-}

module Hint.Negation(negationParensHint) where

import Hint.Type(DeclHint,Idea(..),rawIdea,toSSA)
import Config.Type
import Data.Generics.Uniplate.DataOnly
import Refact.Types
import GHC.Hs
import GHC.Util
import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable
import GHC.Types.SrcLoc

-- | See [motivating issue #1484](https://github.com/ndmitchell/hlint/issues/1484).
--
-- == Implementation note
--
-- The original intention was to compare fixities so as
-- to only fire the rule when the operand of prefix negation
-- has higher fixity than the negation itself (fixity 6).
--
-- However, since there do not exist any numerically-valued
-- operators with lower fixity than 6
-- (see [table](https://www.haskell.org/onlinereport/decls.html#sect4.4.2)),
-- we do not have to worry about fixity comparisons.
negationParensHint :: DeclHint
negationParensHint :: DeclHint
negationParensHint Scope
_ ModuleEx
_ LHsDecl GhcPs
x =
  (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [Idea])
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LHsExpr GhcPs -> [Idea]
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [Idea]
negatedOp (GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall from to. Biplate from to => from -> [to]
universeBi LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
x :: [LHsExpr GhcPs])

negatedOp :: LHsExpr GhcPs -> [Idea]
negatedOp :: LHsExpr GhcPs -> [Idea]
negatedOp LHsExpr GhcPs
e =
  case LHsExpr GhcPs
e of
    L SrcSpanAnnA
b1 (NegApp XNegApp GhcPs
a1 inner :: LHsExpr GhcPs
inner@(L SrcSpanAnnA
_ OpApp {}) SyntaxExpr GhcPs
a2) ->
      Idea -> [Idea]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Idea -> [Idea]) -> Idea -> [Idea]
forall a b. (a -> b) -> a -> b
$
        Severity
-> String
-> SrcSpan
-> String
-> Maybe String
-> [Note]
-> [Refactoring SrcSpan]
-> Idea
rawIdea
          Severity
Suggestion
          String
"Parenthesize unary negation"
          (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e))
          (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> String
forall a. Outputable a => a -> String
unsafePrettyPrint LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e)
          (String -> Maybe String
forall a. a -> Maybe a
Just String
renderedNewExpr)
          []
          [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> RType
forall a. Brackets a => a -> RType
findType LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e) (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e) [] String
renderedNewExpr]
        where
          renderedNewExpr :: String
renderedNewExpr = GenLocated SrcSpanAnnA (HsExpr GhcPs) -> String
forall a. Outputable a => a -> String
unsafePrettyPrint GenLocated SrcSpanAnnA (HsExpr GhcPs)
newExpr
          parenthesizedOperand :: LHsExpr GhcPs
parenthesizedOperand = LHsExpr GhcPs -> LHsExpr GhcPs
forall a. Brackets a => a -> a
addParen LHsExpr GhcPs
inner
          newExpr :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
newExpr = SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
b1 (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XNegApp GhcPs -> LHsExpr GhcPs -> SyntaxExpr GhcPs -> HsExpr GhcPs
forall p. XNegApp p -> LHsExpr p -> SyntaxExpr p -> HsExpr p
NegApp XNegApp GhcPs
a1 LHsExpr GhcPs
parenthesizedOperand SyntaxExpr GhcPs
a2
    LHsExpr GhcPs
_ -> []