{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiWayIf            #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE Strict                #-}
{-# LANGUAGE TupleSections         #-}
{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
module Tokstyle.Linter.Nullability (descr) where

import           Control.Monad               (forM_)
import           Control.Monad.State.Strict  (State)
import qualified Control.Monad.State.Strict  as State
import           Data.Fix                    (Fix (..))
import           Data.Foldable               (traverse_)
import           Data.Map.Strict             (Map)
import qualified Data.Map.Strict             as Map
import           Data.Set                    (Set)
import qualified Data.Set                    as Set
import           Data.Text                   (Text)
import qualified Data.Text                   as Text
import           Language.Cimple             (BinaryOp (..), Lexeme (..), Node,
                                              UnaryOp (..))
import qualified Language.Cimple             as C
import           Language.Cimple.Diagnostics (warn)
import           Language.Cimple.TraverseAst (AstActions, astActions, doNode,
                                              traverseAst)

data Nullability
    = NullableVar
    | NonNullVar
    deriving (Int -> Nullability -> ShowS
[Nullability] -> ShowS
Nullability -> String
(Int -> Nullability -> ShowS)
-> (Nullability -> String)
-> ([Nullability] -> ShowS)
-> Show Nullability
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Nullability] -> ShowS
$cshowList :: [Nullability] -> ShowS
show :: Nullability -> String
$cshow :: Nullability -> String
showsPrec :: Int -> Nullability -> ShowS
$cshowsPrec :: Int -> Nullability -> ShowS
Show, Nullability -> Nullability -> Bool
(Nullability -> Nullability -> Bool)
-> (Nullability -> Nullability -> Bool) -> Eq Nullability
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Nullability -> Nullability -> Bool
$c/= :: Nullability -> Nullability -> Bool
== :: Nullability -> Nullability -> Bool
$c== :: Nullability -> Nullability -> Bool
Eq, Eq Nullability
Eq Nullability
-> (Nullability -> Nullability -> Ordering)
-> (Nullability -> Nullability -> Bool)
-> (Nullability -> Nullability -> Bool)
-> (Nullability -> Nullability -> Bool)
-> (Nullability -> Nullability -> Bool)
-> (Nullability -> Nullability -> Nullability)
-> (Nullability -> Nullability -> Nullability)
-> Ord Nullability
Nullability -> Nullability -> Bool
Nullability -> Nullability -> Ordering
Nullability -> Nullability -> Nullability
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Nullability -> Nullability -> Nullability
$cmin :: Nullability -> Nullability -> Nullability
max :: Nullability -> Nullability -> Nullability
$cmax :: Nullability -> Nullability -> Nullability
>= :: Nullability -> Nullability -> Bool
$c>= :: Nullability -> Nullability -> Bool
> :: Nullability -> Nullability -> Bool
$c> :: Nullability -> Nullability -> Bool
<= :: Nullability -> Nullability -> Bool
$c<= :: Nullability -> Nullability -> Bool
< :: Nullability -> Nullability -> Bool
$c< :: Nullability -> Nullability -> Bool
compare :: Nullability -> Nullability -> Ordering
$ccompare :: Nullability -> Nullability -> Ordering
$cp1Ord :: Eq Nullability
Ord)

type VarInfo = (Nullability, Maybe (Node (Lexeme Text)))

type TypeEnv = Map Text VarInfo

data LinterState = LinterState
    { LinterState -> TypeEnv
typeEnv     :: TypeEnv
    , LinterState -> Map Text TypeEnv
structDefs  :: Map Text TypeEnv
    , LinterState -> Set Text
nonNullSet  :: Set Text
    , LinterState -> String
currentFile :: FilePath
    }

type LinterM = State.StateT LinterState (State [Text])

isNullable :: Node (Lexeme Text) -> Bool
isNullable :: Node (Lexeme Text) -> Bool
isNullable = \case
    Fix (C.TyNullable Node (Lexeme Text)
_) -> Bool
True
    Fix (C.TyPointer Node (Lexeme Text)
t)  -> Node (Lexeme Text) -> Bool
isNullable Node (Lexeme Text)
t
    Fix (C.TyConst Node (Lexeme Text)
t)    -> Node (Lexeme Text) -> Bool
isNullable Node (Lexeme Text)
t
    Node (Lexeme Text)
_                    -> Bool
False

isNonnull :: Node (Lexeme Text) -> Bool
isNonnull :: Node (Lexeme Text) -> Bool
isNonnull = \case
    Fix (C.TyNonnull Node (Lexeme Text)
_) -> Bool
True
    Fix (C.TyPointer Node (Lexeme Text)
t) -> Node (Lexeme Text) -> Bool
isNonnull Node (Lexeme Text)
t
    Fix (C.TyConst Node (Lexeme Text)
t)   -> Node (Lexeme Text) -> Bool
isNonnull Node (Lexeme Text)
t
    Node (Lexeme Text)
_                   -> Bool
False

exprToText :: Node (Lexeme Text) -> Maybe Text
exprToText :: Node (Lexeme Text) -> Maybe Text
exprToText (Fix NodeF (Lexeme Text) (Node (Lexeme Text))
node) = case NodeF (Lexeme Text) (Node (Lexeme Text))
node of
    C.VarExpr (C.L AlexPosn
_ LexemeClass
_ Text
name) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name
    C.PointerAccess Node (Lexeme Text)
e (C.L AlexPosn
_ LexemeClass
_ Text
member) -> do
        Text
base <- Node (Lexeme Text) -> Maybe Text
exprToText Node (Lexeme Text)
e
        Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
base Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"->" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
member
    C.MemberAccess Node (Lexeme Text)
e (C.L AlexPosn
_ LexemeClass
_ Text
member) -> do
        Text
base <- Node (Lexeme Text) -> Maybe Text
exprToText Node (Lexeme Text)
e
        Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
base Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
member
    C.UnaryExpr UnaryOp
C.UopDeref Node (Lexeme Text)
e -> do
        Text
base <- Node (Lexeme Text) -> Maybe Text
exprToText Node (Lexeme Text)
e
        Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
"*" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
base
    C.ParenExpr Node (Lexeme Text)
e -> Node (Lexeme Text) -> Maybe Text
exprToText Node (Lexeme Text)
e
    NodeF (Lexeme Text) (Node (Lexeme Text))
_ -> Maybe Text
forall a. Maybe a
Nothing

getParamTypes :: Node (Lexeme Text) -> TypeEnv
getParamTypes :: Node (Lexeme Text) -> TypeEnv
getParamTypes (Fix (C.FunctionPrototype Node (Lexeme Text)
_ Lexeme Text
_ [Node (Lexeme Text)]
params)) = [(Text, (Nullability, Maybe (Node (Lexeme Text))))] -> TypeEnv
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, (Nullability, Maybe (Node (Lexeme Text))))] -> TypeEnv)
-> ([Node (Lexeme Text)]
    -> [(Text, (Nullability, Maybe (Node (Lexeme Text))))])
