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

import           Control.Monad                   (unless, when)
import           Data.Functor.Identity           (Identity)
import           Data.List                       (intercalate, isInfixOf,
                                                  isPrefixOf, isSuffixOf)
import qualified Data.Map.Strict                 as Map
import           Data.Maybe                      (mapMaybe)
import           Data.Set                        (Set)
import qualified Data.Set                        as Set
import           Data.Text                       (Text)
import qualified Data.Text                       as Text
import           Language.C.Analysis.AstAnalysis (ExprSide (..), tExpr)
import           Language.C.Analysis.SemRep      (CompTypeRef (..), FunDef (..),
                                                  FunType (..),
                                                  GlobalDecls (..),
                                                  IdentDecl (..),
                                                  ParamDecl (..), Type (..),
                                                  TypeName (..), VarDecl (..),
                                                  VarName (..))
import           Language.C.Analysis.TravMonad   (Trav, TravT)
import           Language.C.Analysis.TypeUtils   (canonicalType)
import           Language.C.Data.Ident           (Ident (..), SUERef (..))
import           Language.C.Data.Node            (NodeInfo)
import qualified Language.C.Pretty               as C
import           Language.C.Syntax.AST
import           Language.C.Syntax.Constants     (CInteger (..))
import           Prettyprinter                   (pretty, (<+>))
import qualified Tokstyle.C.Env                  as Env
import           Tokstyle.C.Env                  (DiagnosticLevel (..), Env,
                                                  recordLinterError,
                                                  recordRichError)
import           Tokstyle.C.ObjectSystem         (CallbackSlot (..),
                                                  ObjectInfo (..),
                                                  discoverObjectTypes,
                                                  isCallbackMember, isFuncPtr,
                                                  isUserdataMember)
import           Tokstyle.C.Patterns
import           Tokstyle.C.TraverseAst          (AstActions (..), astActions,
                                                  traverseAst)
import           Tokstyle.C.TravUtils            (backticks)


-- | Analyze a function body to see if it behaves like a registry.
isRegistryBehavior :: Map.Map String ObjectInfo -> FunDef -> Set CallbackSlot
isRegistryBehavior :: Map String ObjectInfo -> FunDef -> Set CallbackSlot
isRegistryBehavior Map String ObjectInfo
objs (FunDef (VarDecl VarName
_ DeclAttrs
_ (FunctionType (FunType Type
_ [ParamDecl]
params Bool
_) Attributes
_)) Stmt
body NodeInfo
_) =
    let
        paramInfos :: [(String, Type)]
