{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE Strict                #-}
module Tokstyle.Linter.OwnershipDecls (descr) where

import           Control.Monad               (unless, when)
import           Control.Monad.State.Strict  (State)
import qualified Control.Monad.State.Strict  as State
import           Data.Fix                    (Fix (..))
import qualified Data.List                   as List
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             (Lexeme (..), Node, NodeF (..),
                                              Nullability (..), Scope (..),
                                              lexemeText)
import           Language.Cimple.Diagnostics (CimplePos, Diagnostic (..),
                                              DiagnosticLevel (..),
                                              DiagnosticSpan (..),
                                              HasDiagnosticInfo (..),
                                              HasDiagnosticsRich (..),
                                              nodePosAndLen, warnRich)
import           Language.Cimple.Pretty      (ppNode)
import           Language.Cimple.TraverseAst (AstActions, astActions, doNode,
                                              traverseAst)
import           Prettyprinter               (hsep, pretty, punctuate, (<+>))
import           Tokstyle.Common             (backticks, functionName,
                                              isPublicHeader, warnDoc)


data DeclInfo = DeclInfo
    { DeclInfo -> Bool
declAnnotated    :: Bool
    , DeclInfo -> Bool
declPublicHeader :: Bool
    , DeclInfo -> [Char]
declFile         :: FilePath
    , DeclInfo -> Fix (NodeF (Lexeme Text))
declNode         :: Node (Lexeme Text)
    }

data Linter = Linter
    { Linter -> [Diagnostic CimplePos]
diags            :: [Diagnostic CimplePos]
    , Linter -> Map Text DeclInfo
decls            :: Map Text DeclInfo
    , Linter -> Map Text DeclInfo
functionTypedefs :: Map Text DeclInfo
    , Linter -> Set Text
pointerTypedefs  :: Set Text
    }

empty :: Linter
empty :: Linter
empty = [Diagnostic CimplePos]
-> Map Text DeclInfo -> Map Text DeclInfo -> Set Text -> Linter
Linter [] Map Text DeclInfo
forall k a. Map k a
Map.empty Map Text DeclInfo
forall k a. Map k a
Map.empty Set Text
forall a. Set a
Set.empty


instance HasDiagnosticsRich Linter CimplePos where
    addDiagnosticRich :: Diagnostic CimplePos -> Linter -> Linter
addDiagnosticRich Diagnostic CimplePos
diag l :: Linter
l@Linter{[Diagnostic CimplePos]
diags :: Linter -> [Diagnostic CimplePos]
diags :: [Diagnostic CimplePos]
diags} = Linter
l{diags = diag : diags}


hasNullability :: Linter -> Node (Lexeme Text) -> Bool
hasNullability :: Linter -> Fix (NodeF (Lexeme Text)) -> Bool
hasNullability Linter
l (Fix NodeF (Lexeme Text) (Fix (NodeF (Lexeme Text)))
node) = case NodeF (Lexeme Text) (Fix (NodeF (Lexeme Text)))
node of
    TyNonnull Fix (NodeF (Lexeme Text))
_       -> Bool
True
    TyNullable Fix (NodeF (Lexeme Text))
_      -> Bool
True
    TyPointer Fix (NodeF (Lexeme Text))
t       -> Linter -> Fix (NodeF (Lexeme Text)) -> Bool
hasNullability Linter
l Fix (NodeF (Lexeme Text))
t
    TyConst Fix (NodeF (Lexeme Text))
t         -> Linter -> Fix (NodeF (Lexeme Text)) -> Bool
hasNullability Linter
l Fix (NodeF (Lexeme Text))
t
    TyForce Fix (NodeF (Lexeme Text))
t         -> Linter -> Fix (NodeF (Lexeme Text)) -> Bool
hasNullability Linter
l Fix (NodeF (Lexeme Text))
t
    VarDecl Fix (NodeF (Lexeme Text))
t Lexeme Text
_ [Fix (NodeF (Lexeme Text))]
specs -> Linter -> Fix (NodeF (Lexeme Text)) -> Bool
hasNullability Linter
l Fix (NodeF (Lexeme Text))
t Bool -> Bool -> Bool
|| (Fix (NodeF (Lexeme Text)) -> Bool)
-> [Fix (NodeF (Lexeme Text))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Fix (NodeF (Lexeme Text)) -> Bool
forall {lexeme}. Fix (NodeF lexeme) -> Bool
isAnnotatedArray [Fix (NodeF (Lexeme Text))]
specs
    CallbackDecl (L AlexPosn
_ LexemeClass
_ Text
typeName) Lexeme Text
_ ->
        case Text -> Map Text DeclInfo -> Maybe DeclInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
typeName (Linter -> Map Text DeclInfo
functionTypedefs Linter
l) of
            Just DeclInfo
info -> DeclInfo -> Bool
declAnnotated DeclInfo
info
            Maybe DeclInfo
Nothing   -> Bool
False
    NodeF (Lexeme Text) (Fix (NodeF (Lexeme Text)))
_                 -> Bool
False
  where
    isAnnotatedArray :: Fix (NodeF lexeme) -> Bool
isAnnotatedArray (Fix (DeclSpecArray Nullability
n Maybe (Fix (NodeF lexeme))
_)) = Nullability
n Nullability -> Nullability -> Bool
forall a. Eq a => a -> a -> Bool
/= Nullability
NullabilityUnspecified
    isAnnotatedArray Fix (NodeF lexeme)
_                         = Bool
False


isPointerType :: Linter -> Node (Lexeme Text) -> Bool
isPointerType :: Linter -> Fix (NodeF (Lexeme Text)) -> Bool
isPointerType Linter
l (Fix NodeF (Lexeme Text) (Fix (NodeF (Lexeme Text)))
node) = case NodeF (Lexeme Text) (Fix (NodeF (Lexeme Text)))
node of
    TyPointer Fix (NodeF (Lexeme Text))
_                     -> Bool
True
    TyNullable Fix (NodeF (Lexeme Text))
t                    -> Linter -> Fix (NodeF (Lexeme Text)) -> Bool
isPointerType Linter
l Fix (NodeF (Lexeme Text))
t
    TyNonnull Fix (NodeF (Lexeme Text))
t                     -> Linter -> Fix (NodeF (Lexeme Text)) -> Bool
isPointerType Linter
l Fix (NodeF (Lexeme Text))
t
    TyConst Fix (NodeF (Lexeme Text))
t                       -> Linter -> Fix (NodeF (Lexeme Text)) -> Bool
isPointerType Linter
l Fix (NodeF (Lexeme Text))
t
    TyForce Fix (NodeF (Lexeme Text))
t                       -> Linter -> Fix (NodeF (Lexeme Text)) -> Bool
isPointerType Linter
l Fix (NodeF (Lexeme Text))
t
    VarDecl Fix (NodeF (Lexeme Text))
t Lexeme Text
_ [Fix (NodeF (Lexeme Text))]
specs               -> Linter -> Fix (NodeF (Lexeme Text)) -> Bool
isPointerType Linter
l Fix (NodeF (Lexeme Text))
t Bool -> Bool -> Bool
|| (Fix (NodeF (Lexeme Text)) -> Bool)
-> [Fix (NodeF (Lexeme Text))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Fix (NodeF (Lexeme Text)) -> Bool
forall {lexeme}. Fix (NodeF lexeme) -> Bool
isArray [Fix (NodeF (Lexeme Text))]
specs
    TyUserDefined (L AlexPosn
_ LexemeClass
_ Text
name)      -> Text
name Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Linter -> Set Text
pointerTypedefs Linter
l
    TyFunc (L AlexPosn
_ LexemeClass
_ Text
name)             -> Text
name Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Linter -> Set Text
pointerTypedefs Linter
l
    CallbackDecl (L AlexPosn
_ LexemeClass
_ Text
typeName) Lexeme Text
_ -> Text
typeName Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Linter -> Set Text
pointerTypedefs Linter
l
    NodeF (Lexeme Text) (Fix (NodeF (Lexeme Text)))
_                               -> Bool
False
  where
    isArray :: Fix (NodeF lexeme) -> Bool
isArray (Fix (DeclSpecArray {})) = Bool
True
    isArray Fix (NodeF lexeme)
_                        = Bool
False


isThirdParty :: FilePath -> Bool
isThirdParty :: [Char] -> Bool
isThirdParty [Char]
path = [Char]
"third_party/" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`List.isInfixOf` [Char]
path


checkNullability :: HasDiagnosticInfo at CimplePos => FilePath -> at -> Node (Lexeme Text) -> Maybe DeclInfo -> State Linter ()
checkNullability :: forall at.
HasDiagnosticInfo at CimplePos =>
[Char]
-> at
-> Fix (NodeF (Lexeme Text))
-> Maybe DeclInfo
-> State Linter ()
checkNullability [Char]
file at
at Fix (NodeF (Lexeme Text))
ty Maybe DeclInfo
mDeclInfo = do
    Linter
l <- StateT Linter Identity Linter
forall s (m :: * -> *). MonadState s m => m s
State.get
    Bool -> State Linter () -> State Linter ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Linter -> Fix (NodeF (Lexeme Text)) -> Bool
isPointerType Linter
l Fix (NodeF (Lexeme Text))
ty Bool -> Bool -> Bool
&& Bool -> Bool
not (Linter -> Fix (NodeF (Lexeme Text)) -> Bool
hasNullability Linter
l Fix (NodeF (Lexeme Text))
ty)) (State Linter () -> State Linter ())
-> State Linter () -> State Linter ()
forall a b. (a -> b) -> a -> b
$
        let (CimplePos
pos, Int
len) = [Char] -> at -> (CimplePos, Int)
forall at pos.
HasDiagnosticInfo at pos =>
[Char] -> at -> (pos, Int)
getDiagnosticInfo [Char]
file at
at
            msg :: Doc AnsiStyle
msg = Doc AnsiStyle
"pointer 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 (Fix (NodeF (Lexeme Text)) -> Doc AnsiStyle
forall a. Pretty a => Node (Lexeme a) -> Doc AnsiStyle
ppNode Fix (NodeF (Lexeme Text))
ty)
                  Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
"should have an explicit nullability annotation (`_Nullable` or `_Nonnull`)"
            spans :: [DiagnosticSpan CimplePos]
spans = [ CimplePos -> Int -> [Doc AnsiStyle] -> DiagnosticSpan CimplePos
forall pos. pos -> Int -> [Doc AnsiStyle] -> DiagnosticSpan pos
DiagnosticSpan CimplePos
pos Int
len [ Doc AnsiStyle
"missing annotation here" ] ]
                    [DiagnosticSpan CimplePos]
-> [DiagnosticSpan CimplePos] -> [DiagnosticSpan CimplePos]
forall a. [a] -> [a] -> [a]
++ case Maybe DeclInfo
mDeclInfo of
                         Just DeclInfo
info | DeclInfo -> [Char]
declFile DeclInfo
info [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
file ->
                             [ CimplePos -> Int -> [Doc AnsiStyle] -> DiagnosticSpan CimplePos
forall pos. pos -> Int -> [Doc AnsiStyle] -> DiagnosticSpan pos
DiagnosticSpan ((CimplePos, Int) -> CimplePos
forall a b. (a, b) -> a
fst ((CimplePos, Int) -> CimplePos) -> (CimplePos, Int) -> CimplePos
forall a b. (a -> b) -> a -> b
$ [Char] -> Fix (NodeF (Lexeme Text)) -> (CimplePos, Int)
nodePosAndLen (DeclInfo -> [Char]
declFile DeclInfo
info) (DeclInfo -> Fix (NodeF (Lexeme Text))
declNode DeclInfo
info)) ((CimplePos, Int) -> Int
forall a b. (a, b) -> b
snd ((CimplePos, Int) -> Int) -> (CimplePos, Int) -> Int
forall a b. (a -> b) -> a -> b
$ [Char] -> Fix (NodeF (Lexeme Text)) -> (CimplePos, Int)
nodePosAndLen (DeclInfo -> [Char]
declFile DeclInfo
info) (DeclInfo -> Fix (NodeF (Lexeme Text))
declNode DeclInfo
info)) [ Doc AnsiStyle
"because declaration here is unannotated" ] ]
                         Maybe DeclInfo
_ -> []
        in Diagnostic CimplePos -> State Linter ()
forall diags pos.
HasDiagnosticsRich diags pos =>
Diagnostic pos -> DiagnosticsT diags ()
warnRich (Diagnostic CimplePos -> State Linter ())
-> Diagnostic CimplePos -> State Linter ()
forall a b. (a -> b) -> a -> b
$ CimplePos
-> Int
-> DiagnosticLevel
-> Doc AnsiStyle
-> Maybe Text
-> [DiagnosticSpan CimplePos]
-> [(DiagnosticLevel, Doc AnsiStyle)]
-> Diagnostic CimplePos
forall pos.
pos
-> Int
-> DiagnosticLevel
-> Doc AnsiStyle
-> Maybe Text
-> [DiagnosticSpan pos]
-> [(DiagnosticLevel, Doc AnsiStyle)]
-> Diagnostic pos
Diagnostic CimplePos
pos Int
len DiagnosticLevel
WarningLevel Doc AnsiStyle
msg (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"ownership-decls") [DiagnosticSpan CimplePos]
spans []


checkPrototypeNullability :: FilePath -> Node (Lexeme Text) -> Maybe DeclInfo -> State Linter ()
checkPrototypeNullability :: [Char]
-> Fix (NodeF (Lexeme Text)) -> Maybe DeclInfo -> State Linter ()
checkPrototypeNullability [Char]
file (Fix (FunctionPrototype Fix (NodeF (Lexeme Text))
retType Lexeme Text
_ [Fix (NodeF (Lexeme Text))]
params)) Maybe DeclInfo
mDeclInfo = do
    [Char]
-> Fix (NodeF (Lexeme Text))
-> Fix (NodeF (Lexeme Text))
-> Maybe DeclInfo
-> State Linter ()
forall at.
HasDiagnosticInfo at CimplePos =>
[Char]
-> at
-> Fix (NodeF (Lexeme Text))
-> Maybe DeclInfo
-> State Linter ()
checkNullability [Char]
file Fix (NodeF (Lexeme Text))
retType Fix (NodeF (Lexeme Text))
retType Maybe DeclInfo
mDeclInfo
    (Fix (NodeF (Lexeme Text)) -> State Linter ())
-> [Fix (NodeF (Lexeme Text))] -> State Linter ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Fix (NodeF (Lexeme Text)) -> State Linter ()
checkParamNullability [Fix (NodeF (Lexeme Text))]
params
  where
    checkParamNullability :: Fix (NodeF (Lexeme Text)) -> State Linter ()
checkParamNullability (Fix (VarDecl Fix (NodeF (Lexeme Text))
ty Lexeme Text
name [Fix (NodeF (Lexeme Text))]
_)) = [Char]
-> Lexeme Text
-> Fix (NodeF (Lexeme Text))
-> Maybe DeclInfo
-> State Linter ()
forall at.
HasDiagnosticInfo at CimplePos =>
[Char]
-> at
-> Fix (NodeF (Lexeme Text))
-> Maybe DeclInfo
-> State Linter ()
checkNullability [Char]
file Lexeme Text
name Fix (NodeF (Lexeme Text))
ty Maybe DeclInfo
mDeclInfo
    checkParamNullability Fix (NodeF (Lexeme Text))
_                         = () -> State Linter ()
forall a. a -> StateT Linter Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkPrototypeNullability [Char]
_ Fix (NodeF (Lexeme Text))
_ Maybe DeclInfo
_ = () -> State Linter ()
forall a. a -> StateT Linter Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


findQualifiers :: Node (Lexeme Text) -> [Text]
findQualifiers :: Fix (NodeF (Lexeme Text)) -> [Text]
findQualifiers (Fix NodeF (Lexeme Text) (Fix (NodeF (Lexeme Text)))
node) = case NodeF (Lexeme Text) (Fix (NodeF (Lexeme Text)))
node of
    TyOwner Fix (NodeF (Lexeme Text))
t    -> Text
"_Owner" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Fix (NodeF (Lexeme Text)) -> [Text]
findQualifiers Fix (NodeF (Lexeme Text))
t
    TyNonnull Fix (NodeF (Lexeme Text))
t  -> Text
"_Nonnull" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Fix (NodeF (Lexeme Text)) -> [Text]
findQualifiers Fix (NodeF (Lexeme Text))
t
    TyNullable Fix (NodeF (Lexeme Text))
t -> Text
"_Nullable" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Fix (NodeF (Lexeme Text)) -> [Text]
findQualifiers Fix (NodeF (Lexeme Text))
t
    TyConst Fix (NodeF (Lexeme Text))
t    -> Fix (NodeF (Lexeme Text)) -> [Text]
findQualifiers Fix (NodeF (Lexeme Text))
t
    TyPointer Fix (NodeF (Lexeme Text))
t  -> Fix (NodeF (Lexeme Text)) -> [Text]
findQualifiers Fix (NodeF (Lexeme Text))
t
    NodeF (Lexeme Text) (Fix (NodeF (Lexeme Text)))
_            -> []

findPrototypeQualifiers :: Node (Lexeme Text) -> [Text]
findPrototypeQualifiers :: Fix (NodeF (Lexeme Text)) -> [Text]
findPrototypeQualifiers (Fix (FunctionPrototype Fix (NodeF (Lexeme Text))
retType Lexeme Text
_ [Fix (NodeF (Lexeme Text))]
params)) =
    Fix (NodeF (Lexeme Text)) -> [Text]
findQualifiers Fix (NodeF (Lexeme Text))
retType [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (Fix (NodeF (Lexeme Text)) -> [Text])
-> [Fix (NodeF (Lexeme Text))] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Fix (NodeF (Lexeme Text)) -> [Text]
findParamQualifiers [Fix (NodeF (Lexeme Text))]
params
  where
    findParamQualifiers :: Fix (NodeF (Lexeme Text)) -> [Text]
findParamQualifiers (Fix (VarDecl Fix (NodeF (Lexeme Text))
ty Lexeme Text
_ [Fix (NodeF (Lexeme Text))]
_)) = Fix (NodeF (Lexeme Text)) -> [Text]
findQualifiers Fix (NodeF (Lexeme Text))
ty
    findParamQualifiers Fix (NodeF (Lexeme Text))
_                      = []
findPrototypeQualifiers Fix (NodeF (Lexeme Text))
_ = []


collectTypedefs :: AstActions (State Linter) Text
collectTypedefs :: AstActions (State Linter) Text
collectTypedefs = AstActions (State Linter) Text
forall (f :: * -> *) text. Applicative f => AstActions f text
astActions
    { doNode = \[Char]
file Fix (NodeF (Lexeme Text))
node State Linter ()
act ->
        case Fix (NodeF (Lexeme Text))
-> NodeF (Lexeme Text) (Fix (NodeF (Lexeme Text)))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Fix (NodeF (Lexeme Text))
node of
            Typedef Fix (NodeF (Lexeme Text))
ty Lexeme Text
name [Fix (NodeF (Lexeme Text))]
specs -> do
                Linter
st <- StateT Linter Identity Linter
forall s (m :: * -> *). MonadState s m => m s
State.get
                let isPtr :: Bool
isPtr = Linter -> Fix (NodeF (Lexeme Text)) -> Bool
isPointerType Linter
st Fix (NodeF (Lexeme Text))
ty Bool -> Bool -> Bool
|| (Fix (NodeF (Lexeme Text)) -> Bool)
-> [Fix (NodeF (Lexeme Text))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Fix (NodeF (Lexeme Text)) -> Bool
forall {lexeme}. Fix (NodeF lexeme) -> Bool
isArray [Fix (NodeF (Lexeme Text))]
specs
                Bool -> State Linter () -> State Linter ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isPtr (State Linter () -> State Linter ())
-> State Linter () -> State Linter ()
forall a b. (a -> b) -> a -> b
$ (Linter -> Linter) -> State Linter ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify ((Linter -> Linter) -> State Linter ())
-> (Linter -> Linter) -> State Linter ()
forall a b. (a -> b) -> a -> b
$ \Linter
s -> Linter
s { pointerTypedefs = Set.insert (lexemeText name) (pointerTypedefs s) }
                State Linter ()
act
              where
                isArray :: Fix (NodeF lexeme) -> Bool
isArray (Fix (DeclSpecArray {})) = Bool
True
                isArray Fix (NodeF lexeme)
_                        = Bool
False

            TypedefFunction Fix (NodeF (Lexeme Text))
proto -> do
                case Fix (NodeF (Lexeme Text)) -> Maybe Text
forall a. Show a => Node (Lexeme a) -> Maybe a
functionName Fix (NodeF (Lexeme Text))
proto of
                    Just Text
name -> do
                        let isAnnotated :: Bool
isAnnotated = Bool -> Bool
not (Bool -> Bool) -> ([Text] -> Bool) -> [Text] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Text] -> Bool) -> [Text] -> Bool
forall a b. (a -> b) -> a -> b
$ Fix (NodeF (Lexeme Text)) -> [Text]
findPrototypeQualifiers Fix (NodeF (Lexeme Text))
proto
                        (Linter -> Linter) -> State Linter ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify ((Linter -> Linter) -> State Linter ())
-> (Linter -> Linter) -> State Linter ()
forall a b. (a -> b) -> a -> b
$ \Linter
s -> Linter
s
                            { pointerTypedefs = Set.insert name (pointerTypedefs s)
                            , functionTypedefs = Map.insert name (DeclInfo isAnnotated (isPublicHeader file) file proto) (functionTypedefs s)
                            }
                    Maybe Text
Nothing -> () -> State Linter ()
forall a. a -> StateT Linter Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                State Linter ()
act

            NodeF (Lexeme Text) (Fix (NodeF (Lexeme Text)))
_ -> State Linter ()
act
    }


collectDecls :: AstActions (State Linter) Text
collectDecls :: AstActions (State Linter) Text
collectDecls = AstActions (State Linter) Text
forall (f :: * -> *) text. Applicative f => AstActions f text
astActions
    { doNode = \[Char]
file Fix (NodeF (Lexeme Text))
node State Linter ()
act ->
        case Fix (NodeF (Lexeme Text))
-> NodeF (Lexeme Text) (Fix (NodeF (Lexeme Text)))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Fix (NodeF (Lexeme Text))
node of
            FunctionDecl Scope
_ Fix (NodeF (Lexeme Text))
proto -> do
                case Fix (NodeF (Lexeme Text))
-> NodeF (Lexeme Text) (Fix (NodeF (Lexeme Text)))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Fix (NodeF (Lexeme Text))
proto of
                    FunctionPrototype Fix (NodeF (Lexeme Text))
_ Lexeme Text
name [Fix (NodeF (Lexeme Text))]
_ ->
                        (Linter -> Linter) -> State Linter ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify ((Linter -> Linter) -> State Linter ())
-> (Linter -> Linter) -> State Linter ()
forall a b. (a -> b) -> a -> b
$ \Linter
s -> Linter
s { decls = Map.insert (lexemeText name) (DeclInfo (not . null $ findPrototypeQualifiers proto) (isPublicHeader file) file proto) (decls s) }
                    CallbackDecl Lexeme Text
typeNameLexeme Lexeme Text
nameLexeme -> do
                        Linter{Map Text DeclInfo
functionTypedefs :: Linter -> Map Text DeclInfo
functionTypedefs :: Map Text DeclInfo
functionTypedefs} <- StateT Linter Identity Linter
forall s (m :: * -> *). MonadState s m => m s
State.get
                        case Text -> Map Text DeclInfo -> Maybe DeclInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Lexeme Text -> Text
forall text. Lexeme text -> text
lexemeText Lexeme Text
typeNameLexeme) Map Text DeclInfo
functionTypedefs of
                            Just DeclInfo
info -> (Linter -> Linter) -> State Linter ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify ((Linter -> Linter) -> State Linter ())
-> (Linter -> Linter) -> State Linter ()
forall a b. (a -> b) -> a -> b
$ \Linter
s -> Linter
s { decls = Map.insert (lexemeText nameLexeme) info (decls s) }
                            Maybe DeclInfo
Nothing   -> () -> State Linter ()
forall a. a -> StateT Linter Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    NodeF (Lexeme Text) (Fix (NodeF (Lexeme Text)))
_ -> () -> State Linter ()
forall a. a -> StateT Linter Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                State Linter ()
act

            NodeF (Lexeme Text) (Fix (NodeF (Lexeme Text)))
_ -> State Linter ()
act
    }


linter :: AstActions (State Linter) Text
linter :: AstActions (State Linter) Text
linter = AstActions (State Linter) Text
forall (f :: * -> *) text. Applicative f => AstActions f text
astActions
    { doNode = \[Char]
file Fix (NodeF (Lexeme Text))
node State Linter ()
act ->
        if [Char] -> Bool
isThirdParty [Char]
file then State Linter ()
act else case Fix (NodeF (Lexeme Text))
-> NodeF (Lexeme Text) (Fix (NodeF (Lexeme Text)))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Fix (NodeF (Lexeme Text))
node of
            FunctionDecl Scope
_ Fix (NodeF (Lexeme Text))
proto -> do
                Bool -> State Linter () -> State Linter ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Char] -> Bool
isPublicHeader [Char]
file) (State Linter () -> State Linter ())
-> State Linter () -> State Linter ()
forall a b. (a -> b) -> a -> b
$
                    case Fix (NodeF (Lexeme Text))
