{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StrictData #-} module Tokstyle.Cimple.Analysis.DeclsHaveDefns (analyse) where import qualified Control.Monad.State.Lazy as State import Data.Map (Map) import qualified Data.Map as Map import Data.Maybe (mapMaybe) import Data.Text (Text) import Language.Cimple (AstActions, Lexeme (..), LexemeClass (..), Node (..), defaultActions, doNode, traverseAst) import qualified Language.Cimple.Diagnostics as Diagnostics import System.FilePath (takeFileName) data DeclDefn = DeclDefn { DeclDefn -> Maybe (FilePath, Lexeme Text) decl :: Maybe (FilePath, Lexeme Text) , DeclDefn -> Maybe (FilePath, Lexeme Text) defn :: Maybe (FilePath, Lexeme Text) } collectPairs :: AstActions (Map Text DeclDefn) collectPairs :: AstActions (Map Text DeclDefn) collectPairs = AstActions (Map Text DeclDefn) forall a. IdentityActions (State a) () Text defaultActions { doNode :: FilePath -> Node () (Lexeme Text) -> State (Map Text DeclDefn) (Node () (Lexeme Text)) -> State (Map Text DeclDefn) (Node () (Lexeme Text)) doNode = \FilePath file Node () (Lexeme Text) node State (Map Text DeclDefn) (Node () (Lexeme Text)) act -> case Node () (Lexeme Text) node of FunctionDecl Scope _ (FunctionPrototype Node () (Lexeme Text) _ fn :: Lexeme Text fn@(L AlexPosn _ LexemeClass IdVar Text fname) [Node () (Lexeme Text)] _) Maybe (Node () (Lexeme Text)) _ -> do (Map Text DeclDefn -> Map Text DeclDefn) -> State (Map Text DeclDefn) () forall s (m :: * -> *). MonadState s m => (s -> s) -> m () State.modify ((Map Text DeclDefn -> Map Text DeclDefn) -> State (Map Text DeclDefn) ()) -> (Map Text DeclDefn -> Map Text DeclDefn) -> State (Map Text DeclDefn) () forall a b. (a -> b) -> a -> b $ \Map Text DeclDefn pairs -> case Text -> Map Text DeclDefn -> Maybe DeclDefn forall k a. Ord k => k -> Map k a -> Maybe a Map.lookup Text fname Map Text DeclDefn pairs of Maybe DeclDefn Nothing -> Text -> DeclDefn -> Map Text DeclDefn -> Map Text DeclDefn forall k a. Ord k => k -> a -> Map k a -> Map k a Map.insert Text fname (DeclDefn :: Maybe (FilePath, Lexeme Text) -> Maybe (FilePath, Lexeme Text) -> DeclDefn DeclDefn{ decl :: Maybe (FilePath, Lexeme Text) decl = (FilePath, Lexeme Text) -> Maybe (FilePath, Lexeme Text) forall a. a -> Maybe a Just (FilePath file, Lexeme Text fn), defn :: Maybe (FilePath, Lexeme Text) defn = Maybe (FilePath, Lexeme Text) forall a. Maybe a Nothing }) Map Text DeclDefn pairs Just DeclDefn dd -> Text -> DeclDefn -> Map Text DeclDefn -> Map Text DeclDefn forall k a. Ord k => k -> a -> Map k a -> Map k a Map.insert Text fname (DeclDefn dd { decl :: Maybe (FilePath, Lexeme Text) decl = (FilePath, Lexeme Text) -> Maybe (FilePath, Lexeme Text) forall a. a -> Maybe a Just (FilePath file, Lexeme Text fn) }) Map Text DeclDefn pairs State (Map Text DeclDefn) (Node () (Lexeme Text)) act FunctionDefn Scope _ (FunctionPrototype Node () (Lexeme Text) _ fn :: Lexeme Text fn@(L AlexPosn _ LexemeClass IdVar Text fname) [Node () (Lexeme Text)] _) [Node () (Lexeme Text)] _ -> do (Map Text DeclDefn -> Map Text DeclDefn) -> State (Map Text DeclDefn) () forall s (m :: * -> *). MonadState s m => (s -> s) -> m () State.modify ((Map Text DeclDefn -> Map Text DeclDefn) -> State (Map Text DeclDefn) ()) -> (Map Text DeclDefn -> Map Text DeclDefn) -> State (Map Text DeclDefn) () forall a b. (a -> b) -> a -> b $ \Map Text DeclDefn pairs -> case Text -> Map Text DeclDefn -> Maybe DeclDefn forall k a. Ord k => k -> Map k a -> Maybe a Map.lookup Text fname Map Text DeclDefn pairs of Maybe DeclDefn Nothing -> Text -> DeclDefn -> Map Text DeclDefn -> Map Text DeclDefn forall k a. Ord k => k -> a -> Map k a -> Map k a Map.insert Text fname (DeclDefn :: Maybe (FilePath, Lexeme Text) -> Maybe (FilePath, Lexeme Text) -> DeclDefn DeclDefn{ decl :: Maybe (FilePath, Lexeme Text) decl = Maybe (FilePath, Lexeme Text) forall a. Maybe a Nothing, defn :: Maybe (FilePath, Lexeme Text) defn = (FilePath, Lexeme Text) -> Maybe (FilePath, Lexeme Text) forall a. a -> Maybe a Just (FilePath file, Lexeme Text fn) }) Map Text DeclDefn pairs Just DeclDefn dd -> Text -> DeclDefn -> Map Text DeclDefn -> Map Text DeclDefn forall k a. Ord k => k -> a -> Map k a -> Map k a Map.insert Text fname (DeclDefn dd { defn :: Maybe (FilePath, Lexeme Text) defn = (FilePath, Lexeme Text) -> Maybe (FilePath, Lexeme Text) forall a. a -> Maybe a Just (FilePath file, Lexeme Text fn) }) Map Text DeclDefn pairs State (Map Text DeclDefn) (Node () (Lexeme Text)) act Node () (Lexeme Text) _ -> State (Map Text DeclDefn) (Node () (Lexeme Text)) act } analyse :: [(FilePath, [Node () (Lexeme Text)])] -> [Text] analyse :: [(FilePath, [Node () (Lexeme Text)])] -> [Text] analyse = ((FilePath, Lexeme Text) -> Text) -> [(FilePath, Lexeme Text)] -> [Text] forall a b. (a -> b) -> [a] -> [b] map (FilePath, Lexeme Text) -> Text makeDiagnostic ([(FilePath, Lexeme Text)] -> [Text]) -> ([(FilePath, [Node () (Lexeme Text)])] -> [(FilePath, Lexeme Text)]) -> [(FilePath, [Node () (Lexeme Text)])] -> [Text] forall b c a. (b -> c) -> (a -> b) -> a -> c . (DeclDefn -> Maybe (FilePath, Lexeme Text)) -> [DeclDefn] -> [(FilePath, Lexeme Text)] forall a b. (a -> Maybe b) -> [a] -> [b] mapMaybe DeclDefn -> Maybe (FilePath, Lexeme Text) lacksDefn ([DeclDefn] -> [(FilePath, Lexeme Text)]) -> ([(FilePath, [Node () (Lexeme Text)])] -> [DeclDefn]) -> [(FilePath, [Node () (Lexeme Text)])] -> [(FilePath, Lexeme Text)] forall b c a. (b -> c) -> (a -> b) -> a -> c . Map Text DeclDefn -> [DeclDefn] forall k a. Map k a -> [a] Map.elems (Map Text DeclDefn -> [DeclDefn]) -> ([(FilePath, [Node () (Lexeme Text)])] -> Map Text DeclDefn) -> [(FilePath, [Node () (Lexeme Text)])] -> [DeclDefn] forall b c a. (b -> c) -> (a -> b) -> a -> c . (State (Map Text DeclDefn) [(FilePath, [Node () (Lexeme Text)])] -> Map Text DeclDefn -> Map Text DeclDefn) -> Map Text DeclDefn -> State (Map Text DeclDefn) [(FilePath, [Node () (Lexeme Text)])] -> Map Text DeclDefn forall a b c. (a -> b -> c) -> b -> a -> c flip State (Map Text DeclDefn) [(FilePath, [Node () (Lexeme Text)])] -> Map Text DeclDefn -> Map Text DeclDefn forall s a. State s a -> s -> s State.execState Map Text DeclDefn forall k a. Map k a Map.empty (State (Map Text DeclDefn) [(FilePath, [Node () (Lexeme Text)])] -> Map Text DeclDefn) -> ([(FilePath, [Node () (Lexeme Text)])] -> State (Map Text DeclDefn) [(FilePath, [Node () (Lexeme Text)])]) -> [(FilePath, [Node () (Lexeme Text)])] -> Map Text DeclDefn forall b c a. (b -> c) -> (a -> b) -> a -> c . AstActions (Map Text DeclDefn) -> [(FilePath, [Node () (Lexeme Text)])] -> State (Map Text DeclDefn) [(FilePath, [Node () (Lexeme Text)])] forall iattr oattr itext otext a (f :: * -> *). (TraverseAst iattr oattr itext otext a a, Applicative f) => AstActions f iattr oattr itext otext -> a -> f a traverseAst AstActions (Map Text DeclDefn) collectPairs ([(FilePath, [Node () (Lexeme Text)])] -> State (Map Text DeclDefn) [(FilePath, [Node () (Lexeme Text)])]) -> ([(FilePath, [Node () (Lexeme Text)])] -> [(FilePath, [Node () (Lexeme Text)])]) -> [(FilePath, [Node () (Lexeme Text)])] -> State (Map Text DeclDefn) [(FilePath, [Node () (Lexeme Text)])] forall b c a. (b -> c) -> (a -> b) -> a -> c . ((FilePath, [Node () (Lexeme Text)]) -> Bool) -> [(FilePath, [Node () (Lexeme Text)])] -> [(FilePath, [Node () (Lexeme Text)])] forall a. (a -> Bool) -> [a] -> [a] filter (Bool -> Bool not (Bool -> Bool) -> ((FilePath, [Node () (Lexeme Text)]) -> Bool) -> (FilePath, [Node () (Lexeme Text)]) -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . (FilePath -> [FilePath] -> Bool forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool `elem` [FilePath "ccompat.h", FilePath "tox.h"]) (FilePath -> Bool) -> ((FilePath, [Node () (Lexeme Text)]) -> FilePath) -> (FilePath, [Node () (Lexeme Text)]) -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . FilePath -> FilePath takeFileName (FilePath -> FilePath) -> ((FilePath, [Node () (Lexeme Text)]) -> FilePath) -> (FilePath, [Node () (Lexeme Text)]) -> FilePath forall b c a. (b -> c) -> (a -> b) -> a -> c . (FilePath, [Node () (Lexeme Text)]) -> FilePath forall a b. (a, b) -> a fst) where lacksDefn :: DeclDefn -> Maybe (FilePath, Lexeme Text) lacksDefn DeclDefn{Maybe (FilePath, Lexeme Text) decl :: Maybe (FilePath, Lexeme Text) decl :: DeclDefn -> Maybe (FilePath, Lexeme Text) decl, defn :: DeclDefn -> Maybe (FilePath, Lexeme Text) defn = Maybe (FilePath, Lexeme Text) Nothing} = Maybe (FilePath, Lexeme Text) decl lacksDefn DeclDefn _ = Maybe (FilePath, Lexeme Text) forall a. Maybe a Nothing makeDiagnostic :: (FilePath, Lexeme Text) -> Text makeDiagnostic (FilePath file, fn :: Lexeme Text fn@(L AlexPosn _ LexemeClass _ Text fname)) = FilePath -> Lexeme Text -> Text forall text. FilePath -> Lexeme text -> Text Diagnostics.sloc FilePath file Lexeme Text fn Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text ": missing definition for `" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text fname Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "'"