paramInfos = (ParamDecl -> Maybe (String, Type))
-> [ParamDecl] -> [(String, Type)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ParamDecl -> Maybe (String, Type)
getParamInfo [ParamDecl]
params
        getParamInfo :: ParamDecl -> Maybe (String, Type)
getParamInfo (ParamDecl (VarDecl (VarName (Ident String
n Int
_ NodeInfo
_) Maybe AsmName
_) DeclAttrs
_ Type
ty) NodeInfo
_) = (String, Type) -> Maybe (String, Type)
forall a. a -> Maybe a
Just (String
n, Type
ty)
        getParamInfo ParamDecl
_ = Maybe (String, Type)
forall a. Maybe a
Nothing

        paramNames :: [String]
paramNames = ((String, Type) -> String) -> [(String, Type)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Type) -> String
forall a b. (a, b) -> a
fst [(String, Type)]
paramInfos

        -- Check if an expression is a parameter.
        isParam :: CExpression a -> Bool
isParam (CVar (Ident String
n Int
_ NodeInfo
_) a
_) = String
n String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
paramNames
        isParam CExpression a
_                      = Bool
False

        -- Resolve the struct type of a variable if it's a parameter.
        getStructType :: CExpression a -> Maybe String
getStructType (CVar (Ident String
n Int
_ NodeInfo
_) a
_) =
            case String -> [(String, Type)] -> Maybe Type
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
n [(String, Type)]
paramInfos of
                Just (Type -> Type
canonicalType -> PtrType (DirectType (TyComp (CompTypeRef (NamedRef (Ident String
s Int
_ NodeInfo
_)) CompTyKind
_ NodeInfo
_)) TypeQuals
_ Attributes
_) TypeQuals
_ Attributes
_) -> String -> Maybe String
forall a. a -> Maybe a
Just String
s
                Maybe Type
_ -> Maybe String
forall a. Maybe a
Nothing
        getStructType CExpression a
_ = Maybe String
forall a. Maybe a
Nothing

        -- Check if a member access is to a callback field of a known object type.
        getCallbackSlot :: CExpression a -> Maybe CallbackSlot
getCallbackSlot (CMember CExpression a
structExpr (Ident String
fieldName Int
_ NodeInfo
_) Bool
_ a
_) =
            case CExpression a -> Maybe String
forall a. CExpression a -> Maybe String
getStructType CExpression a
structExpr of
                Just String
s  -> if Map String ObjectInfo -> String -> String -> Bool
isCallbackMember Map String ObjectInfo
objs String
s String
fieldName Bool -> Bool -> Bool
|| Map String ObjectInfo -> String -> String -> Bool
isUserdataMember Map String ObjectInfo
objs String
s String
fieldName
                           then CallbackSlot -> Maybe CallbackSlot
forall a. a -> Maybe a
Just (String -> String -> CallbackSlot
CallbackSlot String
s String
fieldName)
                           else Maybe CallbackSlot
forall a. Maybe a
Nothing
                Maybe String
Nothing -> Maybe CallbackSlot
forall a. Maybe a
Nothing
        getCallbackSlot (CIndex CExpression a
l CExpression a
_ a
_) = CExpression a -> Maybe CallbackSlot
getCallbackSlot CExpression a
l
        getCallbackSlot CExpression a
_ = Maybe CallbackSlot
forall a. Maybe a
Nothing

    in (CExpr -> Bool)
-> (CExpr -> Maybe CallbackSlot) -> Stmt -> Set CallbackSlot
isRegistryStat CExpr -> Bool
forall a. CExpression a -> Bool
isParam CExpr -> Maybe CallbackSlot
forall a. CExpression a -> Maybe CallbackSlot
getCallbackSlot Stmt
body
isRegistryBehavior Map String ObjectInfo
_ FunDef
_ = Set CallbackSlot
forall a. Set a
Set.empty


isRegistryStat :: (CExpr -> Bool) -> (CExpr -> Maybe CallbackSlot) -> CStat -> Set CallbackSlot
isRegistryStat :: (CExpr -> Bool)
-> (CExpr -> Maybe CallbackSlot) -> Stmt -> Set CallbackSlot
isRegistryStat CExpr -> Bool
isParam CExpr -> Maybe CallbackSlot
getSlot Stmt
stat = case Stmt
stat of
    CExpr (Just (CAssign CAssignOp
_ CExpr
l CExpr
r NodeInfo
_)) NodeInfo
_ ->
        if (CExpr -> Bool
isParam CExpr
r Bool -> Bool -> Bool
|| CExpr -> Bool
isNull CExpr
r)
        then case CExpr -> Maybe CallbackSlot
getSlot CExpr
l of
            Just CallbackSlot
s  -> CallbackSlot -> Set CallbackSlot
forall a. a -> Set a
Set.singleton CallbackSlot
s
            Maybe CallbackSlot
Nothing -> Set CallbackSlot
forall a. Set a
Set.empty
        else Set CallbackSlot
forall a. Set a
Set.empty
    CIf CExpr
_ Stmt
t Maybe Stmt
e NodeInfo
_ -> (CExpr -> Bool)
-> (CExpr -> Maybe CallbackSlot) -> Stmt -> Set CallbackSlot
isRegistryStat CExpr -> Bool
isParam CExpr -> Maybe CallbackSlot
getSlot Stmt
t Set CallbackSlot -> Set CallbackSlot -> Set CallbackSlot
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set CallbackSlot
-> (Stmt -> Set CallbackSlot) -> Maybe Stmt -> Set CallbackSlot
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set CallbackSlot
forall a. Set a
Set.empty ((CExpr -> Bool)
-> (CExpr -> Maybe CallbackSlot) -> Stmt -> Set CallbackSlot
isRegistryStat CExpr -> Bool
isParam CExpr -> Maybe CallbackSlot
getSlot) Maybe Stmt
e
    CFor Either (Maybe CExpr) (CDeclaration NodeInfo)
_ Maybe CExpr
_ Maybe CExpr
_ Stmt
s NodeInfo
_ -> (CExpr -> Bool)
-> (CExpr -> Maybe CallbackSlot) -> Stmt -> Set CallbackSlot
isRegistryStat CExpr -> Bool
isParam CExpr -> Maybe CallbackSlot
getSlot Stmt
s
    CWhile CExpr
_ Stmt
s Bool
_ NodeInfo
_ -> (CExpr -> Bool)
-> (CExpr -> Maybe CallbackSlot) -> Stmt -> Set CallbackSlot
isRegistryStat CExpr -> Bool
isParam CExpr -> Maybe CallbackSlot
getSlot Stmt
s
    CCompound [Ident]
_ [CCompoundBlockItem NodeInfo]
items NodeInfo
_ -> [Set CallbackSlot] -> Set CallbackSlot
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set CallbackSlot] -> Set CallbackSlot)
-> [Set CallbackSlot] -> Set CallbackSlot
forall a b. (a -> b) -> a -> b
$ (CCompoundBlockItem NodeInfo -> Set CallbackSlot)
-> [CCompoundBlockItem NodeInfo] -> [Set CallbackSlot]
forall a b. (a -> b) -> [a] -> [b]
map ((CExpr -> Bool)
-> (CExpr -> Maybe CallbackSlot)
-> CCompoundBlockItem NodeInfo
-> Set CallbackSlot
isRegistryItem CExpr -> Bool
isParam CExpr -> Maybe CallbackSlot
getSlot) [CCompoundBlockItem NodeInfo]
items
    Stmt
_ -> Set CallbackSlot
forall a. Set a
Set.empty
  where
    isRegistryItem :: (CExpr -> Bool)