-> NodeF (Lexeme Text) (Fix (NodeF (Lexeme Text)))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Fix (NodeF (Lexeme Text))
proto of
                        FunctionPrototype {} -> [Char]
-> Fix (NodeF (Lexeme Text)) -> Maybe DeclInfo -> State Linter ()
checkPrototypeNullability [Char]
file Fix (NodeF (Lexeme Text))
proto Maybe DeclInfo
forall a. Maybe a
Nothing
                        CallbackDecl Lexeme Text
typeNameLexeme Lexeme Text
nameLexeme -> do
                            Linter{Map Text DeclInfo
functionTypedefs :: Linter -> Map Text DeclInfo
functionTypedefs :: Map Text DeclInfo
functionTypedefs} <- StateT Linter Identity Linter
forall s (m :: * -> *). MonadState s m => m s
State.get
                            let mInfo :: Maybe DeclInfo
mInfo = Text -> Map Text DeclInfo -> Maybe DeclInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Lexeme Text -> Text
forall text. Lexeme text -> text
lexemeText Lexeme Text
typeNameLexeme) Map Text DeclInfo
functionTypedefs
                            let isPublic :: Bool
isPublic = Bool -> (DeclInfo -> Bool) -> Maybe DeclInfo -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False DeclInfo -> Bool
declPublicHeader Maybe DeclInfo
mInfo
                            Bool -> State Linter () -> State Linter ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isPublic (State Linter () -> State Linter ())
