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

import           Data.Functor.Identity           (Identity)
import           Language.C.Analysis.AstAnalysis (ExprSide (..), tExpr)
import           Language.C.Analysis.SemError    (typeMismatch)
import           Language.C.Analysis.SemRep      (GlobalDecls, IntType (..),
                                                  Type (..), TypeDefRef (..),
                                                  TypeName (..))
import           Language.C.Analysis.TravMonad   (MonadTrav, Trav, TravT,
                                                  recordError)
import           Language.C.Data.Ident           (Ident (..))
import           Language.C.Pretty               (pretty)
import           Language.C.Syntax.AST           (CBinaryOp (..), CExpr,
                                                  CExpression (..),
                                                  CUnaryOp (..), annotation)
import           Tokstyle.C.Env                  (Env)
import           Tokstyle.C.TraverseAst          (AstActions (..), astActions,
                                                  traverseAst)

checkBoolConversion :: MonadTrav m => CExpr -> m ()
checkBoolConversion :: CExpr -> m ()
checkBoolConversion CExpr
expr = do
    Type
ty <- [StmtCtx] -> ExprSide -> CExpr -> m Type
forall (m :: * -> *).
MonadTrav m =>
[StmtCtx] -> ExprSide -> CExpr -> m Type
tExpr [] ExprSide
RValue CExpr
expr
    case Type
ty of
        DirectType (TyIntegral IntType
TyBool) TypeQuals
_ Attributes
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        DirectType (TyIntegral IntType
TyInt) TypeQuals
_ Attributes
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        TypeDefType (TypeDefRef (Ident String
"bool" Int
_ NodeInfo
_) Type
_ NodeInfo
_) TypeQuals
_ Attributes
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Type
_ ->
            let annot :: (NodeInfo, Type)
annot = (CExpr -> NodeInfo
forall (ast :: * -> *) a. Annotated ast => ast a -> a
annotation CExpr
expr, Type
ty) in
            TypeMismatch -> m ()
forall (m :: * -> *) e. (MonadCError m, Error e) => e -> m ()
recordError (TypeMismatch -> m ()) -> TypeMismatch -> m ()
forall a b. (a -> b) -> a -> b
$ String -> (NodeInfo, Type) -> (NodeInfo, Type) -> TypeMismatch
typeMismatch (String
"implicit conversion from " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Doc -> String
forall a. Show a => a -> String
show (Type -> Doc
forall p. Pretty p => p -> Doc
pretty Type
ty) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" to bool") (NodeInfo, Type)
annot (NodeInfo, Type)
annot


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 ()
forall (m :: * -> *). MonadTrav m => CExpr -> m ()
checkBoolConversion CExpr
c
            TravT Env Identity ()
act
        CUnary CUnaryOp
CNegOp CExpr
e NodeInfo
_ -> do
            CExpr -> TravT Env Identity ()
forall (m :: * -> *). MonadTrav m => CExpr -> m ()
checkBoolConversion CExpr
e
            TravT Env Identity ()
act
        CBinary CBinaryOp
CLorOp CExpr
l CExpr
r NodeInfo
_ -> do
            CExpr -> TravT Env Identity ()
forall (m :: * -> *). MonadTrav m => CExpr -> m ()
checkBoolConversion CExpr
l
            CExpr -> TravT Env Identity ()
forall (m :: * -> *). MonadTrav m => CExpr -> m ()
checkBoolConversion CExpr
r
            TravT Env Identity ()
act
        CBinary CBinaryOp
CLndOp CExpr
l CExpr
r NodeInfo
_ -> do
            CExpr -> TravT Env Identity ()
forall (m :: * -> *). MonadTrav m => CExpr -> m ()
checkBoolConversion CExpr
l
            CExpr -> TravT Env Identity ()
forall (m :: * -> *). MonadTrav m => CExpr -> m ()
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