-> (CExpr -> Maybe CallbackSlot)
-> CCompoundBlockItem NodeInfo
-> Set CallbackSlot
isRegistryItem CExpr -> Bool
p CExpr -> Maybe CallbackSlot
c (CBlockStmt Stmt
s) = (CExpr -> Bool)
-> (CExpr -> Maybe CallbackSlot) -> Stmt -> Set CallbackSlot
isRegistryStat CExpr -> Bool
p CExpr -> Maybe CallbackSlot
c Stmt
s
    isRegistryItem CExpr -> Bool
_ CExpr -> Maybe CallbackSlot
_ CCompoundBlockItem NodeInfo
_              = Set CallbackSlot
forall a. Set a
Set.empty



isNull :: CExpr -> Bool
isNull :: CExpr -> Bool
isNull (CVar (Ident String
n Int
_ NodeInfo
_) NodeInfo
_)                  = String
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"NULL" Bool -> Bool -> Bool
|| String
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"nullptr"
isNull (CConst (CIntConst (CInteger Integer
0 CIntRepr
_ Flags CIntFlag
_) NodeInfo
_)) = Bool
True
isNull CExpr
_                                       = Bool
False


countComplexity :: CStat -> Int
countComplexity :: Stmt -> Int
countComplexity (CCompound [Ident]
_ [CCompoundBlockItem NodeInfo]
items NodeInfo
_) = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (CCompoundBlockItem NodeInfo -> Int)
-> [CCompoundBlockItem NodeInfo] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map CCompoundBlockItem NodeInfo -> Int
forall a a. Num a => CCompoundBlockItem a -> a
countItem [CCompoundBlockItem NodeInfo]
items
  where
    countItem :: CCompoundBlockItem a -> a
countItem (CBlockStmt CStatement a
s) = CStatement a -> a
countStat CStatement a
s
    countItem (CBlockDecl CDeclaration a
_) = a
1
    countItem CCompoundBlockItem a
_              = a
0

    countStat :: CStatement a -> a
countStat (CCompound [Ident]
_ [CCompoundBlockItem a]
items' a
_) = [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ (CCompoundBlockItem a -> a) -> [CCompoundBlockItem a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map CCompoundBlockItem a -> a
countItem [CCompoundBlockItem a]
items'
    countStat (CIf CExpression a
_ CStatement a
t Maybe (CStatement a)
e a
_)          = a
1 a -> a -> a
forall a. Num a => a -> a -> a
+ CStatement a -> a
countStat CStatement a
t a -> a -> a
forall a. Num a => a -> a -> a
+ a -> (CStatement a -> a) -> Maybe (CStatement a) -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
0 CStatement a -> a
countStat Maybe (CStatement a)
e
    countStat (CFor Either (Maybe (CExpression a)) (CDeclaration a)
_ Maybe (CExpression a)
_ Maybe (CExpression a)
_ CStatement a
s a
_)       = a
1 a -> a -> a
forall a. Num a => a -> a -> a
+ CStatement a -> a
countStat CStatement a
s
    countStat (CWhile CExpression a
_ CStatement a
s Bool
_ a
_)       = a
1 a -> a -> a
forall a. Num a => a -> a -> a
+ CStatement a -> a
countStat CStatement a
s
    countStat (CExpr Maybe (CExpression a)
_ a
_)            = a
1
    countStat (CReturn Maybe (CExpression a)
_ a
_)          = a
1
    countStat CStatement a
_                      = a
1
countComplexity Stmt
_ = Int
1


isAllowedCall :: String -> Bool
isAllowedCall :: String -> Bool
isAllowedCall String
name = String
name String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"assert", String
"__assert_fail", String
"memcpy", String
"memset", String
"tox_lock", String
"tox_unlock", String
"pthread_mutex_lock", String
"pthread_mutex_unlock", String
"random_u64", String
"UINT32_C", String
"UINT16_C", String
"UINT8_C"]


checkCalls :: NodeInfo -> String -> CStat -> TravT Env Identity ()
checkCalls :: NodeInfo -> String -> Stmt -> TravT Env Identity ()
checkCalls NodeInfo
info String
funcName Stmt
stat = Stmt -> TravT Env Identity ()
checkStat Stmt
stat
  where
    checkStat :: Stmt -> TravT Env Identity ()
checkStat (CCompound [Ident]
_ [CCompoundBlockItem NodeInfo]
items NodeInfo
_) = (CCompoundBlockItem NodeInfo -> TravT Env Identity ())
-> [CCompoundBlockItem NodeInfo] -> TravT Env Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ CCompoundBlockItem NodeInfo -> TravT Env Identity ()
checkItem [CCompoundBlockItem NodeInfo]
items
    checkStat (CIf CExpr
_ Stmt
t Maybe Stmt
e NodeInfo
_)          = Stmt -> TravT Env Identity ()
checkStat Stmt
t TravT Env Identity ()
-> TravT Env Identity () -> TravT Env Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TravT Env Identity ()
-> (Stmt -> TravT Env Identity ())
-> Maybe Stmt
-> TravT Env Identity ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> TravT Env Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Stmt -> TravT Env Identity ()
checkStat Maybe Stmt
e
    checkStat (CFor Either (Maybe CExpr) (CDeclaration NodeInfo)
_ Maybe CExpr
_ Maybe CExpr
_ Stmt
s NodeInfo
_)       = Stmt -> TravT Env Identity ()
checkStat Stmt
s
    checkStat (CWhile CExpr
cond Stmt
s Bool
isDo NodeInfo
a) = do
        Bool -> TravT Env Identity () -> TravT Env Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CExpr -> Bool -> Bool
forall a. CExpression a -> Bool -> Bool
isAssertLoop CExpr
cond Bool
isDo) (TravT Env Identity () -> TravT Env Identity ())
-> TravT Env Identity () -> TravT Env Identity ()
forall a b. (a -> b) -> a -> b
$
            NodeInfo -> Doc AnsiStyle -> TravT Env Identity ()