-> State Linter () -> State Linter ()
forall a b. (a -> b) -> a -> b
$ [Char]
-> Lexeme Text
-> Fix (NodeF (Lexeme Text))
-> Maybe DeclInfo
-> State Linter ()
forall at.
HasDiagnosticInfo at CimplePos =>
[Char]
-> at
-> Fix (NodeF (Lexeme Text))
-> Maybe DeclInfo
-> State Linter ()
checkNullability [Char]
file Lexeme Text
nameLexeme Fix (NodeF (Lexeme Text))
proto Maybe DeclInfo
mInfo
                        NodeF (Lexeme Text) (Fix (NodeF (Lexeme Text)))
_ -> () -> State Linter ()
forall a. a -> StateT Linter Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                State Linter ()
act

            FunctionDefn Scope
scope proto :: Fix (NodeF (Lexeme Text))
proto@(Fix (FunctionPrototype Fix (NodeF (Lexeme Text))
_ Lexeme Text
name [Fix (NodeF (Lexeme Text))]
_)) Fix (NodeF (Lexeme Text))
_ -> do
                Linter{Map Text DeclInfo
decls :: Linter -> Map Text DeclInfo
decls :: Map Text DeclInfo
decls} <- StateT Linter Identity Linter
forall s (m :: * -> *). MonadState s m => m s
State.get
                let nameText :: Text