-> [Node (Lexeme Text)]
-> TypeEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node (Lexeme Text)
 -> [(Text, (Nullability, Maybe (Node (Lexeme Text))))])
-> [Node (Lexeme Text)]
-> [(Text, (Nullability, Maybe (Node (Lexeme Text))))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Node (Lexeme Text)
-> [(Text, (Nullability, Maybe (Node (Lexeme Text))))]
getVarDecls ([Node (Lexeme Text)] -> TypeEnv)
-> [Node (Lexeme Text)] -> TypeEnv
forall a b. (a -> b) -> a -> b
$ [Node (Lexeme Text)]
params
  where
    getVarDecls :: Node (Lexeme Text)
-> [(Text, (Nullability, Maybe (Node (Lexeme Text))))]
getVarDecls (Fix (C.VarDecl Node (Lexeme Text)
ty (C.L AlexPosn
_ LexemeClass
_ Text
name) [Node (Lexeme Text)]
_)) =
        let nullability :: Nullability
nullability = if Node (Lexeme Text) -> Bool
isNullable Node (Lexeme Text)
ty then Nullability
NullableVar else Nullability
NonNullVar
        in [(Text
name, (Nullability
nullability, Node (Lexeme Text) -> Maybe (Node (Lexeme Text))
forall a. a -> Maybe a
Just Node (Lexeme Text)
ty))]
    getVarDecls Node (Lexeme Text)
_ = []
getParamTypes Node (Lexeme Text)
_ = TypeEnv
forall k a. Map k a
Map.empty

getStructName :: Node (Lexeme Text) -> Maybe Text
getStructName :: Node (Lexeme Text) -> Maybe Text
getStructName (Fix NodeF (Lexeme Text) (Node (Lexeme Text))
node) = case NodeF (Lexeme Text) (Node (Lexeme Text))
node of
    C.TyPointer Node (Lexeme Text)
t                  -> Node (Lexeme Text) -> Maybe Text
getStructName Node (Lexeme Text)
t
    C.TyConst Node (Lexeme Text)
t                    -> Node (Lexeme Text) -> Maybe Text
getStructName Node (Lexeme Text)
t
    C.TyNonnull Node (Lexeme Text)
t                  -> Node (Lexeme Text) -> Maybe Text
getStructName Node (Lexeme Text)
t
    C.TyStruct (C.L AlexPosn
_ LexemeClass
_ Text
name)      -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name
    C.TyUserDefined (C.L AlexPosn
_ LexemeClass
_ Text
name) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name
    NodeF (Lexeme Text) (Node (Lexeme Text))
_                              -> Maybe Text
forall a. Maybe a
Nothing

getNullability :: Text -> LinterState -> Maybe Nullability
getNullability :: Text -> LinterState -> Maybe Nullability
getNullability Text
name LinterState
st =
    case Text -> Text -> [Text]
Text.splitOn Text
"->" Text
name of
        [Text
var] -> (Nullability, Maybe (Node (Lexeme Text))) -> Nullability
forall a b. (a, b) -> a
fst ((Nullability, Maybe (Node (Lexeme Text))) -> Nullability)
-> Maybe (Nullability, Maybe (Node (Lexeme Text)))
-> Maybe Nullability
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> TypeEnv -> Maybe (Nullability, Maybe (Node (Lexeme Text)))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
var (LinterState -> TypeEnv
typeEnv LinterState
st)
        [Text
base, Text
member] -> do
            (Nullability
_, Maybe (Node (Lexeme Text))
baseTypeM) <- Text -> TypeEnv -> Maybe (Nullability, Maybe (Node (Lexeme Text)))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
base (LinterState -> TypeEnv
typeEnv LinterState
st)
            Node (Lexeme Text)
baseType <- Maybe (Node (Lexeme Text))
baseTypeM
            Text
structName <- Node (Lexeme Text) -> Maybe Text
getStructName Node (Lexeme Text)
baseType
            TypeEnv
structDef <- Text -> Map Text TypeEnv -> Maybe TypeEnv
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
structName (LinterState -> Map Text TypeEnv
structDefs LinterState
st)
            (Nullability
memberNullability, Maybe (Node (Lexeme Text))
_) <- Text -> TypeEnv -> Maybe (Nullability, Maybe (Node (Lexeme Text)))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
member TypeEnv
structDef
            Nullability -> Maybe Nullability
forall a. a -> Maybe a
Just Nullability
memberNullability
        [Text]
_ -> Maybe Nullability
forall a. Maybe a
Nothing

isExprNonNull :: Node (Lexeme Text) -> LinterM Bool
isExprNonNull :: Node (Lexeme Text) -> LinterM Bool
isExprNonNull (Fix NodeF (Lexeme Text) (Node (Lexeme Text))
node) = case NodeF (Lexeme Text) (Node (Lexeme Text))
node of
    C.UnaryExpr UnaryOp
C.UopAddress Node (Lexeme Text)
_ -> Bool -> LinterM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    NodeF (Lexeme Text) (Node (Lexeme Text))
_ -> do
        LinterState
st <- StateT LinterState (State [Text]) LinterState
forall s (m :: * -> *). MonadState s m => m s
State.get
        case Node (Lexeme Text) -> Maybe Text
exprToText (NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix NodeF (Lexeme Text) (Node (Lexeme Text))
node) of
            Just Text
name -> Bool -> LinterM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> LinterM Bool) -> Bool -> LinterM Bool
forall a b. (a -> b) -> a -> b
$ Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Text
name (LinterState -> Set Text
nonNullSet LinterState
st) Bool -> Bool -> Bool
|| Text -> LinterState -> Maybe Nullability
getNullability Text
name LinterState
st Maybe Nullability -> Maybe Nullability -> Bool
forall a. Eq a => a -> a -> Bool
== Nullability -> Maybe Nullability
forall a. a -> Maybe a
Just Nullability
NonNullVar
            Maybe Text