recordLinterError NodeInfo
a (Doc AnsiStyle
"registry function" 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 String
funcName) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
"contains a loop")
        Stmt -> TravT Env Identity ()
checkStat Stmt
s
    checkStat (CExpr (Just CExpr
e) NodeInfo
_)     = CExpr -> TravT Env Identity ()
forall a. CExpression a -> TravT Env Identity ()
checkExpr CExpr
e
    checkStat Stmt
_                      = () -> TravT Env Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    isAssertLoop :: CExpression a -> Bool -> Bool
isAssertLoop CExpression a
cond Bool
True = CExpression a -> Bool
forall a. CExpression a -> Bool
isConstantZero CExpression a
cond
    isAssertLoop CExpression a
_ Bool
_       = Bool
False

    isConstantZero :: CExpression a -> Bool
isConstantZero (CConst (CIntConst (CInteger Integer
0 CIntRepr
_ Flags CIntFlag
_) a
_)) = Bool
True
    isConstantZero CExpression a
_                                       = Bool
False

    checkItem :: CCompoundBlockItem NodeInfo -> TravT Env Identity ()
checkItem (CBlockStmt Stmt
s) = Stmt -> TravT Env Identity ()
checkStat Stmt
s
    checkItem CCompoundBlockItem NodeInfo
_              = () -> TravT Env Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    checkExpr :: CExpression a -> TravT Env Identity ()
checkExpr (CCall (CVar (Ident String
name Int
_ NodeInfo
_) a
_) [CExpression a]
_ a
_) =
        Bool -> TravT Env Identity () -> TravT Env Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
isAllowedCall String
name) (TravT Env Identity () -> TravT Env Identity ())
-> TravT Env Identity () -> TravT Env Identity ()
forall a b. (a -> b) -> a -> b
$
            NodeInfo
-> DiagnosticLevel
-> Doc AnsiStyle
-> [DiagnosticSpan Position]
-> [(DiagnosticLevel, Doc AnsiStyle)]
-> TravT Env Identity ()
recordRichError NodeInfo
info DiagnosticLevel
ErrorLevel
                (Doc AnsiStyle
"registry function" 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 String
funcName) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
"calls non-trivial function" 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 String
name))
                []
                [(DiagnosticLevel
NoteLevel, Doc AnsiStyle
"registry functions should be side-effect free and remain simple")]
    checkExpr (CCond CExpression a
c Maybe (CExpression a)
t CExpression a
e a
_) = CExpression a -> TravT Env Identity ()
checkExpr CExpression a
c TravT Env Identity ()
-> TravT Env Identity () -> TravT Env Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TravT Env Identity ()
-> (CExpression a -> TravT Env Identity ())
-> Maybe (CExpression a)
-> TravT Env Identity ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> TravT Env Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) CExpression a -> TravT Env Identity ()
checkExpr Maybe (CExpression a)
t TravT Env Identity ()
-> TravT Env Identity () -> TravT Env Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CExpression a -> TravT Env Identity ()
checkExpr CExpression a
e
    checkExpr (CBinary CBinaryOp
_ CExpression a
l CExpression a
r a
_) = CExpression a -> TravT Env Identity ()
checkExpr CExpression a
l TravT Env Identity ()
-> TravT Env Identity () -> TravT Env Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CExpression a -> TravT Env Identity ()
checkExpr CExpression a
r
    checkExpr (CUnary CUnaryOp
_ CExpression a
e a
_) = CExpression a -> TravT Env Identity ()
checkExpr CExpression a
e
    checkExpr (CAssign CAssignOp
_ CExpression a
l CExpression a
r a
_) = CExpression a -> TravT Env Identity ()
checkExpr CExpression a
l TravT Env Identity ()
-> TravT Env Identity () -> TravT Env Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CExpression a -> TravT Env Identity ()
checkExpr CExpression a
r
    checkExpr CExpression a
_ = () -> TravT Env Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()


checkRegistrySideEffects :: Map.Map String ObjectInfo -> FunDef -> TravT Env Identity ()
checkRegistrySideEffects :: Map String ObjectInfo -> FunDef -> TravT Env Identity ()
checkRegistrySideEffects Map String ObjectInfo
objs (FunDef (VarDecl (VarName (Ident String
name Int
_ NodeInfo
_) Maybe AsmName
_) DeclAttrs
_ Type
_) Stmt
body NodeInfo
_) = do
    let
        -- Find all assignments.
        checkItem :: CCompoundBlockItem NodeInfo -> TravT Env Identity ()
checkItem (CBlockStmt Stmt
s) = Stmt -> TravT Env Identity ()
checkStat Stmt
s
        checkItem CCompoundBlockItem NodeInfo
