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

import           Data.Functor.Identity           (Identity)
import           Data.Text                       (Text)
import           Language.C.Analysis.AstAnalysis (ExprSide (..), tExpr)
import           Language.C.Analysis.SemRep      (GlobalDecls, IntType (..),
                                                  Type (..), TypeDefRef (..),
                                                  TypeName (..))
import           Language.C.Analysis.TravMonad   (MonadTrav, Trav, TravT)
import           Language.C.Data.Ident           (Ident (..))
import qualified Language.C.Pretty               as C
import           Language.C.Syntax.AST           (CBinaryOp (..), CExpr,
                                                  CExpression (..),
                                                  CUnaryOp (..), annotation)
import           Prettyprinter                   (pretty, (<+>))
import           Tokstyle.C.Env                  (Env, recordLinterError)

import           Tokstyle.C.TraverseAst          (AstActions (..), astActions,
                                                  traverseAst)
import           Tokstyle.C.TravUtils            (backticks)

checkBoolConversion :: CExpr -> TravT Env Identity ()
checkBoolConversion :: CExpr -> TravT Env Identity ()
checkBoolConversion CExpr
expr = do
    Type
ty <- [StmtCtx] -> ExprSide -> CExpr -> TravT Env Identity Type
forall (m :: * -> *).
MonadTrav m =>
[StmtCtx] -> ExprSide -> CExpr -> m Type
tExpr [] ExprSide
RValue CExpr
expr
    case Type
ty of
        DirectType (TyIntegral IntType
_) TypeQuals
_ Attributes
_ -> () -> TravT Env Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        TypeDefType (TypeDefRef (Ident String
"bool" Int
_ NodeInfo
_) Type
_ NodeInfo
_) TypeQuals
_ Attributes
_ -> () -> TravT Env Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        PtrType Type
_ TypeQuals
_ Attributes
_ ->
            NodeInfo -> Doc AnsiStyle -> TravT Env Identity ()
recordLinterError (CExpr -> NodeInfo
forall (ast :: * -> *) a. Annotated ast => ast a -> a
annotation CExpr
expr) (Doc AnsiStyle -> TravT Env Identity ())
-> Doc AnsiStyle -> TravT Env Identity ()
forall a b. (a -> b) -> a -> b
$
                Doc AnsiStyle
"implicit conversion from" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann
backticks (String -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty (Doc -> String
forall a. Show a => a -> String
show (Type -> Doc
forall p. Pretty p => p -> Doc
C.pretty Type
ty))) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
"to bool"
        Type
_ -> () -> TravT Env Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()


linter :: AstActions (TravT Env Identity)
linter :: AstActions (TravT Env Identity)
linter = AstActions (TravT Env Identity)
forall (f :: * -> *). Applicative f => AstActions f
astActions
    { doExpr :: CExpr -> TravT Env Identity () -> TravT Env Identity ()
doExpr = \CExpr
node TravT Env Identity ()
act -> case CExpr
node of
        CCond CExpr
c Maybe CExpr
_ CExpr
_ NodeInfo
_ -> do
            CExpr -> TravT Env Identity ()
checkBoolConversion CExpr
c
            TravT Env Identity ()
act
        CUnary CUnaryOp
CNegOp CExpr
e NodeInfo
_ -> do
            CExpr -> TravT Env Identity ()
checkBoolConversion CExpr
e
            TravT Env Identity ()
act
        CBinary CBinaryOp
CLorOp CExpr
l CExpr
r NodeInfo
_ -> do
            CExpr -> TravT Env Identity ()
checkBoolConversion CExpr
l
            CExpr -> TravT Env Identity ()
checkBoolConversion CExpr
r
            TravT Env Identity ()
act
        CBinary CBinaryOp
CLndOp CExpr
l CExpr
r NodeInfo
_ -> do
            CExpr -> TravT Env Identity ()
checkBoolConversion CExpr
l
            CExpr -> TravT Env Identity ()
checkBoolConversion CExpr
r
            TravT Env Identity ()
act

        CExpr
_ -> TravT Env Identity ()
act
    }


analyse :: GlobalDecls -> Trav Env ()
analyse :: GlobalDecls -> TravT Env Identity ()
analyse = AstActions (TravT Env Identity)
-> GlobalDecls -> TravT Env Identity ()
forall a (f :: * -> *).
(TraverseAst a, Applicative f) =>
AstActions f -> a -> f ()
traverseAst AstActions (TravT Env Identity)
linter


descr :: (GlobalDecls -> Trav Env (), (Text, Text))
descr :: (GlobalDecls -> TravT Env Identity (), (Text, Text))
descr = (GlobalDecls -> TravT Env Identity ()
analyse, (Text
"bool-conversion", Text
"Checks for implicit conversions to bool."))