Nothing   -> Bool -> LinterM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

checkCondition :: Node (Lexeme Text) -> (Set Text, Set Text)
checkCondition :: Node (Lexeme Text) -> (Set Text, Set Text)
checkCondition Node (Lexeme Text)
e = Node (Lexeme Text) -> (Set Text, Set Text)
go Node (Lexeme Text)
e
  where
    go :: Node (Lexeme Text) -> (Set Text, Set Text)
go n :: Node (Lexeme Text)
n@(Fix NodeF (Lexeme Text) (Node (Lexeme Text))
node) = case NodeF (Lexeme Text) (Node (Lexeme Text))
node of
        C.BinaryExpr Node (Lexeme Text)
lhs BinaryOp
BopNe (Fix (C.LiteralExpr LiteralType
C.ConstId (C.L AlexPosn
_ LexemeClass
_ Text
"NULL"))) ->
            (Maybe Text -> Set Text
forall a. Maybe a -> Set a
fromText (Maybe Text -> Set Text) -> Maybe Text -> Set Text
forall a b. (a -> b) -> a -> b
$ Node (Lexeme Text) -> Maybe Text
exprToText Node (Lexeme Text)
lhs, Set Text
forall a. Set a
Set.empty)
        C.BinaryExpr (Fix (C.LiteralExpr LiteralType
C.ConstId (C.L AlexPosn
_ LexemeClass
_ Text
"NULL"))) BinaryOp
BopNe Node (Lexeme Text)
rhs ->
            (Maybe Text -> Set Text
forall a. Maybe a -> Set a
fromText (Maybe Text -> Set Text) -> Maybe Text -> Set Text
forall a b. (a -> b) -> a -> b
$ Node (Lexeme Text) -> Maybe Text
exprToText Node (Lexeme Text)
rhs, Set Text
forall a. Set a
Set.empty)
        C.BinaryExpr Node (Lexeme Text)
lhs BinaryOp
BopEq (Fix (C.LiteralExpr LiteralType
C.ConstId (C.L AlexPosn
_ LexemeClass
_ Text
"NULL"))) ->
            (Set Text
forall a. Set a
Set.empty, Maybe Text -> Set Text
forall a. Maybe a -> Set a
fromText (Maybe Text -> Set Text) -> Maybe Text -> Set Text
forall a b. (a -> b) -> a -> b
$ Node (Lexeme Text) -> Maybe Text
exprToText Node (Lexeme Text)
lhs)
        C.BinaryExpr (Fix (C.LiteralExpr LiteralType
C.ConstId (C.L AlexPosn
_ LexemeClass
_ Text
"NULL"))) BinaryOp
BopEq Node (Lexeme Text)
rhs ->
            (Set Text
forall a. Set a
Set.empty, Maybe Text -> Set Text
forall a. Maybe a -> Set a
fromText (Maybe Text -> Set Text) -> Maybe Text -> Set Text
forall a b. (a -> b) -> a -> b
$ Node (Lexeme Text) -> Maybe Text
exprToText Node (Lexeme Text)
rhs)
        C.BinaryExpr Node (Lexeme Text)
lhs BinaryOp
BopNe (Fix (C.LiteralExpr LiteralType
_ (C.L AlexPosn
_ LexemeClass
_ Text
"nullptr"))) ->
            (Maybe Text -> Set Text
forall a. Maybe a -> Set a
fromText (Maybe Text -> Set Text) -> Maybe Text -> Set Text
forall a b. (a -> b) -> a -> b
$ Node (Lexeme Text) -> Maybe Text
exprToText Node (Lexeme Text)
lhs, Set Text
forall a. Set a
Set.empty)
        C.BinaryExpr (Fix (C.LiteralExpr LiteralType
_ (C.L AlexPosn
_ LexemeClass
_ Text
"nullptr"))) BinaryOp
BopNe Node (Lexeme Text)
rhs ->
            (Maybe Text -> Set Text
forall a. Maybe a -> Set a
fromText (Maybe Text -> Set Text) -> Maybe Text -> Set Text
forall a b. (a -> b) -> a -> b
$ Node (Lexeme Text) -> Maybe Text
exprToText Node (Lexeme Text)
rhs, Set Text
forall a. Set a
Set.empty)
        C.BinaryExpr Node (Lexeme Text)