_              = () -> TravT Env Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

        checkStat :: Stmt -> TravT Env Identity ()
checkStat (CCompound [Ident]
_ [CCompoundBlockItem NodeInfo]
items NodeInfo
_) = (CCompoundBlockItem NodeInfo -> TravT Env Identity ())
-> [CCompoundBlockItem NodeInfo] -> TravT Env Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ CCompoundBlockItem NodeInfo -> TravT Env Identity ()
checkItem [CCompoundBlockItem NodeInfo]
items
        checkStat (CIf CExpr
_ Stmt
t Maybe Stmt
e NodeInfo
_)          = Stmt -> TravT Env Identity ()
checkStat Stmt
t TravT Env Identity ()
-> TravT Env Identity () -> TravT Env Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TravT Env Identity ()
-> (Stmt -> TravT Env Identity ())
-> Maybe Stmt
-> TravT Env Identity ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> TravT Env Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Stmt -> TravT Env Identity ()
checkStat Maybe Stmt
e
        checkStat (CFor Either (Maybe CExpr) (CDeclaration NodeInfo)
_ Maybe CExpr
_ Maybe CExpr
_ Stmt
s NodeInfo
_)       = Stmt -> TravT Env Identity ()
checkStat Stmt
s
        checkStat (CWhile CExpr
_ Stmt
s Bool
_ NodeInfo
_)       = Stmt -> TravT Env Identity ()
checkStat Stmt
s
        checkStat (CExpr (Just (CAssign CAssignOp
_ CExpr
l CExpr
_ NodeInfo
_)) NodeInfo
_) = CExpr -> TravT Env Identity ()
checkLHS CExpr
l
        checkStat Stmt
_                      = () -> TravT Env Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

        checkLHS :: CExpr -> TravT Env Identity ()
checkLHS CExpr
expr = case CExpr
expr of
            CMember CExpr
structExpr (Ident String
fieldName Int
_ NodeInfo
_) Bool
_ NodeInfo
_ -> do
                Type
ty <- [StmtCtx] -> ExprSide -> CExpr -> TravT Env Identity Type
forall (m :: * -> *).
MonadTrav m =>
[StmtCtx] -> ExprSide -> CExpr -> m Type
tExpr [] ExprSide
RValue CExpr
structExpr
                case Type -> Type
canonicalType Type
ty of
                    PtrType (DirectType (TyComp (CompTypeRef (NamedRef (Ident String
s Int
_ NodeInfo
_)) CompTyKind
_ NodeInfo
_)) TypeQuals
_ Attributes
_) TypeQuals
_ Attributes
_ ->
                        Bool -> TravT Env Identity () -> TravT Env Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Map String ObjectInfo -> String -> String -> Bool
isCallbackMember Map String ObjectInfo
objs String
s String
fieldName Bool -> Bool -> Bool
|| Map String ObjectInfo -> String -> String -> Bool
isUserdataMember Map String ObjectInfo
objs String
s String
fieldName) (TravT Env Identity () -> TravT Env Identity ())
-> TravT Env Identity () -> TravT Env Identity ()
forall a b. (a -> b) -> a -> b
$
                            CExpr -> TravT Env Identity ()
forall (ast :: * -> *).
(Annotated ast, Pretty (ast NodeInfo)) =>
ast NodeInfo -> TravT Env Identity ()
recordError CExpr
expr
                    DirectType (TyComp (CompTypeRef (NamedRef (Ident String
s Int
_ NodeInfo
_)) CompTyKind
_ NodeInfo
_)) TypeQuals
_ Attributes
_ ->
                        Bool -> TravT Env Identity () -> TravT Env Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Map String ObjectInfo -> String -> String -> Bool
isCallbackMember Map String ObjectInfo
objs String
s String
fieldName Bool -> Bool -> Bool
|| Map String ObjectInfo -> String -> String -> Bool
isUserdataMember Map String ObjectInfo
objs String
s String
fieldName) (TravT Env Identity () -> TravT Env Identity ())
-> TravT Env Identity () -> TravT Env Identity ()
forall a b. (a -> b) -> a -> b
$
                            CExpr -> TravT Env Identity ()
forall (ast :: * -> *).
(Annotated ast, Pretty (ast NodeInfo)) =>
ast NodeInfo -> TravT Env Identity ()
recordError CExpr
expr
                    Type
_ -> () -> TravT Env Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            CIndex CExpr
l CExpr
_ NodeInfo
_ -> CExpr -> TravT Env Identity ()
checkLHS CExpr
l
            CExpr
_ -> () -> TravT Env Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

        recordError :: ast NodeInfo -> TravT Env Identity ()
recordError ast NodeInfo
l =
            NodeInfo
-> DiagnosticLevel
-> Doc AnsiStyle
-> [DiagnosticSpan Position]
-> [(DiagnosticLevel, Doc AnsiStyle)]
-> TravT Env Identity ()
recordRichError (ast NodeInfo -> NodeInfo
forall (ast :: * -> *) a. Annotated ast => ast a -> a
annotation ast NodeInfo
l) DiagnosticLevel
ErrorLevel
                (Doc AnsiStyle
"registry function" 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 String
name) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
"mutates non-callback field" 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 (ast NodeInfo -> Doc
forall p. Pretty p => p -> Doc
C.pretty ast NodeInfo
l))))
                []
                [(DiagnosticLevel
NoteLevel, Doc AnsiStyle
"registry functions should only set callbacks and their associated userdata")]

    Stmt -> TravT Env Identity ()