nameText = Lexeme Text -> Text
forall text. Lexeme text -> text
lexemeText Lexeme Text
name
                let mInfo :: Maybe DeclInfo
mInfo = Text -> Map Text DeclInfo -> Maybe DeclInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
nameText Map Text DeclInfo
decls
                let qs :: [Text]
qs = [Text] -> [Text]
forall a. Eq a => [a] -> [a]
List.nub ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Fix (NodeF (Lexeme Text)) -> [Text]
findPrototypeQualifiers Fix (NodeF (Lexeme Text))
proto
                let shouldAllowQualifiers :: Bool
shouldAllowQualifiers = case Maybe DeclInfo
mInfo of
                        Just DeclInfo
info -> DeclInfo -> Bool
declPublicHeader DeclInfo
info Bool -> Bool -> Bool
&& Bool -> Bool
not (DeclInfo -> Bool
declAnnotated DeclInfo
info)
                        Maybe DeclInfo
Nothing   -> Scope
scope Scope -> Scope -> Bool
forall a. Eq a => a -> a -> Bool
== Scope
Static
                Bool -> State Linter () -> State Linter ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
qs Bool -> Bool -> Bool
|| Bool
shouldAllowQualifiers) (State Linter () -> State Linter ())
-> State Linter () -> State Linter ()
forall a b. (a -> b) -> a -> b
$ do
                    let (CimplePos
pos, Int
len) = [Char] -> Lexeme Text -> (CimplePos, Int)
forall at pos.
HasDiagnosticInfo at pos =>
[Char] -> at -> (pos, Int)
getDiagnosticInfo [Char]
file Lexeme Text
name
                        spans :: [DiagnosticSpan CimplePos]
