{-# 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, warnDoc)


data DeclInfo = DeclInfo
    { DeclInfo -> Bool
declAnnotated    :: Bool
    , DeclInfo -> Bool
declPublicHeader :: Bool
    , DeclInfo -> FilePath
declFile         :: FilePath
    , DeclInfo -> Node (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 :: [Diagnostic CimplePos]
diags :: Linter -> [Diagnostic CimplePos]
diags} = Linter
l{diags :: [Diagnostic CimplePos]
diags = Diagnostic CimplePos
diag Diagnostic CimplePos
-> [Diagnostic CimplePos] -> [Diagnostic CimplePos]
forall a. a -> [a] -> [a]
: [Diagnostic CimplePos]
diags}


hasNullability :: Linter -> Node (Lexeme Text) -> Bool
hasNullability :: Linter -> Node (Lexeme Text) -> Bool
hasNullability Linter
l (Fix NodeF (Lexeme Text) (Node (Lexeme Text))
node) = case NodeF (Lexeme Text) (Node (Lexeme Text))
node of
    TyNonnull Node (Lexeme Text)
_       -> Bool
True
    TyNullable Node (Lexeme Text)
_      -> Bool
True
    TyPointer Node (Lexeme Text)
t       -> Linter -> Node (Lexeme Text) -> Bool
hasNullability Linter
l Node (Lexeme Text)
t
    TyConst Node (Lexeme Text)
t         -> Linter -> Node (Lexeme Text) -> Bool
hasNullability Linter
l Node (Lexeme Text)
t
    TyForce Node (Lexeme Text)
t         -> Linter -> Node (Lexeme Text) -> Bool
hasNullability Linter
l Node (Lexeme Text)
t
    VarDecl Node (Lexeme Text)
t Lexeme Text
_ [Node (Lexeme Text)]
specs -> Linter -> Node (Lexeme Text) -> Bool
hasNullability Linter
l Node (Lexeme Text)
t Bool -> Bool -> Bool
|| (Node (Lexeme Text) -> Bool) -> [Node (Lexeme Text)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Node (Lexeme Text) -> Bool
forall lexeme. Fix (NodeF lexeme) -> Bool
isAnnotatedArray [Node (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) (Node (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 -> Node (Lexeme Text) -> Bool
isPointerType Linter
l (Fix NodeF (Lexeme Text) (Node (Lexeme Text))
node) = case NodeF (Lexeme Text) (Node (Lexeme Text))
node of
    TyPointer Node (Lexeme Text)
_                     -> Bool
True
    TyNullable Node (Lexeme Text)
t                    -> Linter -> Node (Lexeme Text) -> Bool
isPointerType Linter
l Node (Lexeme Text)
t
    TyNonnull Node (Lexeme Text)
t                     -> Linter -> Node (Lexeme Text) -> Bool
isPointerType Linter
l Node (Lexeme Text)
t
    TyConst Node (Lexeme Text)
t                       -> Linter -> Node (Lexeme Text) -> Bool
isPointerType Linter
l Node (Lexeme Text)
t
    TyForce Node (Lexeme Text)
t                       -> Linter -> Node (Lexeme Text) -> Bool
isPointerType Linter
l Node (Lexeme Text)
t
    VarDecl Node (Lexeme Text)
t Lexeme Text
_ [Node (Lexeme Text)]
specs               -> Linter -> Node (Lexeme Text) -> Bool
isPointerType Linter
l Node (Lexeme Text)
t Bool -> Bool -> Bool
|| (Node (Lexeme Text) -> Bool) -> [Node (Lexeme Text)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Node (Lexeme Text) -> Bool
forall lexeme. Fix (NodeF lexeme) -> Bool
isArray [Node (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) (Node (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 :: FilePath -> Bool
isThirdParty FilePath
path = FilePath
"third_party/" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`List.isInfixOf` FilePath
path


isPublicHeader :: FilePath -> Bool
isPublicHeader :: FilePath -> Bool
isPublicHeader FilePath
path = (FilePath -> Bool) -> [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`List.isSuffixOf` FilePath
path) [FilePath
"tox.h", FilePath
"tox_events.h", FilePath
"tox_dispatch.h", FilePath
"toxav.h", FilePath
"toxencryptsave.h", FilePath
"tox_options.h", FilePath
"tox_log_level.h"]


checkNullability :: HasDiagnosticInfo at CimplePos => FilePath -> at -> Node (Lexeme Text) -> Maybe DeclInfo -> State Linter ()
checkNullability :: FilePath
-> at -> Node (Lexeme Text) -> Maybe DeclInfo -> State Linter ()
checkNullability FilePath
file at
at Node (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 -> Node (Lexeme Text) -> Bool
isPointerType Linter
l Node (Lexeme Text)
ty Bool -> Bool -> Bool
&& Bool -> Bool
not (Linter -> Node (Lexeme Text) -> Bool
hasNullability Linter
l Node (Lexeme Text)
ty)) (State Linter () -> State Linter ())
-> State Linter () -> State Linter ()
forall a b. (a -> b) -> a -> b
$
        let (CimplePos
pos, Int
len) = FilePath -> at -> (CimplePos, Int)
forall at pos.
HasDiagnosticInfo at pos =>
FilePath -> at -> (pos, Int)
getDiagnosticInfo FilePath
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 (Node (Lexeme Text) -> Doc AnsiStyle
forall a. Pretty a => Node (Lexeme a) -> Doc AnsiStyle
ppNode Node (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 -> FilePath
declFile DeclInfo
info FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
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
$ FilePath -> Node (Lexeme Text) -> (CimplePos, Int)
nodePosAndLen (DeclInfo -> FilePath
declFile DeclInfo
info) (DeclInfo -> Node (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
$ FilePath -> Node (Lexeme Text) -> (CimplePos, Int)
nodePosAndLen (DeclInfo -> FilePath
declFile DeclInfo
info) (DeclInfo -> Node (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 :: FilePath -> Node (Lexeme Text) -> Maybe DeclInfo -> State Linter ()
checkPrototypeNullability FilePath
file (Fix (FunctionPrototype Node (Lexeme Text)
retType Lexeme Text
_ [Node (Lexeme Text)]
params)) Maybe DeclInfo
mDeclInfo = do
    FilePath
-> Node (Lexeme Text)
-> Node (Lexeme Text)
-> Maybe DeclInfo
-> State Linter ()
forall at.
HasDiagnosticInfo at CimplePos =>
FilePath
-> at -> Node (Lexeme Text) -> Maybe DeclInfo -> State Linter ()
checkNullability FilePath
file Node (Lexeme Text)
retType Node (Lexeme Text)
retType Maybe DeclInfo
mDeclInfo
    (Node (Lexeme Text) -> State Linter ())
-> [Node (Lexeme Text)] -> State Linter ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Node (Lexeme Text) -> State Linter ()
checkParamNullability [Node (Lexeme Text)]
params
  where
    checkParamNullability :: Node (Lexeme Text) -> State Linter ()
checkParamNullability (Fix (VarDecl Node (Lexeme Text)
ty Lexeme Text
name [Node (Lexeme Text)]
_)) = FilePath
-> Lexeme Text
-> Node (Lexeme Text)
-> Maybe DeclInfo
-> State Linter ()
forall at.
HasDiagnosticInfo at CimplePos =>
FilePath
-> at -> Node (Lexeme Text) -> Maybe DeclInfo -> State Linter ()
checkNullability FilePath
file Lexeme Text
name Node (Lexeme Text)
ty Maybe DeclInfo
mDeclInfo
    checkParamNullability Node (Lexeme Text)
_                         = () -> State Linter ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkPrototypeNullability FilePath
_ Node (Lexeme Text)
_ Maybe DeclInfo
_ = () -> State Linter ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()


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

findPrototypeQualifiers :: Node (Lexeme Text) -> [Text]
findPrototypeQualifiers :: Node (Lexeme Text) -> [Text]
findPrototypeQualifiers (Fix (FunctionPrototype Node (Lexeme Text)
retType Lexeme Text
_ [Node (Lexeme Text)]
params)) =
    Node (Lexeme Text) -> [Text]
findQualifiers Node (Lexeme Text)
retType [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (Node (Lexeme Text) -> [Text]) -> [Node (Lexeme Text)] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Node (Lexeme Text) -> [Text]
findParamQualifiers [Node (Lexeme Text)]
params
  where
    findParamQualifiers :: Node (Lexeme Text) -> [Text]
findParamQualifiers (Fix (VarDecl Node (Lexeme Text)
ty Lexeme Text
_ [Node (Lexeme Text)]
_)) = Node (Lexeme Text) -> [Text]
findQualifiers Node (Lexeme Text)
ty
    findParamQualifiers Node (Lexeme Text)
_                      = []
findPrototypeQualifiers Node (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 :: FilePath
-> Node (Lexeme Text) -> State Linter () -> State Linter ()
doNode = \FilePath
file Node (Lexeme Text)
node State Linter ()
act ->
        case Node (Lexeme Text) -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Node (Lexeme Text)
node of
            Typedef Node (Lexeme Text)
ty Lexeme Text
name [Node (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 -> Node (Lexeme Text) -> Bool
isPointerType Linter
st Node (Lexeme Text)
ty Bool -> Bool -> Bool
|| (Node (Lexeme Text) -> Bool) -> [Node (Lexeme Text)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Node (Lexeme Text) -> Bool
forall lexeme. Fix (NodeF lexeme) -> Bool
isArray [Node (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 Text
pointerTypedefs = Text -> Set Text -> Set Text
forall a. Ord a => a -> Set a -> Set a
Set.insert (Lexeme Text -> Text
forall text. Lexeme text -> text
lexemeText Lexeme Text
name) (Linter -> Set Text
pointerTypedefs Linter
s) }
                State Linter ()
act
              where
                isArray :: Fix (NodeF lexeme) -> Bool
isArray (Fix (DeclSpecArray {})) = Bool
True
                isArray Fix (NodeF lexeme)
_                        = Bool
False

            TypedefFunction Node (Lexeme Text)
proto -> do
                case Node (Lexeme Text) -> Maybe Text
forall a. Show a => Node (Lexeme a) -> Maybe a
functionName Node (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 (t :: * -> *) a. Foldable t => t a -> Bool
null ([Text] -> Bool) -> [Text] -> Bool
forall a b. (a -> b) -> a -> b
$ Node (Lexeme Text) -> [Text]
findPrototypeQualifiers Node (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 Text
pointerTypedefs = Text -> Set Text -> Set Text
forall a. Ord a => a -> Set a -> Set a
Set.insert Text
name (Linter -> Set Text
pointerTypedefs Linter
s)
                            , functionTypedefs :: Map Text DeclInfo
functionTypedefs = Text -> DeclInfo -> Map Text DeclInfo -> Map Text DeclInfo
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
name (Bool -> Bool -> FilePath -> Node (Lexeme Text) -> DeclInfo
DeclInfo Bool
isAnnotated (FilePath -> Bool
isPublicHeader FilePath
file) FilePath
file Node (Lexeme Text)
proto) (Linter -> Map Text DeclInfo
functionTypedefs Linter
s)
                            }
                    Maybe Text
Nothing -> () -> State Linter ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                State Linter ()
act

            NodeF (Lexeme Text) (Node (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 :: FilePath
-> Node (Lexeme Text) -> State Linter () -> State Linter ()
doNode = \FilePath
file Node (Lexeme Text)
node State Linter ()
act ->
        case Node (Lexeme Text) -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Node (Lexeme Text)
node of
            FunctionDecl Scope
_ Node (Lexeme Text)
proto -> do
                case Node (Lexeme Text) -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Node (Lexeme Text)
proto of
                    FunctionPrototype Node (Lexeme Text)
_ Lexeme Text
name [Node (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 Text DeclInfo
decls = Text -> DeclInfo -> Map Text DeclInfo -> Map Text DeclInfo
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Lexeme Text -> Text
forall text. Lexeme text -> text
lexemeText Lexeme Text
name) (Bool -> Bool -> FilePath -> Node (Lexeme Text) -> DeclInfo
DeclInfo (Bool -> Bool
not (Bool -> Bool) -> ([Text] -> Bool) -> [Text] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Text] -> Bool) -> [Text] -> Bool
forall a b. (a -> b) -> a -> b
$ Node (Lexeme Text) -> [Text]
findPrototypeQualifiers Node (Lexeme Text)
proto) (FilePath -> Bool
isPublicHeader FilePath
file) FilePath
file Node (Lexeme Text)
proto) (Linter -> Map Text DeclInfo
decls Linter
s) }
                    CallbackDecl Lexeme Text
typeNameLexeme Lexeme Text
nameLexeme -> do
                        Linter{Map Text DeclInfo
functionTypedefs :: Map Text DeclInfo
functionTypedefs :: Linter -> 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 Text DeclInfo
decls = Text -> DeclInfo -> Map Text DeclInfo -> Map Text DeclInfo
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Lexeme Text -> Text
forall text. Lexeme text -> text
lexemeText Lexeme Text
nameLexeme) DeclInfo
info (Linter -> Map Text DeclInfo
decls Linter
s) }
                            Maybe DeclInfo
Nothing   -> () -> State Linter ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    NodeF (Lexeme Text) (Node (Lexeme Text))
_ -> () -> State Linter ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                State Linter ()
act

            NodeF (Lexeme Text) (Node (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 :: FilePath
-> Node (Lexeme Text) -> State Linter () -> State Linter ()
doNode = \FilePath
file Node (Lexeme Text)
node State Linter ()
act ->
        if FilePath -> Bool
isThirdParty FilePath
file then State Linter ()
act else case Node (Lexeme Text) -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Node (Lexeme Text)
node of
            FunctionDecl Scope
_ Node (Lexeme Text)
proto -> do
                Bool -> State Linter () -> State Linter ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FilePath -> Bool
isPublicHeader FilePath
file) (State Linter () -> State Linter ())
-> State Linter () -> State Linter ()
forall a b. (a -> b) -> a -> b
$
                    case Node (Lexeme Text) -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Node (Lexeme Text)
proto of
                        FunctionPrototype {} -> FilePath -> Node (Lexeme Text) -> Maybe DeclInfo -> State Linter ()
checkPrototypeNullability FilePath
file Node (Lexeme Text)
proto Maybe DeclInfo
forall a. Maybe a
Nothing
                        CallbackDecl Lexeme Text
typeNameLexeme Lexeme Text
nameLexeme -> do
                            Linter{Map Text DeclInfo
functionTypedefs :: Map Text DeclInfo
functionTypedefs :: Linter -> 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
$ FilePath
-> Lexeme Text
-> Node (Lexeme Text)
-> Maybe DeclInfo
-> State Linter ()
forall at.
HasDiagnosticInfo at CimplePos =>
FilePath
-> at -> Node (Lexeme Text) -> Maybe DeclInfo -> State Linter ()
checkNullability FilePath
file Lexeme Text
nameLexeme Node (Lexeme Text)
proto Maybe DeclInfo
mInfo
                        NodeF (Lexeme Text) (Node (Lexeme Text))
_ -> () -> State Linter ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                State Linter ()
act

            FunctionDefn Scope
scope proto :: Node (Lexeme Text)
proto@(Fix (FunctionPrototype Node (Lexeme Text)
_ Lexeme Text
name [Node (Lexeme Text)]
_)) Node (Lexeme Text)
_ -> do
                Linter{Map Text DeclInfo
decls :: Map Text DeclInfo
decls :: Linter -> 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
$ Node (Lexeme Text) -> [Text]
findPrototypeQualifiers Node (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 (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) = FilePath -> Lexeme Text -> (CimplePos, Int)
forall at pos.
HasDiagnosticInfo at pos =>
FilePath -> at -> (pos, Int)
getDiagnosticInfo FilePath
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 -> FilePath
declFile DeclInfo
info FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
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
$ FilePath -> Node (Lexeme Text) -> (CimplePos, Int)
nodePosAndLen (DeclInfo -> FilePath
declFile DeclInfo
info) (DeclInfo -> Node (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
$ FilePath -> Node (Lexeme Text) -> (CimplePos, Int)
nodePosAndLen (DeclInfo -> FilePath
declFile DeclInfo
info) (DeclInfo -> Node (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 (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 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
$ FilePath -> Node (Lexeme Text) -> Maybe DeclInfo -> State Linter ()
checkPrototypeNullability FilePath
file Node (Lexeme Text)
proto Maybe DeclInfo
mInfo
                State Linter ()
act

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

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


analyse :: [(FilePath, [Node (Lexeme Text)])] -> [Diagnostic CimplePos]
analyse :: [(FilePath, [Node (Lexeme Text)])] -> [Diagnostic CimplePos]
analyse [(FilePath, [Node (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
-> [(FilePath, [Node (Lexeme Text)])] -> State Linter ()
forall text a (f :: * -> *).
(TraverseAst text a, Applicative f) =>
AstActions f text -> a -> f ()
traverseAst AstActions (State Linter) Text
collectTypedefs [(FilePath, [Node (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
-> [(FilePath, [Node (Lexeme Text)])] -> State Linter ()
forall text a (f :: * -> *).
(TraverseAst text a, Applicative f) =>
AstActions f text -> a -> f ()
traverseAst AstActions (State Linter) Text
collectDecls [(FilePath, [Node (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
-> [(FilePath, [Node (Lexeme Text)])] -> State Linter ()
forall text a (f :: * -> *).
(TraverseAst text a, Applicative f) =>
AstActions f text -> a -> f ()
traverseAst AstActions (State Linter) Text
linter [(FilePath, [Node (Lexeme Text)])]
tus) Linter
linterStateDecls

descr :: ([(FilePath, [Node (Lexeme Text)])] -> [Diagnostic CimplePos], (Text, Text))
descr :: ([(FilePath, [Node (Lexeme Text)])] -> [Diagnostic CimplePos],
 (Text, Text))
descr = ([(FilePath, [Node (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."
    ]))