checkStat Stmt
body
checkRegistrySideEffects Map String ObjectInfo
_ FunDef
_ = () -> TravT Env Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()


checkCallbackMutation :: Map.Map String ObjectInfo -> Map.Map CallbackSlot (Set String) -> CExpr -> TravT Env Identity ()
checkCallbackMutation :: Map String ObjectInfo
-> Map CallbackSlot (Set String) -> CExpr -> TravT Env Identity ()
checkCallbackMutation Map String ObjectInfo
objs Map CallbackSlot (Set String)
registryMap CExpr
expr = do
    Maybe CallbackSlot
mSlot <- CExpr -> TravT Env Identity (Maybe CallbackSlot)
forall (m :: * -> *).
MonadTrav m =>
CExpr -> m (Maybe CallbackSlot)
getCallbackSlot CExpr
expr
    case Maybe CallbackSlot
mSlot of
        Maybe CallbackSlot
Nothing -> () -> TravT Env Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just CallbackSlot
slot -> do
            [String]
ctx <- Trav Env [String]
Env.getCtx
            let currentFunc :: String
currentFunc = case [ String
f | String
f <- [String]
ctx, String
"func:" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
f ] of
                    (String
f:[String]
_) -> Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
5 String
f
                    []    -> String
""

            let allowed :: Set String
allowed = Set String
-> CallbackSlot -> Map CallbackSlot (Set String) -> Set String
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Set String
forall a. Set a
Set.empty CallbackSlot
slot Map CallbackSlot (Set String)
registryMap

            Bool -> TravT Env Identity () -> TravT Env Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String
currentFunc String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set String
allowed Bool -> Bool -> Bool
|| String -> Bool
isConstructor String
currentFunc Bool -> Bool -> Bool
|| String -> Bool
isDestructor String
currentFunc) (TravT Env Identity () -> TravT Env Identity ())
-> TravT Env Identity () -> TravT Env Identity ()
forall a b. (a -> b) -> a -> b
$ do
                let msg :: Doc ann
msg = Doc ann
"mutation of callback/userdata field" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
backticks (String -> Doc ann
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
expr))) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"outside of a registry function"
                let footers :: [(DiagnosticLevel, Doc ann)]
footers = if Set String -> Bool
forall a. Set a -> Bool
Set.null Set String
allowed
                              then []
                              else [(DiagnosticLevel
HelpLevel, Doc ann
"use one of these registry functions instead:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " (Set String -> [String]
forall a. Set a -> [a]
Set.toList Set String
allowed)))]
                NodeInfo
-> DiagnosticLevel
-> Doc AnsiStyle
-> [DiagnosticSpan Position]
-> [(DiagnosticLevel, Doc AnsiStyle)]
-> TravT Env Identity ()
recordRichError (CExpr -> NodeInfo
forall (ast :: * -> *) a. Annotated ast => ast a -> a
annotation CExpr
expr) DiagnosticLevel
ErrorLevel Doc AnsiStyle
forall ann. Doc ann
msg [] [(DiagnosticLevel, Doc AnsiStyle)]
forall ann. [(DiagnosticLevel, Doc ann)]
footers
  where
    isConstructor :: String -> Bool
isConstructor String
f = String
"_new" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
f Bool -> Bool -> Bool
|| String
"new_" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
f
    isDestructor :: String -> Bool
isDestructor String
f  = String
"_kill" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
f Bool -> Bool -> Bool
|| String
"kill_" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
f

    getCallbackSlot :: CExpr -> m (Maybe CallbackSlot)
getCallbackSlot (CMember CExpr
structExpr (Ident String
fieldName Int
_ NodeInfo
_) Bool
_ NodeInfo
_) = do
        Type
ty' <- [StmtCtx] -> ExprSide -> CExpr -> m Type
forall (m :: * -> *).
MonadTrav m =>
[StmtCtx] -> ExprSide -> CExpr -> m Type
tExpr [] ExprSide
RValue CExpr
structExpr
        case Type -> Type
canonicalType Type
ty' of
            PtrType (DirectType (TyComp (CompTypeRef (NamedRef (Ident String
s Int
_ NodeInfo
_)) CompTyKind
_ NodeInfo
_)) TypeQuals
_ Attributes
_) TypeQuals
_ Attributes
_ ->
                Maybe CallbackSlot -> m (Maybe CallbackSlot)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe CallbackSlot -> m (Maybe CallbackSlot))
-> Maybe CallbackSlot -> m (Maybe CallbackSlot)
forall a b. (a -> b) -> a -> b
$ if Map String ObjectInfo -> String -> String -> Bool
isCallbackMember Map String ObjectInfo
objs String
s String
fieldName Bool -> Bool -> Bool
|| Map String ObjectInfo -> String -> String -> Bool
isUserdataMember Map String ObjectInfo
objs String
s String
fieldName
                         then CallbackSlot -> Maybe CallbackSlot
