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

import           Data.Functor.Identity           (Identity)
import           Data.Text                       (Text)
import           Language.C.Analysis.AstAnalysis (ExprSide (..), tExpr)
import           Language.C.Analysis.SemRep      (GlobalDecls, Type (..))
import           Language.C.Analysis.TravMonad   (MonadTrav, Trav, TravT)
import           Language.C.Analysis.TypeUtils   (canonicalType)
import qualified Language.C.Pretty               as C
import           Language.C.Syntax.AST           (CExpr, CExpression (..),
                                                  annotation)
import           Prettyprinter                   (pretty, (<+>))
import           Tokstyle.C.Env                  (Env, recordLinterError)
import           Tokstyle.C.Patterns
import           Tokstyle.C.TraverseAst          (AstActions (..), astActions,
                                                  traverseAst)
import           Tokstyle.C.TravUtils            (backticks)


-- | This catches `sizeof(buf)` where `buf` is a pointer instead of an array.
checkSizeof :: CExpr -> Type -> TravT Env Identity ()
checkSizeof :: CExpr -> Type -> TravT Env Identity ()
checkSizeof CExpr
_ (Type -> Type
canonicalType -> TY_struct String
_) = () -> TravT Env Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkSizeof CExpr
_ (Type -> Type
canonicalType -> TY_struct_ptr String
"IPPTsPng") = () -> TravT Env Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkSizeof CExpr
_ ArrayType{} = () -> TravT Env Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkSizeof CExpr
e Type
ty
  | Type -> Bool
isIntegral Type
ty = () -> TravT Env Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | Bool
otherwise =
      NodeInfo -> Doc AnsiStyle -> TravT Env Identity ()
recordLinterError (CExpr -> NodeInfo
forall (ast :: * -> *) a. Annotated ast => ast a -> a
annotation CExpr
e) (Doc AnsiStyle -> TravT Env Identity ())
-> Doc AnsiStyle -> TravT Env Identity ()
forall a b. (a -> b) -> a -> b
$
          Doc AnsiStyle
"disallowed sizeof argument of type" 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
"- did you mean for" 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 (CExpr -> Doc
forall p. Pretty p => p -> Doc
C.pretty CExpr
e))) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
"to be an array?"


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
        CSizeofExpr CExpr
e NodeInfo
_ -> do
            Type
ty <- [StmtCtx] -> ExprSide -> CExpr -> TravT Env Identity Type
forall (m :: * -> *).
MonadTrav m =>
[StmtCtx] -> ExprSide -> CExpr -> m Type
tExpr [] ExprSide
RValue CExpr
e
            CExpr -> Type -> TravT Env Identity ()
checkSizeof CExpr
e Type
ty
            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
"sizeof", Text
"Checks for `sizeof(buf)` where `buf` is a pointer instead of an array."))