lhs BinaryOp
BopEq (Fix (C.LiteralExpr LiteralType
_ (C.L AlexPosn
_ LexemeClass
_ Text
"nullptr"))) ->
            (Set Text
forall a. Set a
Set.empty, Maybe Text -> Set Text
forall a. Maybe a -> Set a
fromText (Maybe Text -> Set Text) -> Maybe Text -> Set Text
forall a b. (a -> b) -> a -> b
$ Node (Lexeme Text) -> Maybe Text
exprToText Node (Lexeme Text)
lhs)
        C.BinaryExpr (Fix (C.LiteralExpr LiteralType
_ (C.L AlexPosn
_ LexemeClass
_ Text
"nullptr"))) BinaryOp
BopEq Node (Lexeme Text)
rhs ->
            (Set Text
forall a. Set a
Set.empty, Maybe Text -> Set Text
forall a. Maybe a -> Set a
fromText (Maybe Text -> Set Text) -> Maybe Text -> Set Text
forall a b. (a -> b) -> a -> b
$ Node (Lexeme Text) -> Maybe Text
exprToText Node (Lexeme Text)
rhs)

        C.UnaryExpr UnaryOp
UopNot Node (Lexeme Text)
inner ->
            let (Set Text
thenSet, Set Text
elseSet) = Node (Lexeme Text) -> (Set Text, Set Text)
checkCondition Node (Lexeme Text)
inner
            in (Set Text
elseSet, Set Text
thenSet)

        C.BinaryExpr Node (Lexeme Text)
lhs BinaryOp
BopAnd Node (Lexeme Text)
rhs ->
            let (Set Text
then1, Set Text
else1) = Node (Lexeme Text) -> (Set Text, Set Text)
checkCondition Node (Lexeme Text)
lhs
                (Set Text
then2, Set Text
else2) = Node (Lexeme Text) -> (Set Text, Set Text)
checkCondition Node (Lexeme Text)
rhs
            in (Set Text
then1 Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set Text
then2, Set Text
else1 Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set Text
else2)

        C.BinaryExpr Node (Lexeme Text)
lhs BinaryOp
BopOr Node (Lexeme Text)
rhs ->
            let (Set Text
then1, Set Text
else1) = Node (Lexeme Text) -> (Set Text, Set Text)
checkCondition Node (Lexeme Text)
lhs
                (Set Text
then2, Set Text
else2) = Node (Lexeme Text) -> (Set Text, Set Text)
checkCondition Node (Lexeme Text)
rhs
            in (Set Text
then1 Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set Text
then2, Set Text
else1 Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set Text
else2)

        C.ParenExpr Node (Lexeme Text)
inner -> Node (Lexeme Text) -> (Set Text, Set Text)
checkCondition Node (Lexeme Text)
inner

        C.VarExpr {} -> (Maybe Text -> Set Text
forall a. Maybe a -> Set a
fromText (Maybe Text -> Set Text) -> Maybe Text -> Set Text
forall a b. (a -> b) -> a -> b
$ Node (Lexeme Text) -> Maybe Text
exprToText Node (Lexeme Text)
n, Set Text
forall a. Set a
Set.empty)
        C.PointerAccess {} -> (Maybe Text -> Set Text
forall a. Maybe a -> Set a
fromText (Maybe Text -> Set Text) -> Maybe Text -> Set Text
forall a b. (a -> b) -> a -> b
$ Node (Lexeme Text) -> Maybe Text
exprToText Node (Lexeme Text)
n, Set Text
forall a. Set a
Set.empty)
        C.MemberAccess {} -> (Maybe Text -> Set Text
forall a. Maybe a -> Set a
fromText (Maybe Text -> Set Text) -> Maybe Text -> Set Text
forall a b. (a -> b) -> a -> b
$ Node (Lexeme Text) -> Maybe Text
exprToText Node (Lexeme Text)
n, Set Text
forall a. Set a
Set.empty)
        C.UnaryExpr UnaryOp
C.UopDeref Node (Lexeme Text)
_ -> (Maybe Text -> Set Text
forall a. Maybe a -> Set a
fromText (Maybe Text -> Set Text) -> Maybe Text -> Set Text
forall a b. (a -> b) -> a -> b
$ Node (Lexeme Text) -> Maybe Text
exprToText Node (Lexeme Text)
n, Set Text
forall a. Set a
Set.empty)

        NodeF (Lexeme Text) (Node (Lexeme Text))
_ -> (Set Text
forall a. Set a
Set.empty, Set Text
forall a. Set a
Set.empty)

    fromText :: Maybe a -> Set a
fromText Maybe a
Nothing  = Set a
forall a. Set a
Set.empty
    fromText (Just a
t) = a -> Set a
forall a. a -> Set a
Set.singleton a
t

hasReturn :: Node (Lexeme Text) -> Bool
hasReturn :: Node (Lexeme Text) -> Bool
hasReturn = \case
    Fix (C.Return Maybe (Node (Lexeme Text))
_)            -> Bool
True
    Fix (C.IfStmt Node (Lexeme Text)
_ Node (Lexeme Text)
t (Just Node (Lexeme Text)
e)) -> Node (Lexeme Text) -> Bool
hasReturn Node (Lexeme Text)
t Bool -> Bool -> Bool
&& Node (Lexeme Text) -> Bool
hasReturn Node (Lexeme Text)
e
    Fix (C.CompoundStmt [Node (Lexeme Text)]
stmts)  -> (Node (Lexeme Text) -> Bool) -> [Node (Lexeme Text)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Node (Lexeme Text) -> Bool
hasReturn [Node (Lexeme Text)]
stmts
    Node (Lexeme Text)
_                           -> Bool
False

analyseStmts :: [Node (Lexeme Text)] -> LinterM ()
analyseStmts :: [Node (Lexeme Text)] -> LinterM ()
analyseStmts = (Node (Lexeme Text) -> LinterM ())
-> [Node (Lexeme Text)] -> LinterM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Node (Lexeme Text) -> LinterM ()
analyseExpr

analyseExpr :: Node (Lexeme Text) -> LinterM ()
analyseExpr :: Node (Lexeme Text) -> LinterM ()
analyseExpr (Fix NodeF (Lexeme Text) (Node (Lexeme Text))
fixNode) = case NodeF (Lexeme Text) (Node (Lexeme Text))
fixNode of
    C.CastExpr Node (Lexeme Text)
toType Node (Lexeme Text)
fromExpr -> do
        LinterState
st <- StateT LinterState (State [Text]) LinterState
forall s (m :: * -> *). MonadState s m => m s
State.get
        let fromNameM :: Maybe Text
fromNameM = Node (Lexeme Text) -> Maybe Text
exprToText Node (Lexeme Text)
fromExpr
        Maybe Text -> (Text -> LinterM ()) -> LinterM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Text
fromNameM ((Text -> LinterM ()) -> LinterM ())
-> (Text -> LinterM ()) -> LinterM ()
forall a b. (a -> b) -> a -> b
$ \Text
fromName ->
            Maybe Nullability -> (Nullability -> LinterM ()) -> LinterM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Text -> LinterState -> Maybe Nullability
getNullability Text
fromName LinterState
st) ((Nullability -> LinterM ()) -> LinterM ())
-> (Nullability -> LinterM ()) -> LinterM ()
forall a b. (a -> b) -> a -> b
$ \Nullability
nullability ->
                if Node (Lexeme Text) -> Bool