forall a. a -> Maybe a
Just (String -> String -> CallbackSlot
CallbackSlot String
s String
fieldName)
                         else Maybe CallbackSlot
forall a. Maybe a
Nothing
            DirectType (TyComp (CompTypeRef (NamedRef (Ident String
s Int
_ NodeInfo
_)) CompTyKind
_ NodeInfo
_)) TypeQuals
_ Attributes
_ ->
                Maybe CallbackSlot -> m (Maybe CallbackSlot)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe CallbackSlot -> m (Maybe CallbackSlot))
-> Maybe CallbackSlot -> m (Maybe CallbackSlot)
forall a b. (a -> b) -> a -> b
$ if Map String ObjectInfo -> String -> String -> Bool
isCallbackMember Map String ObjectInfo
objs String
s String
fieldName Bool -> Bool -> Bool
|| Map String ObjectInfo -> String -> String -> Bool
isUserdataMember Map String ObjectInfo
objs String
s String
fieldName
                         then CallbackSlot -> Maybe CallbackSlot
forall a. a -> Maybe a
Just (String -> String -> CallbackSlot
CallbackSlot String
s String
fieldName)
                         else Maybe CallbackSlot
forall a. Maybe a
Nothing
            Type
_ -> Maybe CallbackSlot -> m (Maybe CallbackSlot)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CallbackSlot
forall a. Maybe a
Nothing
    getCallbackSlot (CIndex CExpr
l CExpr
_ NodeInfo
_) = CExpr -> m (Maybe CallbackSlot)
getCallbackSlot CExpr
l
    getCallbackSlot CExpr
_ = Maybe CallbackSlot -> m (Maybe CallbackSlot)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CallbackSlot
forall a. Maybe a
Nothing


linter :: Map.Map String ObjectInfo -> Map.Map CallbackSlot (Set String) -> Set String -> AstActions (TravT Env Identity)
linter :: Map String ObjectInfo
-> Map CallbackSlot (Set String)
-> Set String
-> AstActions (TravT Env Identity)
linter Map String ObjectInfo
objs Map CallbackSlot (Set String)
registryMap Set String
registries = AstActions (TravT Env Identity)
forall (f :: * -> *). Applicative f => AstActions f
astActions
    { doIdentDecl :: IdentDecl -> TravT Env Identity () -> TravT Env Identity ()
doIdentDecl = \IdentDecl
node TravT Env Identity ()
act -> case IdentDecl
node of
        FunctionDef f :: FunDef
f@(FunDef (VarDecl (VarName (Ident String
name Int
_ NodeInfo
_) Maybe AsmName
_) DeclAttrs
_ Type
_) Stmt
body NodeInfo
_) -> do
            let isRegistry :: Bool
isRegistry = String
name String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set String
registries
            Bool -> TravT Env Identity () -> TravT Env Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isRegistry (TravT Env Identity () -> TravT Env Identity ())
-> TravT Env Identity () -> TravT Env Identity ()
forall a b. (a -> b) -> a -> b
$ do
                let complexity :: Int
complexity = Stmt -> Int
countComplexity Stmt
body
                Bool -> TravT Env Identity () -> TravT Env Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
complexity Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
20) (TravT Env Identity () -> TravT Env Identity ())
-> TravT Env Identity () -> TravT Env Identity ()
forall a b. (a -> b) -> a -> b
$
                    NodeInfo -> Doc AnsiStyle -> TravT Env Identity ()
recordLinterError (Stmt -> NodeInfo
forall (ast :: * -> *) a. Annotated ast => ast a -> a
annotation Stmt
body) (Doc AnsiStyle -> TravT Env Identity ())
-> Doc AnsiStyle -> TravT Env Identity ()
forall a b. (a -> b) -> a -> b
$
                        Doc AnsiStyle
"registry function" 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 String
name) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
"is too complex (" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Int -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty Int
complexity Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
"statements)"

                NodeInfo -> String -> Stmt -> TravT Env Identity ()
checkCalls (Stmt -> NodeInfo
forall (ast :: * -> *) a. Annotated ast => ast a -> a
annotation Stmt
body) String
name Stmt
body
                Map String ObjectInfo -> FunDef -> TravT Env Identity ()
checkRegistrySideEffects Map String ObjectInfo
objs FunDef
f

            String -> TravT Env Identity ()
Env.pushCtx (String -> TravT Env Identity ())
-> String -> TravT Env Identity ()
forall a b. (a -> b) -> a -> b
$ String
"func:" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
name
            TravT Env Identity ()
act
            TravT Env Identity ()
Env.popCtx
        IdentDecl
_ -> TravT Env Identity ()
act

    , doExpr :: CExpr -> TravT Env Identity () -> TravT Env Identity ()
doExpr = \CExpr
node TravT Env Identity ()
act -> case CExpr
node of
        CAssign CAssignOp
_ CExpr
l CExpr
_ NodeInfo
_ -> do
            Map String ObjectInfo
-> Map CallbackSlot (Set String) -> CExpr -> TravT Env Identity ()
checkCallbackMutation Map String ObjectInfo
objs Map CallbackSlot (Set String)
registryMap CExpr
l
            TravT Env Identity ()
act
        CExpr
_ -> TravT Env Identity ()
act
    }