spans = [ CimplePos -> Int -> [Doc AnsiStyle] -> DiagnosticSpan CimplePos
forall pos. pos -> Int -> [Doc AnsiStyle] -> DiagnosticSpan pos
DiagnosticSpan CimplePos
pos Int
len [ Doc AnsiStyle
"found qualifier here" ] ]
                                [DiagnosticSpan CimplePos]
-> [DiagnosticSpan CimplePos] -> [DiagnosticSpan CimplePos]
forall a. [a] -> [a] -> [a]
++ case Maybe DeclInfo
mInfo of
                                     Just DeclInfo
info | DeclInfo -> [Char]
declFile DeclInfo
info [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
file ->
                                         [ CimplePos -> Int -> [Doc AnsiStyle] -> DiagnosticSpan CimplePos
forall pos. pos -> Int -> [Doc AnsiStyle] -> DiagnosticSpan pos
DiagnosticSpan ((CimplePos, Int) -> CimplePos
forall a b. (a, b) -> a
fst ((CimplePos, Int) -> CimplePos) -> (CimplePos, Int) -> CimplePos
forall a b. (a -> b) -> a -> b
$ [Char] -> Fix (NodeF (Lexeme Text)) -> (CimplePos, Int)
nodePosAndLen (DeclInfo -> [Char]
declFile DeclInfo
info) (DeclInfo -> Fix (NodeF (Lexeme Text))
declNode DeclInfo
info)) ((CimplePos, Int) -> Int
forall a b. (a, b) -> b
snd ((CimplePos, Int) -> Int) -> (CimplePos, Int) -> Int
forall a b. (a -> b) -> a -> b
$ [Char] -> Fix (NodeF (Lexeme Text)) -> (CimplePos, Int)
nodePosAndLen (DeclInfo -> [Char]
declFile DeclInfo
info) (DeclInfo -> Fix (NodeF (Lexeme Text))
declNode DeclInfo
info)) [ Doc AnsiStyle
"should be added here instead" ] ]
                                     Maybe DeclInfo
_ -> []
                    Diagnostic CimplePos -> State Linter ()
forall diags pos.
HasDiagnosticsRich diags pos =>
Diagnostic pos -> DiagnosticsT diags ()
warnRich (Diagnostic CimplePos -> State Linter ())
-> Diagnostic CimplePos -> State Linter ()
forall a b. (a -> b) -> a -> b
$ CimplePos
-> Int
-> DiagnosticLevel
-> Doc AnsiStyle
-> Maybe Text
-> [DiagnosticSpan CimplePos]
-> [(DiagnosticLevel, Doc AnsiStyle)]
-> Diagnostic CimplePos
forall pos.
pos
-> Int
-> DiagnosticLevel
-> Doc AnsiStyle
-> Maybe Text
-> [DiagnosticSpan pos]
-> [(DiagnosticLevel, Doc AnsiStyle)]
-> Diagnostic pos
Diagnostic CimplePos
pos Int
len DiagnosticLevel
WarningLevel
                        (Doc AnsiStyle
"qualifier" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> (if [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
qs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then Doc AnsiStyle
"s" else Doc AnsiStyle
"")
                        Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
hsep (Doc AnsiStyle -> [Doc AnsiStyle] -> [Doc AnsiStyle]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc AnsiStyle
" and" ((Text -> Doc AnsiStyle) -> [Text] -> [Doc AnsiStyle]
forall a b. (a -> b) -> [a] -> [b]
map (Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann
backticks (Doc AnsiStyle -> Doc AnsiStyle)
-> (Text -> Doc AnsiStyle) -> Text -> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc AnsiStyle
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty) [Text]
qs))
                        Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
"should only be used on function declarations, not definitions")
                        (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"ownership-decls")
                        [DiagnosticSpan CimplePos]
spans
                        []

                let shouldExpectAnnotations :: Bool
shouldExpectAnnotations = case Maybe DeclInfo
mInfo of
                        Just DeclInfo
info -> DeclInfo -> Bool
declPublicHeader DeclInfo
info Bool -> Bool -> Bool
&& Bool -> Bool
not (DeclInfo -> Bool
declAnnotated DeclInfo
info)
                        Maybe DeclInfo
Nothing   -> Bool
True
                Bool -> State Linter () -> State Linter ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldExpectAnnotations (State Linter () -> State Linter ())
-> State Linter () -> State Linter ()
forall a b. (a -> b) -> a -> b
$ [Char]
-> Fix (NodeF (Lexeme Text)) -> Maybe DeclInfo -> State Linter ()
checkPrototypeNullability [Char]
file Fix (NodeF (Lexeme Text))
proto Maybe DeclInfo
mInfo
                State Linter ()
act

            Struct Lexeme Text
_ [Fix (NodeF (Lexeme Text))]
members -> do
                Bool -> State Linter () -> State Linter ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Char] -> Bool
isPublicHeader [Char]
file) (State Linter () -> State Linter ())
-> State Linter () -> State Linter ()
forall a b. (a -> b) -> a -> b
$ (Fix (NodeF (Lexeme Text)) -> State Linter ())
-> [Fix (NodeF (Lexeme Text))] -> State Linter ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Fix (NodeF (Lexeme Text)) -> State Linter ()
checkMember [Fix (NodeF (Lexeme Text))]
members
                State Linter ()