isNonnull Node (Lexeme Text)
toType Bool -> Bool -> Bool
&& Nullability
nullability Nullability -> Nullability -> Bool
forall a. Eq a => a -> a -> Bool
== Nullability
NullableVar Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Text
fromName (LinterState -> Set Text
nonNullSet LinterState
st))
                then StateT [Text] Identity () -> LinterM ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
State.lift (StateT [Text] Identity () -> LinterM ())
-> (Text -> StateT [Text] Identity ()) -> Text -> LinterM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Node (Lexeme Text) -> Text -> StateT [Text] Identity ()
forall at diags.
(HasLocation at, HasDiagnostics diags) =>
String -> at -> Text -> DiagnosticsT diags ()
warn (LinterState -> String
currentFile LinterState
st) Node (Lexeme Text)
fromExpr (Text -> LinterM ()) -> Text -> LinterM ()
forall a b. (a -> b) -> a -> b
$
                        Text
"expression `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fromName
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"` is nullable and has not been checked before this cast"
                else () -> LinterM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        (Node (Lexeme Text) -> LinterM ())
-> NodeF (Lexeme Text) (Node (Lexeme Text)) -> LinterM ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Node (Lexeme Text) -> LinterM ()
analyseExpr NodeF (Lexeme Text) (Node (Lexeme Text))
fixNode

    C.AssignExpr Node (Lexeme Text)
lhs AssignOp
_ Node (Lexeme Text)
rhs -> do
        Node (Lexeme Text) -> LinterM ()
analyseExpr Node (Lexeme Text)
lhs
        Node (Lexeme Text) -> LinterM ()
analyseExpr Node (Lexeme Text)
rhs
        let lhsNameM :: Maybe Text
lhsNameM = Node (Lexeme Text) -> Maybe Text
exprToText Node (Lexeme Text)
lhs
        Bool
rhsIsNonNull <- Node (Lexeme Text) -> LinterM Bool
isExprNonNull Node (Lexeme Text)
rhs
        Maybe Text -> (Text -> LinterM ()) -> LinterM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Text
lhsNameM ((Text -> LinterM ()) -> LinterM ())
-> (Text -> LinterM ()) -> LinterM ()
forall a b. (a -> b) -> a -> b
$ \Text
lhsName ->
            if Bool
rhsIsNonNull
                then (LinterState -> LinterState) -> LinterM ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify ((LinterState -> LinterState) -> LinterM ())
-> (LinterState -> LinterState) -> LinterM ()
forall a b. (a -> b) -> a -> b
$ \LinterState
s -> LinterState
s { nonNullSet :: Set Text
nonNullSet = Text -> Set Text -> Set Text
forall a. Ord a => a -> Set a -> Set a
Set.insert Text
lhsName (LinterState -> Set Text
nonNullSet LinterState
s) }
                else (LinterState -> LinterState) -> LinterM ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify ((LinterState -> LinterState) -> LinterM ())
-> (LinterState -> LinterState) -> LinterM ()
forall a b. (a -> b) -> a -> b
$ \LinterState
s -> LinterState
s { nonNullSet :: Set Text
nonNullSet = Text -> Set Text -> Set Text
forall a. Ord a => a -> Set a -> Set a
Set.delete Text
lhsName (LinterState -> Set Text
nonNullSet LinterState
s) }

    C.BinaryExpr Node (Lexeme Text)
lhs BinaryOp
C.BopAnd Node (Lexeme Text)
rhs -> do
        Node (Lexeme Text) -> LinterM ()
analyseExpr Node (Lexeme Text)
lhs
        let (Set Text
nonNullInThen, Set Text
_) = Node (Lexeme Text) -> (Set Text, Set Text)
checkCondition Node (Lexeme Text)
lhs
        LinterState
st <- StateT LinterState (State [Text]) LinterState
forall s (m :: * -> *). MonadState s m => m s
State.get
        LinterState -> LinterM ()
forall s (m :: * -> *). MonadState s m => s -> m ()
State.put (LinterState -> LinterM ()) -> LinterState -> LinterM ()
forall a b. (a -> b) -> a -> b
$ LinterState
st { nonNullSet :: Set Text
nonNullSet = LinterState -> Set Text
nonNullSet LinterState
st Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set Text
nonNullInThen }
        Node (Lexeme Text) -> LinterM ()
analyseExpr Node (Lexeme Text)
rhs
        LinterState -> LinterM ()
forall s (m :: * -> *). MonadState s m => s -> m ()
State.put LinterState
st

    C.IfStmt Node (Lexeme Text)