collectRegistries :: Map.Map String ObjectInfo -> GlobalDecls -> Map.Map CallbackSlot (Set String)
collectRegistries :: Map String ObjectInfo
-> GlobalDecls -> Map CallbackSlot (Set String)
collectRegistries Map String ObjectInfo
objs (GlobalDecls Map Ident IdentDecl
objs' Map SUERef TagDef
_ Map Ident TypeDef
_) =
    (Set String -> Set String -> Set String)
-> [Map CallbackSlot (Set String)] -> Map CallbackSlot (Set String)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith Set String -> Set String -> Set String
forall a. Ord a => Set a -> Set a -> Set a
Set.union ([Map CallbackSlot (Set String)] -> Map CallbackSlot (Set String))
-> (Map Ident IdentDecl -> [Map CallbackSlot (Set String)])
-> Map Ident IdentDecl
-> Map CallbackSlot (Set String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IdentDecl -> Maybe (Map CallbackSlot (Set String)))
-> [IdentDecl] -> [Map CallbackSlot (Set String)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe IdentDecl -> Maybe (Map CallbackSlot (Set String))
isReg ([IdentDecl] -> [Map CallbackSlot (Set String)])
-> (Map Ident IdentDecl -> [IdentDecl])
-> Map Ident IdentDecl
-> [Map CallbackSlot (Set String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Ident IdentDecl -> [IdentDecl]
forall k a. Map k a -> [a]
Map.elems (Map Ident IdentDecl -> Map CallbackSlot (Set String))
-> Map Ident IdentDecl -> Map CallbackSlot (Set String)
forall a b. (a -> b) -> a -> b
$ Map Ident IdentDecl
objs'
  where
    isReg :: IdentDecl -> Maybe (Map CallbackSlot (Set String))
isReg (FunctionDef f :: FunDef
f@(FunDef (VarDecl (VarName (Ident String
name Int
_ NodeInfo
_) Maybe AsmName
_) DeclAttrs
_ Type
_) Stmt
_ NodeInfo
_)) =
        let slots :: Set CallbackSlot
slots = Map String ObjectInfo -> FunDef -> Set CallbackSlot
isRegistryBehavior Map String ObjectInfo
objs FunDef
f
        in if Set CallbackSlot -> Bool
forall a. Set a -> Bool
Set.null Set CallbackSlot
slots
           then Maybe (Map CallbackSlot (Set String))
forall a. Maybe a
Nothing
           else Map CallbackSlot (Set String)
-> Maybe (Map CallbackSlot (Set String))
forall a. a -> Maybe a
Just (Map CallbackSlot (Set String)
 -> Maybe (Map CallbackSlot (Set String)))
-> Map CallbackSlot (Set String)
-> Maybe (Map CallbackSlot (Set String))
forall a b. (a -> b) -> a -> b
$ [(CallbackSlot, Set String)] -> Map CallbackSlot (Set String)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (CallbackSlot
s, String -> Set String
forall a. a -> Set a
Set.singleton String
name) | CallbackSlot
s <- Set CallbackSlot -> [CallbackSlot]
forall a. Set a -> [a]
Set.toList Set CallbackSlot
slots ]
    isReg IdentDecl
_ = Maybe (Map CallbackSlot (Set String))
forall a. Maybe a
Nothing


analyse :: GlobalDecls -> Trav Env ()
analyse :: GlobalDecls -> TravT Env Identity ()
analyse GlobalDecls
decls = do
    let objs :: Map String ObjectInfo
objs = GlobalDecls -> Map String ObjectInfo
discoverObjectTypes GlobalDecls
decls
    let registryMap :: Map CallbackSlot (Set String)
registryMap = Map String ObjectInfo
-> GlobalDecls -> Map CallbackSlot (Set String)
collectRegistries Map String ObjectInfo
objs GlobalDecls
decls
    let registries :: Set String
registries = [Set String] -> Set String
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set String] -> Set String) -> [Set String] -> Set String
forall a b. (a -> b) -> a -> b
$ Map CallbackSlot (Set String) -> [Set String]
forall k a. Map k a -> [a]
Map.elems Map CallbackSlot (Set String)
registryMap
    AstActions (TravT Env Identity)
-> GlobalDecls -> TravT Env Identity ()
forall a (f :: * -> *).
(TraverseAst a, Applicative f) =>
AstActions f -> a -> f ()
traverseAst (Map String ObjectInfo
-> Map CallbackSlot (Set String)
-> Set String
-> AstActions (TravT Env Identity)
linter Map String ObjectInfo
objs Map CallbackSlot (Set String)
registryMap Set String
registries) GlobalDecls
decls


descr :: (GlobalDecls -> Trav Env (), (Text, Text))
descr :: (GlobalDecls -> TravT Env Identity (), (Text, Text))
descr = (GlobalDecls -> TravT Env Identity ()
analyse, (Text
"callback-discipline", [Text] -> Text
Text.unlines
    [ Text
"Ensures callback discipline is followed."
    , Text
""
    , Text
"Callback and userdata fields should only be mutated within registry"
    , Text
"functions (functions that simply assign a parameter to a callback field)."
    , Text
"Registry functions themselves must remain simple and side-effect free."
    ]))