act
              where
                checkMember :: Fix (NodeF (Lexeme Text)) -> State Linter ()
checkMember (Fix (MemberDecl (Fix (VarDecl Fix (NodeF (Lexeme Text))
ty Lexeme Text
fieldName [Fix (NodeF (Lexeme Text))]
_)) Maybe (Lexeme Text)
_)) =
                    [Char]
-> Lexeme Text
-> Fix (NodeF (Lexeme Text))
-> Maybe DeclInfo
-> State Linter ()
forall at.
HasDiagnosticInfo at CimplePos =>
[Char]
-> at
-> Fix (NodeF (Lexeme Text))
-> Maybe DeclInfo
-> State Linter ()
checkNullability [Char]
file Lexeme Text
fieldName Fix (NodeF (Lexeme Text))
ty Maybe DeclInfo
forall a. Maybe a
Nothing
                checkMember Fix (NodeF (Lexeme Text))
_ = () -> State Linter ()
forall a. a -> StateT Linter Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

            NodeF (Lexeme Text) (Fix (NodeF (Lexeme Text)))
_ -> State Linter ()
act
    }


analyse :: [(FilePath, [Node (Lexeme Text)])] -> [Diagnostic CimplePos]
analyse :: [([Char], [Fix (NodeF (Lexeme Text))])] -> [Diagnostic CimplePos]
analyse [([Char], [Fix (NodeF (Lexeme Text))])]
tus =
    let linterStateTypedefs :: Linter
