{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Strict            #-}
module Tokstyle.Linter.Parens (descr) where

import           Control.Monad.State.Strict  (State)
import qualified Control.Monad.State.Strict  as State
import           Data.Fix                    (Fix (..))
import           Data.Maybe                  (maybeToList)
import           Data.Text                   (Text)
import qualified Data.Text                   as Text
import           Language.Cimple             (Lexeme (..), Node, NodeF (..))
import           Language.Cimple.Diagnostics (CimplePos, Diagnostic)
import           Language.Cimple.TraverseAst (AstActions, astActions, doNode,
                                              traverseAst)
import           Tokstyle.Common             (warn)


needsParens :: Node a -> Bool
needsParens :: Node a -> Bool
needsParens Node a
n = case Node a -> NodeF a (Node a)
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Node a
n of
    BinaryExpr{}  -> Bool
True
    TernaryExpr{} -> Bool
True
    CastExpr{}    -> Bool
True
    NodeF a (Node a)
_             -> Bool
False


checkArg :: FilePath -> Node (Lexeme Text) -> State [Diagnostic CimplePos] ()
checkArg :: FilePath -> Node (Lexeme Text) -> State [Diagnostic CimplePos] ()
checkArg FilePath
file Node (Lexeme Text)
arg = case Node (Lexeme Text) -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Node (Lexeme Text)
arg of
    ParenExpr{} -> FilePath
-> Node (Lexeme Text) -> Text -> State [Diagnostic CimplePos] ()
forall diags at.
(HasDiagnosticsRich diags CimplePos,
 HasDiagnosticInfo at CimplePos) =>
FilePath -> at -> Text -> DiagnosticsT diags ()
warn FilePath
file Node (Lexeme Text)
arg Text
"function call argument does not need parentheses"
    NodeF (Lexeme Text) (Node (Lexeme Text))
_           -> () -> State [Diagnostic CimplePos] ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()


linter :: AstActions (State [Diagnostic CimplePos]) Text
linter :: AstActions (State [Diagnostic CimplePos]) Text
linter = AstActions (State [Diagnostic CimplePos]) Text
forall (f :: * -> *) text. Applicative f => AstActions f text
astActions
    { doNode :: FilePath
-> Node (Lexeme Text)
-> State [Diagnostic CimplePos] ()
-> State [Diagnostic CimplePos] ()
doNode = \FilePath
file Node (Lexeme Text)
node State [Diagnostic CimplePos] ()
act ->
        case Node (Lexeme Text) -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Node (Lexeme Text)
node of
            -- Extra parentheses inside macro body is allowed (and sometimes needed).
            PreprocDefineConst{} -> () -> State [Diagnostic CimplePos] ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            PreprocDefineMacro{} -> () -> State [Diagnostic CimplePos] ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

            FunctionCall Node (Lexeme Text)
_ [Node (Lexeme Text)]
args -> do
                (Node (Lexeme Text) -> State [Diagnostic CimplePos] ())
-> [Node (Lexeme Text)] -> State [Diagnostic CimplePos] ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath -> Node (Lexeme Text) -> State [Diagnostic CimplePos] ()
checkArg FilePath
file) [Node (Lexeme Text)]
args
                State [Diagnostic CimplePos] ()
act

            IfStmt (Fix (ParenExpr Node (Lexeme Text)
c)) Node (Lexeme Text)
t Maybe (Node (Lexeme Text))
e ->
                AstActions (State [Diagnostic CimplePos]) Text
-> (FilePath, [Node (Lexeme Text)])
-> State [Diagnostic CimplePos] ()
forall text a (f :: * -> *).
(TraverseAst text a, Applicative f) =>
AstActions f text -> a -> f ()
traverseAst AstActions (State [Diagnostic CimplePos]) Text
linter (FilePath
file, [Node (Lexeme Text)
c, Node (Lexeme Text)
t] [Node (Lexeme Text)]
-> [Node (Lexeme Text)] -> [Node (Lexeme Text)]
forall a. [a] -> [a] -> [a]
++ Maybe (Node (Lexeme Text)) -> [Node (Lexeme Text)]
forall a. Maybe a -> [a]
maybeToList Maybe (Node (Lexeme Text))
e)

            Return (Just (Fix ParenExpr{})) -> do
                FilePath
-> Node (Lexeme Text) -> Text -> State [Diagnostic CimplePos] ()
forall diags at.
(HasDiagnosticsRich diags CimplePos,
 HasDiagnosticInfo at CimplePos) =>
FilePath -> at -> Text -> DiagnosticsT diags ()
warn FilePath
file Node (Lexeme Text)
node Text
"return expression does not need parentheses"
                State [Diagnostic CimplePos] ()
act
            VarDeclStmt Node (Lexeme Text)
_ (Just (Fix ParenExpr{})) -> do
                FilePath
-> Node (Lexeme Text) -> Text -> State [Diagnostic CimplePos] ()
forall diags at.
(HasDiagnosticsRich diags CimplePos,
 HasDiagnosticInfo at CimplePos) =>
FilePath -> at -> Text -> DiagnosticsT diags ()
warn FilePath
file Node (Lexeme Text)
node Text
"variable initialiser does not need parentheses"
                State [Diagnostic CimplePos] ()
act
            AssignExpr Node (Lexeme Text)
_ AssignOp
_ (Fix ParenExpr{}) -> do
                FilePath
-> Node (Lexeme Text) -> Text -> State [Diagnostic CimplePos] ()
forall diags at.
(HasDiagnosticsRich diags CimplePos,
 HasDiagnosticInfo at CimplePos) =>
FilePath -> at -> Text -> DiagnosticsT diags ()
warn FilePath
file Node (Lexeme Text)
node Text
"the right hand side of assignments does not need parentheses"
                State [Diagnostic CimplePos] ()
act
            ParenExpr Node (Lexeme Text)
expr | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Node (Lexeme Text) -> Bool
forall a. Node a -> Bool
needsParens Node (Lexeme Text)
expr -> do
                FilePath
-> Node (Lexeme Text) -> Text -> State [Diagnostic CimplePos] ()
forall diags at.
(HasDiagnosticsRich diags CimplePos,
 HasDiagnosticInfo at CimplePos) =>
FilePath -> at -> Text -> DiagnosticsT diags ()
warn FilePath
file Node (Lexeme Text)
node Text
"expression does not need parentheses"
                State [Diagnostic CimplePos] ()
act

            NodeF (Lexeme Text) (Node (Lexeme Text))
_ -> State [Diagnostic CimplePos] ()
act
    }