condition Node (Lexeme Text)
thenBranch Maybe (Node (Lexeme Text))
elseBranchM -> do
        Node (Lexeme Text) -> LinterM ()
analyseExpr Node (Lexeme Text)
condition
        let (Set Text
nonNullInThen, Set Text
nonNullInElse) = Node (Lexeme Text) -> (Set Text, Set Text)
checkCondition Node (Lexeme Text)
condition

        LinterState
initialState <- StateT LinterState (State [Text]) LinterState
forall s (m :: * -> *). MonadState s m => m s
State.get

        LinterState -> LinterM ()
forall s (m :: * -> *). MonadState s m => s -> m ()
State.put (LinterState -> LinterM ()) -> LinterState -> LinterM ()
forall a b. (a -> b) -> a -> b
$ LinterState
initialState { nonNullSet :: Set Text
nonNullSet = LinterState -> Set Text
nonNullSet LinterState
initialState Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set Text
nonNullInThen }
        Node (Lexeme Text) -> LinterM ()
analyseStmts' Node (Lexeme Text)
thenBranch
        let thenReturns :: Bool
thenReturns = Node (Lexeme Text) -> Bool
hasReturn Node (Lexeme Text)
thenBranch
        LinterState
stateAfterThen <- StateT LinterState (State [Text]) LinterState
forall s (m :: * -> *). MonadState s m => m s
State.get

        (LinterState
stateAfterElse, Bool
elseReturns) <- case Maybe (Node (Lexeme Text))
elseBranchM of
            Maybe (Node (Lexeme Text))
Nothing -> do
                let s :: LinterState
s = LinterState
initialState { nonNullSet :: Set Text
nonNullSet = LinterState -> Set Text
nonNullSet LinterState
initialState Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set Text
nonNullInElse }
                (LinterState, Bool)
-> StateT LinterState (State [Text]) (LinterState, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (LinterState
s, Bool
False)
            Just Node (Lexeme Text)
elseBranch -> do
                LinterState -> LinterM ()
forall s (m :: * -> *). MonadState s m => s -> m ()
State.put (LinterState -> LinterM ()) -> LinterState -> LinterM ()
forall a b. (a -> b) -> a -> b
$ LinterState
initialState { nonNullSet :: Set Text
nonNullSet = LinterState -> Set Text
nonNullSet LinterState
initialState Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set Text
nonNullInElse }
                Node (Lexeme Text) -> LinterM ()
analyseStmts' Node (Lexeme Text)
elseBranch
                LinterState
s <- StateT LinterState (State [Text]) LinterState
forall s (m :: * -> *). MonadState s m => m s
State.get
                (LinterState, Bool)
-> StateT LinterState (State [Text]) (LinterState, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (LinterState
s, Node (Lexeme Text) -> Bool
hasReturn Node (Lexeme Text)
elseBranch)

        let finalSet :: Set Text
finalSet = if Bool
thenReturns Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
elseReturns
                         then LinterState -> Set Text
nonNullSet LinterState
stateAfterElse
                         else if Bool -> Bool
not Bool
thenReturns Bool -> Bool -> Bool
&& Bool
elseReturns
                         then LinterState -> Set Text
nonNullSet LinterState
stateAfterThen
                         else LinterState -> Set Text
nonNullSet LinterState
stateAfterThen Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` LinterState -> Set Text
nonNullSet LinterState
stateAfterElse

        LinterState -> LinterM ()
forall s (m :: * -> *). MonadState s m => s -> m ()
State.put (LinterState -> LinterM ()) -> LinterState -> LinterM ()
forall a b. (a -> b) -> a -> b
$ LinterState
stateAfterThen { nonNullSet :: Set Text
nonNullSet = Set Text
finalSet }

    C.TernaryExpr Node (Lexeme Text)
condition Node (Lexeme Text)
thenBranch Node (Lexeme Text)
elseBranch -> do
        Node (Lexeme Text) -> LinterM ()
analyseExpr Node (Lexeme Text)
condition
        let (Set Text
nonNullInThen, Set Text
nonNullInElse) = Node (Lexeme Text) -> (Set Text, Set Text)
checkCondition Node (Lexeme Text)
condition

        LinterState
initialState <- StateT LinterState (State [Text]) LinterState
forall s (m :: * -> *). MonadState s m => m s
State.get

        LinterState -> LinterM ()
forall s (m :: * -> *). MonadState s m => s -> m ()
State.put (LinterState -> LinterM ()) -> LinterState -> LinterM ()
forall a b. (a -> b) -> a -> b
$ LinterState
initialState { nonNullSet :: Set Text
nonNullSet = LinterState -> Set Text
nonNullSet LinterState
initialState Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set Text
nonNullInThen }
        Node (Lexeme Text) -> LinterM ()
analyseExpr Node (Lexeme Text)
thenBranch
        LinterState
stateAfterThen <- StateT LinterState (State [Text]) LinterState
forall s (m :: * -> *). MonadState s m => m s
State.get

        LinterState -> LinterM ()
forall s (m :: * -> *). MonadState s m => s -> m ()
State.put (LinterState -> LinterM ()) -> LinterState -> LinterM ()
forall a b. (a -> b) -> a -> b
$ LinterState
initialState { nonNullSet :: Set Text
nonNullSet = LinterState -> Set Text
nonNullSet LinterState
initialState Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set Text
nonNullInElse }
        Node (Lexeme Text) -> LinterM ()
analyseExpr Node (Lexeme Text)
elseBranch
        LinterState
stateAfterElse <- StateT LinterState (State [Text]) LinterState
forall s (m :: * -> *). MonadState s m => m s
State.get

        LinterState -> LinterM ()
forall s (m :: * -> *). MonadState s m => s -> m ()
State.put (LinterState -> LinterM ()) -> LinterState -> LinterM ()
forall a b. (a -> b) -> a -> b
$ LinterState
stateAfterThen { nonNullSet :: Set Text
nonNullSet = LinterState -> Set Text
nonNullSet LinterState
stateAfterThen Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` LinterState -> Set Text
nonNullSet LinterState
stateAfterElse }

    C.VarDeclStmt (Fix (C.VarDecl Node (Lexeme Text)
ty (C.L AlexPosn
_ LexemeClass
_ Text
name) [Node (Lexeme Text)]
_)) Maybe (Node (Lexeme Text))
initM -> do
        let nullability :: Nullability
nullability = if Node (Lexeme Text) -> Bool
isNullable Node (Lexeme Text)
ty then Nullability
NullableVar else Nullability
NonNullVar
        (LinterState -> LinterState) -> LinterM ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify ((LinterState -> LinterState) -> LinterM ())
-> (LinterState -> LinterState) -> LinterM ()
forall a b. (a -> b) -> a -> b
$ \LinterState
s -> LinterState
s { typeEnv :: TypeEnv
typeEnv = Text
-> (Nullability, Maybe (Node (Lexeme Text))) -> TypeEnv -> TypeEnv
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
name (Nullability
nullability, Node (Lexeme Text) -> Maybe (Node (Lexeme Text))
forall a. a -> Maybe a
Just Node (Lexeme Text)
ty) (LinterState -> TypeEnv
typeEnv LinterState
s) }
        Maybe (Node (Lexeme Text))
-> (Node (Lexeme Text) -> LinterM ()) -> LinterM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (Node (Lexeme Text))
initM ((Node (Lexeme Text) -> LinterM ()) -> LinterM ())
-> (Node (Lexeme Text) -> LinterM ()) -> LinterM ()
forall a b. (a -> b) -> a -> b
$ \Node (Lexeme Text)
i -> do
            Node (Lexeme Text) -> LinterM ()
analyseExpr Node (Lexeme Text)
i
            Bool
isInitNonNull <- Node (Lexeme Text) -> LinterM Bool
isExprNonNull Node (Lexeme Text)
i
            if Bool
isInitNonNull
                then (LinterState -> LinterState) -> LinterM ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify ((LinterState -> LinterState) -> LinterM ())
-> (LinterState -> LinterState) -> LinterM ()
forall a b. (a -> b) -> a -> b
$ \LinterState
s -> LinterState
s { nonNullSet :: Set Text
nonNullSet = Text -> Set Text -> Set Text
forall a. Ord a => a -> Set a -> Set a
Set.insert Text
name (LinterState -> Set Text
nonNullSet LinterState
s) }
                else () -> LinterM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    NodeF (Lexeme Text) (Node (Lexeme Text))
_ -> (Node (Lexeme Text) -> LinterM ())
-> NodeF (Lexeme Text) (Node (Lexeme Text)) -> LinterM ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Node (Lexeme Text) -> LinterM ()
analyseExpr NodeF (Lexeme Text) (Node (Lexeme Text))
fixNode

analyseStmts' :: Node (Lexeme Text) -> LinterM ()
analyseStmts' :: Node (Lexeme Text) -> LinterM ()
analyseStmts' (Fix (C.CompoundStmt [Node (Lexeme Text)]
stmts)) = [Node (Lexeme Text)] -> LinterM ()
analyseStmts [Node (Lexeme Text)]
stmts
analyseStmts' Node (Lexeme Text)
node                         = Node (Lexeme Text) -> LinterM ()
analyseExpr Node (Lexeme Text)
node

