{-# 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 (warn)
import           Language.Cimple.TraverseAst (AstActions, astActions, doNode,
                                              traverseAst)


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 [Text] ()
checkArg :: FilePath -> Node (Lexeme Text) -> State [Text] ()
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 [Text] ()
forall at diags.
(HasLocation at, HasDiagnostics diags) =>
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 [Text] ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()


linter :: AstActions (State [Text]) Text
linter :: AstActions (State [Text]) Text
linter = AstActions (State [Text]) Text
forall (f :: * -> *) text. Applicative f => AstActions f text
astActions
    { doNode :: FilePath
-> Node (Lexeme Text) -> State [Text] () -> State [Text] ()
doNode = \FilePath
file Node (Lexeme Text)
node State [Text] ()
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 [Text] ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            PreprocDefineMacro{} -> () -> State [Text] ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

            IfStmt (Fix (ParenExpr Node (Lexeme Text)
c)) Node (Lexeme Text)
t Maybe (Node (Lexeme Text))
e ->
                AstActions (State [Text]) Text
-> (FilePath, [Node (Lexeme Text)]) -> State [Text] ()
forall text a (f :: * -> *).
(TraverseAst text a, Applicative f) =>
AstActions f text -> a -> f ()
traverseAst AstActions (State [Text]) 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 [Text] ()
forall at diags.
(HasLocation at, HasDiagnostics diags) =>
FilePath -> at -> Text -> DiagnosticsT diags ()
warn FilePath
file Node (Lexeme Text)
node Text
"return expression does not need parentheses"
                State [Text] ()
act
            VarDeclStmt Node (Lexeme Text)
_ (Just (Fix ParenExpr{})) -> do
                FilePath -> Node (Lexeme Text) -> Text -> State [Text] ()
forall at diags.
(HasLocation at, HasDiagnostics diags) =>
FilePath -> at -> Text -> DiagnosticsT diags ()
warn FilePath
file Node (Lexeme Text)
node Text
"variable initialiser does not need parentheses"
                State [Text] ()
act
            AssignExpr Node (Lexeme Text)
_ AssignOp
_ (Fix ParenExpr{}) -> do
                FilePath -> Node (Lexeme Text) -> Text -> State [Text] ()
forall at diags.
(HasLocation at, HasDiagnostics diags) =>
FilePath -> at -> Text -> DiagnosticsT diags ()
warn FilePath
file Node (Lexeme Text)
node Text
"the right hand side of assignments does not need parentheses"
                State [Text] ()
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 [Text] ()
forall at diags.
(HasLocation at, HasDiagnostics diags) =>
FilePath -> at -> Text -> DiagnosticsT diags ()
warn FilePath
file Node (Lexeme Text)
node Text
"expression does not need parentheses"
                State [Text] ()
act

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

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

descr :: ((FilePath, [Node (Lexeme Text)]) -> [Text], (Text, Text))
descr :: ((FilePath, [Node (Lexeme Text)]) -> [Text], (Text, Text))
descr = ((FilePath, [Node (Lexeme Text)]) -> [Text]
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."
    ]))