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

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


pattern EqualsConst :: Lexeme Text -> Node (Lexeme Text)
pattern $mEqualsConst :: forall r.
Node (Lexeme Text) -> (Lexeme Text -> r) -> (Void# -> r) -> r
EqualsConst lhs <- Fix (BinaryExpr (Fix (VarExpr lhs)) BopEq (Fix (LiteralExpr ConstId _)))


data IfInfo = IfInfo
    { IfInfo -> Maybe [Lexeme Text]
ifConds    :: Maybe [Lexeme Text]
    , IfInfo -> [Node (Lexeme Text)]
ifBranches :: [Node (Lexeme Text)]
    } deriving (Int -> IfInfo -> ShowS
[IfInfo] -> ShowS
IfInfo -> String
(Int -> IfInfo -> ShowS)
-> (IfInfo -> String) -> ([IfInfo] -> ShowS) -> Show IfInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IfInfo] -> ShowS
$cshowList :: [IfInfo] -> ShowS
show :: IfInfo -> String
$cshow :: IfInfo -> String
showsPrec :: Int -> IfInfo -> ShowS
$cshowsPrec :: Int -> IfInfo -> ShowS
Show)

instance Semigroup IfInfo where
    IfInfo
a <> :: IfInfo -> IfInfo -> IfInfo
<> IfInfo
b = Maybe [Lexeme Text] -> [Node (Lexeme Text)] -> IfInfo
IfInfo ([Lexeme Text] -> [Lexeme Text] -> [Lexeme Text]
forall a. Semigroup a => a -> a -> a
(<>) ([Lexeme Text] -> [Lexeme Text] -> [Lexeme Text])
-> Maybe [Lexeme Text] -> Maybe ([Lexeme Text] -> [Lexeme Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfInfo -> Maybe [Lexeme Text]
ifConds IfInfo
a Maybe ([Lexeme Text] -> [Lexeme Text])
-> Maybe [Lexeme Text] -> Maybe [Lexeme Text]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IfInfo -> Maybe [Lexeme Text]
ifConds IfInfo
b) (IfInfo -> [Node (Lexeme Text)]
ifBranches IfInfo
a [Node (Lexeme Text)]
-> [Node (Lexeme Text)] -> [Node (Lexeme Text)]
forall a. Semigroup a => a -> a -> a
<> IfInfo -> [Node (Lexeme Text)]
ifBranches IfInfo
b)


collectInfo :: Node (Lexeme Text) -> IfInfo
collectInfo :: Node (Lexeme Text) -> IfInfo
collectInfo (Fix (IfStmt (EqualsConst Lexeme Text
lhs) Node (Lexeme Text)
t Maybe (Node (Lexeme Text))
Nothing)) =
    Maybe [Lexeme Text] -> [Node (Lexeme Text)] -> IfInfo
IfInfo ([Lexeme Text] -> Maybe [Lexeme Text]
forall a. a -> Maybe a
Just [Lexeme Text
lhs]) [Node (Lexeme Text)
t]
collectInfo (Fix (IfStmt (EqualsConst Lexeme Text
lhs) Node (Lexeme Text)
t (Just Node (Lexeme Text)
e))) =
    Maybe [Lexeme Text] -> [Node (Lexeme Text)] -> IfInfo
IfInfo ([Lexeme Text] -> Maybe [Lexeme Text]
forall a. a -> Maybe a
Just [Lexeme Text
lhs]) [Node (Lexeme Text)
t] IfInfo -> IfInfo -> IfInfo
forall a. Semigroup a => a -> a -> a
<> Node (Lexeme Text) -> IfInfo
collectInfo Node (Lexeme Text)
e
collectInfo (Fix (IfStmt Node (Lexeme Text)
_ Node (Lexeme Text)
t Maybe (Node (Lexeme Text))
Nothing)) =
    Maybe [Lexeme Text] -> [Node (Lexeme Text)] -> IfInfo
IfInfo Maybe [Lexeme Text]
forall a. Maybe a
Nothing [Node (Lexeme Text)
t]
collectInfo (Fix (IfStmt Node (Lexeme Text)
_ Node (Lexeme Text)
t (Just Node (Lexeme Text)
e))) =
    Maybe [Lexeme Text] -> [Node (Lexeme Text)] -> IfInfo
IfInfo Maybe [Lexeme Text]
forall a. Maybe a
Nothing [Node (Lexeme Text)
t] IfInfo -> IfInfo -> IfInfo
forall a. Semigroup a => a -> a -> a
<> Node (Lexeme Text) -> IfInfo
collectInfo Node (Lexeme Text)
e
collectInfo Node (Lexeme Text)
e =
    Maybe [Lexeme Text] -> [Node (Lexeme Text)] -> IfInfo
IfInfo ([Lexeme Text] -> Maybe [Lexeme Text]
forall a. a -> Maybe a
Just []) [Node (Lexeme Text)
e]

minSequence :: Int
minSequence :: Int
minSequence = Int
3

-- | Returns 'True' if there are at least 'minSequence' if conditions comparing a
-- variable to a constant and all variable names are the same. Additionally checks
-- whether all branches are single statements, in which case it returns
-- 'False'.
shouldDiagnose :: [Lexeme Text] -> [Node (Lexeme Text)] -> Bool
shouldDiagnose :: [Lexeme Text] -> [Node (Lexeme Text)] -> Bool
shouldDiagnose [Lexeme Text]
cs [Node (Lexeme Text)]
branches =
    [Lexeme Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Lexeme Text]
cs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
minSequence Bool -> Bool -> Bool
&& [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Lexeme Text -> Text) -> [Lexeme Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Lexeme Text -> Text
forall text. Lexeme text -> text
lexemeText [Lexeme Text]
cs) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& Bool -> Bool
not ((Node (Lexeme Text) -> Bool) -> [Node (Lexeme Text)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Node (Lexeme Text) -> Bool
forall lexeme. Fix (NodeF lexeme) -> Bool
singleStatement [Node (Lexeme Text)]
branches)
  where
    singleStatement :: Fix (NodeF lexeme) -> Bool
singleStatement (Fix (CompoundStmt [Fix (NodeF lexeme)
_])) = Bool
True
    singleStatement Fix (NodeF lexeme)
_                        = Bool
False


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 :: String
-> Node (Lexeme Text)
-> State [Diagnostic CimplePos] ()
-> State [Diagnostic CimplePos] ()
doNode = \String
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
            IfStmt{} -> do
                let info :: IfInfo
info = Node (Lexeme Text) -> IfInfo
collectInfo Node (Lexeme Text)
node
                case IfInfo -> Maybe [Lexeme Text]
ifConds IfInfo
info of
                  Just cs :: [Lexeme Text]
cs@(Lexeme Text
c:[Lexeme Text]
_) | [Lexeme Text] -> [Node (Lexeme Text)] -> Bool
shouldDiagnose [Lexeme Text]
cs (IfInfo -> [Node (Lexeme Text)]
ifBranches IfInfo
info) ->
                      String -> Lexeme Text -> Text -> State [Diagnostic CimplePos] ()
forall diags at.
(HasDiagnosticsRich diags CimplePos,
 HasDiagnosticInfo at CimplePos) =>
String -> at -> Text -> DiagnosticsT diags ()
warn String
file Lexeme Text
c Text
"if-statement could be a switch"
                  Maybe [Lexeme Text]
_ -> () -> State [Diagnostic CimplePos] ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                AstActions (State [Diagnostic CimplePos]) Text
-> (String, [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 (String
file, IfInfo -> [Node (Lexeme Text)]
ifBranches IfInfo
info)

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


analyse :: (FilePath, [Node (Lexeme Text)]) -> [Diagnostic CimplePos]
analyse :: (String, [Node (Lexeme Text)]) -> [Diagnostic CimplePos]
analyse = [Diagnostic CimplePos] -> [Diagnostic CimplePos]
forall a. [a] -> [a]
reverse ([Diagnostic CimplePos] -> [Diagnostic CimplePos])
-> ((String, [Node (Lexeme Text)]) -> [Diagnostic CimplePos])
-> (String, [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])
-> ((String, [Node (Lexeme Text)])
    -> State [Diagnostic CimplePos] ())
-> (String, [Node (Lexeme Text)])
-> [Diagnostic CimplePos]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AstActions (State [Diagnostic CimplePos]) Text
-> (String, [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 :: ((String, [Node (Lexeme Text)]) -> [Diagnostic CimplePos],
 (Text, Text))
descr = ((String, [Node (Lexeme Text)]) -> [Diagnostic CimplePos]
analyse, (Text
"switch-if", [Text] -> Text
Text.unlines
    [ Text
"Suggests turning sequences of `if`/`else` statements into `switch`, if there are"
    , Text
"at least " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Int -> String
forall a. Show a => a -> String
show Int
minSequence) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" sequential if-conditions"
    , Text
"comparing a variable to a constant."
    , Text
""
    , Text
"**Reason:** switch-case statements are clearer in expressing long sequences of"
    , Text
"comparisons against constants. They also come with duplication checks in most C"
    , Text
"compilers."
    ]))