collectStructs :: AstActions (State (Map Text TypeEnv)) Text
collectStructs :: AstActions (State (Map Text TypeEnv)) Text
collectStructs = AstActions (State (Map Text TypeEnv)) Text
forall (f :: * -> *) text. Applicative f => AstActions f text
astActions
    { doNode :: String
-> Node (Lexeme Text)
-> State (Map Text TypeEnv) ()
-> State (Map Text TypeEnv) ()
doNode = \String
_ Node (Lexeme Text)
node State (Map Text TypeEnv) ()
act ->
        case Node (Lexeme Text) -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Node (Lexeme Text)
node of
            C.Typedef (Fix (C.Struct Lexeme Text
_ [Node (Lexeme Text)]
members)) Lexeme Text
structName -> do
                let fieldEnv :: TypeEnv
fieldEnv = [(Text, (Nullability, Maybe (Node (Lexeme Text))))] -> TypeEnv
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, (Nullability, Maybe (Node (Lexeme Text))))] -> TypeEnv)
-> ([Node (Lexeme Text)]
    -> [(Text, (Nullability, Maybe (Node (Lexeme Text))))])
-> [Node (Lexeme Text)]
-> TypeEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node (Lexeme Text)
 -> [(Text, (Nullability, Maybe (Node (Lexeme Text))))])
-> [Node (Lexeme Text)]
-> [(Text, (Nullability, Maybe (Node (Lexeme Text))))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Node (Lexeme Text)
-> [(Text, (Nullability, Maybe (Node (Lexeme Text))))]
getFieldDecls ([Node (Lexeme Text)] -> TypeEnv)
-> [Node (Lexeme Text)] -> TypeEnv
forall a b. (a -> b) -> a -> b
$ [Node (Lexeme Text)]
members
                (Map Text TypeEnv -> Map Text TypeEnv)
-> State (Map Text TypeEnv) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (Text -> TypeEnv -> Map Text TypeEnv -> Map Text TypeEnv
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Lexeme Text -> Text
forall text. Lexeme text -> text
C.lexemeText Lexeme Text
structName) TypeEnv
fieldEnv)
                State (Map Text TypeEnv) ()
act
            NodeF (Lexeme Text) (Node (Lexeme Text))
_ -> State (Map Text TypeEnv) ()
act
    }
  where
    getFieldDecls :: Node (Lexeme Text)