linterStateTypedefs = State Linter () -> Linter -> Linter
forall s a. State s a -> s -> s
State.execState (AstActions (State Linter) Text
-> [([Char], [Fix (NodeF (Lexeme Text))])] -> State Linter ()
forall text a (f :: * -> *).
(TraverseAst text a, Applicative f) =>
AstActions f text -> a -> f ()
traverseAst AstActions (State Linter) Text
collectTypedefs [([Char], [Fix (NodeF (Lexeme Text))])]
tus) Linter
empty
        linterStateDecls :: Linter
linterStateDecls = State Linter () -> Linter -> Linter
forall s a. State s a -> s -> s
State.execState (AstActions (State Linter) Text
-> [([Char], [Fix (NodeF (Lexeme Text))])] -> State Linter ()
forall text a (f :: * -> *).
(TraverseAst text a, Applicative f) =>
AstActions f text -> a -> f ()
traverseAst AstActions (State Linter) Text
collectDecls [([Char], [Fix (NodeF (Lexeme Text))])]
tus) Linter
linterStateTypedefs
    in [Diagnostic CimplePos] -> [Diagnostic CimplePos]
forall a. [a] -> [a]
reverse ([Diagnostic CimplePos] -> [Diagnostic CimplePos])
-> (Linter -> [Diagnostic CimplePos])
-> Linter
-> [Diagnostic CimplePos]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Linter -> [Diagnostic CimplePos]
diags (Linter -> [Diagnostic CimplePos])
-> Linter -> [Diagnostic CimplePos]
forall a b. (a -> b) -> a -> b
$ State Linter () -> Linter -> Linter
forall s a. State s a -> s -> s
State.execState (AstActions (State Linter) Text
-> [([Char], [Fix (NodeF (Lexeme Text))])] -> State Linter ()
forall text a (f :: * -> *).
(TraverseAst text a, Applicative f) =>
AstActions f text -> a -> f ()
traverseAst AstActions (State Linter) Text
linter [([Char], [Fix (NodeF (Lexeme Text))])]
tus) Linter
linterStateDecls

descr :: ([(FilePath, [Node (Lexeme Text)])] -> [Diagnostic CimplePos], (Text, Text))
descr :: ([([Char], [Fix (NodeF (Lexeme Text))])] -> [Diagnostic CimplePos],
 (Text, Text))
descr = ([([Char], [Fix (NodeF (Lexeme Text))])] -> [Diagnostic CimplePos]
analyse, (Text
"ownership-decls", [Text] -> Text
Text.unlines
    [ Text
"Checks that `_Owner`, `_Nullable`, and `_Nonnull` are only set on declarations,"
    , Text
"not definitions, unless it's a static definition without prior declaration."
    , Text
""
    , Text
"**Reason:** keeping qualifiers on declarations only reduces clutter in the"
    , Text
"implementation and ensures that the interface is the single source of truth"
    , Text
"for ownership or nullability information."
    ]))