analyse :: (FilePath, [Node (Lexeme Text)]) -> [Diagnostic CimplePos]
analyse :: (FilePath, [Node (Lexeme Text)]) -> [Diagnostic CimplePos]
analyse = [Diagnostic CimplePos] -> [Diagnostic CimplePos]
forall a. [a] -> [a]
reverse ([Diagnostic CimplePos] -> [Diagnostic CimplePos])
-> ((FilePath, [Node (Lexeme Text)]) -> [Diagnostic CimplePos])
-> (FilePath, [Node (Lexeme Text)])
-> [Diagnostic CimplePos]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State [Diagnostic CimplePos] ()
 -> [Diagnostic CimplePos] -> [Diagnostic CimplePos])
-> [Diagnostic CimplePos]
-> State [Diagnostic CimplePos] ()
-> [Diagnostic CimplePos]
forall a b c. (a -> b -> c) -> b -> a -> c
flip State [Diagnostic CimplePos] ()
-> [Diagnostic CimplePos] -> [Diagnostic CimplePos]
forall s a. State s a -> s -> s
State.execState [] (State [Diagnostic CimplePos] () -> [Diagnostic CimplePos])
-> ((FilePath, [Node (Lexeme Text)])
    -> State [Diagnostic CimplePos] ())
-> (FilePath, [Node (Lexeme Text)])
-> [Diagnostic CimplePos]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AstActions (State [Diagnostic CimplePos]) Text
-> (FilePath, [Node (Lexeme Text)])
-> State [Diagnostic CimplePos] ()
forall text a (f :: * -> *).
(TraverseAst text a, Applicative f) =>
AstActions f text -> a -> f ()
traverseAst AstActions (State [Diagnostic CimplePos]) Text
linter

descr :: ((FilePath, [Node (Lexeme Text)]) -> [Diagnostic CimplePos], (Text, Text))
descr :: ((FilePath, [Node (Lexeme Text)]) -> [Diagnostic CimplePos],
 (Text, Text))
descr = ((FilePath, [Node (Lexeme Text)]) -> [Diagnostic CimplePos]
analyse, (Text
"parens", [Text] -> Text
Text.unlines
    [ Text
"Suggests removing parentheses where they are not needed:"
    , Text
""
    , Text
"- in return expressions, e.g. `return(something);` should be `return something;`."
    , Text
"- in initialisers, e.g. `int foo = (something);` should be `int foo = something;`."
    , Text
"- in assignments, e.g. `foo = (something);` should be `foo = something;`."
    , Text
"- in parentheses, e.g. `((something))` should be `(something)`."
    , Text
""
    , Text
"**Reason:** sometimes extra parentheses add clarity, so we don't forbid all"
    , Text
"redundant parentheses, but in the above cases, they don't add clarity and only"
    , Text
"add more syntax and confusion as to why there are extra parentheses there."
    ]))