-> [(Text, (Nullability, Maybe (Node (Lexeme Text))))]
getFieldDecls (Fix (C.MemberDecl (Fix (C.VarDecl Node (Lexeme Text)
ty Lexeme Text
name [Node (Lexeme Text)]
_)) Maybe (Lexeme Text)
_)) =
        let nullability :: Nullability
nullability = if Node (Lexeme Text) -> Bool
isNullable Node (Lexeme Text)
ty then Nullability
NullableVar else Nullability
NonNullVar
        in [(Lexeme Text -> Text
forall text. Lexeme text -> text
C.lexemeText Lexeme Text
name, (Nullability
nullability, Node (Lexeme Text) -> Maybe (Node (Lexeme Text))
forall a. a -> Maybe a
Just Node (Lexeme Text)
ty))]
    getFieldDecls Node (Lexeme Text)
_ = []

linter :: Map Text TypeEnv -> AstActions (State [Text]) Text
linter :: Map Text TypeEnv -> AstActions (State [Text]) Text
linter Map Text TypeEnv
defs = AstActions (State [Text]) Text
forall (f :: * -> *) text. Applicative f => AstActions f text
astActions
    { doNode :: String
-> Node (Lexeme Text)
-> StateT [Text] Identity ()
-> StateT [Text] Identity ()
doNode = \String
file Node (Lexeme Text)
node StateT [Text] Identity ()
act ->
        case Node (Lexeme Text) -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Node (Lexeme Text)
node of
            C.FunctionDefn Scope
_ Node (Lexeme Text)
proto Node (Lexeme Text)
body ->
                let tenv :: TypeEnv
tenv = Node (Lexeme Text) -> TypeEnv
getParamTypes Node (Lexeme Text)
proto
                    initialNonNulls :: Set Text
initialNonNulls = TypeEnv -> Set Text
forall k a. Map k a -> Set k
Map.keysSet (TypeEnv -> Set Text)
-> (TypeEnv -> TypeEnv) -> TypeEnv -> Set Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Nullability, Maybe (Node (Lexeme Text))) -> Bool)
-> TypeEnv -> TypeEnv
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter ((Nullability -> Nullability -> Bool
forall a. Eq a => a -> a -> Bool
== Nullability
NonNullVar) (Nullability -> Bool)
-> ((Nullability, Maybe (Node (Lexeme Text))) -> Nullability)
-> (Nullability, Maybe (Node (Lexeme Text)))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Nullability, Maybe (Node (Lexeme Text))) -> Nullability
forall a b. (a, b) -> a
fst) (TypeEnv -> Set Text) -> TypeEnv -> Set Text
forall a b. (a -> b) -> a -> b
$ TypeEnv
tenv
                    initialState :: LinterState
initialState = TypeEnv -> Map Text TypeEnv -> Set Text -> String -> LinterState
LinterState TypeEnv
tenv Map Text TypeEnv
defs Set Text
initialNonNulls String
file
                in LinterM () -> LinterState -> StateT [Text] Identity ()
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
State.evalStateT (Node (Lexeme Text) -> LinterM ()
analyseStmts' Node (Lexeme Text)
body) LinterState
initialState
            NodeF (Lexeme Text) (Node (Lexeme Text))
_ -> StateT [Text] Identity ()
act
    }

analyse :: (FilePath, [Node (Lexeme Text)]) -> [Text]
analyse :: (String, [Node (Lexeme Text)]) -> [Text]
analyse (String, [Node (Lexeme Text)])
input =
    let defs :: Map Text TypeEnv
defs = State (Map Text TypeEnv) () -> Map Text TypeEnv -> Map Text TypeEnv
forall s a. State s a -> s -> s
State.execState (AstActions (State (Map Text TypeEnv)) Text
-> (String, [Node (Lexeme Text)]) -> State (Map Text TypeEnv) ()
forall text a (f :: * -> *).
(TraverseAst text a, Applicative f) =>
AstActions f text -> a -> f ()
traverseAst AstActions (State (Map Text TypeEnv)) Text
collectStructs (String, [Node (Lexeme Text)])
input) Map Text TypeEnv
forall k a. Map k a
Map.empty
    in [Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text])
-> ((String, [Node (Lexeme Text)]) -> [Text])
-> (String, [Node (Lexeme Text)])
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT [Text] Identity () -> [Text] -> [Text])
-> [Text] -> StateT [Text] Identity () -> [Text]
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT [Text] Identity () -> [Text] -> [Text]
forall s a. State s a -> s -> s
State.execState [] (StateT [Text] Identity () -> [Text])
-> ((String, [Node (Lexeme Text)]) -> StateT [Text] Identity ())
-> (String, [Node (Lexeme Text)])
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AstActions (State [Text]) Text
-> (String, [Node (Lexeme Text)]) -> StateT [Text] Identity ()
forall text a (f :: * -> *).
(TraverseAst text a, Applicative f) =>
AstActions f text -> a -> f ()
traverseAst (Map Text TypeEnv -> AstActions (State [Text]) Text
linter Map Text TypeEnv
defs) ((String, [Node (Lexeme Text)]) -> [Text])
-> (String, [Node (Lexeme Text)]) -> [Text]
forall a b. (a -> b) -> a -> b
$ (String, [Node (Lexeme Text)])
input

descr :: ((FilePath, [Node (Lexeme Text)]) -> [Text], (Text, Text))
descr :: ((String, [Node (Lexeme Text)]) -> [Text], (Text, Text))
descr = ((String, [Node (Lexeme Text)]) -> [Text]
analyse, (Text
"nullability", [Text] -> Text
Text.unlines
    [ Text
"Warns when a `_Nullable` pointer is cast to a `_Nonnull` pointer without a null check."
    , Text
""
    , Text
"**Reason:** Casting a nullable pointer to a non-null pointer without ensuring it's not"
    , Text
"null can lead to null pointer dereferences and crashes."
    ]))