{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StrictData #-} module Tokstyle.Cimple.Analysis.DeclaredOnce (analyse) where import qualified Control.Monad.State.Lazy as State import Data.Map (Map) import qualified Data.Map as Map import Data.Text (Text) import Language.Cimple (AstActions, Lexeme (..), LexemeClass (..), Node (..), defaultActions, doNode, traverseAst) import Language.Cimple.Diagnostics (HasDiagnostics (..), warn) data Linter = Linter { Linter -> [Text] diags :: [Text] , Linter -> Map Text (FilePath, Lexeme Text) decls :: Map Text (FilePath, Lexeme Text) } empty :: Linter empty :: Linter empty = [Text] -> Map Text (FilePath, Lexeme Text) -> Linter Linter [] Map Text (FilePath, Lexeme Text) forall k a. Map k a Map.empty instance HasDiagnostics Linter where addDiagnostic :: Text -> Linter -> Linter addDiagnostic Text diag l :: Linter l@Linter{[Text] diags :: [Text] diags :: Linter -> [Text] diags} = Linter l{diags :: [Text] diags = Text -> [Text] -> [Text] forall a. HasDiagnostics a => Text -> a -> a addDiagnostic Text diag [Text] diags} linter :: AstActions Linter linter :: AstActions Linter linter = AstActions Linter forall a. IdentityActions (State a) () Text defaultActions { doNode :: FilePath -> Node () (Lexeme Text) -> State Linter (Node () (Lexeme Text)) -> State Linter (Node () (Lexeme Text)) doNode = \FilePath file Node () (Lexeme Text) node State Linter (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 l :: Linter l@Linter{Map Text (FilePath, Lexeme Text) decls :: Map Text (FilePath, Lexeme Text) decls :: Linter -> Map Text (FilePath, Lexeme Text) decls} <- State Linter Linter forall s (m :: * -> *). MonadState s m => m s State.get case Text -> Map Text (FilePath, Lexeme Text) -> Maybe (FilePath, Lexeme Text) forall k a. Ord k => k -> Map k a -> Maybe a Map.lookup Text fname Map Text (FilePath, Lexeme Text) decls of Maybe (FilePath, Lexeme Text) Nothing -> Linter -> State Linter () forall s (m :: * -> *). MonadState s m => s -> m () State.put Linter l{decls :: Map Text (FilePath, Lexeme Text) decls = Text -> (FilePath, Lexeme Text) -> Map Text (FilePath, Lexeme Text) -> Map Text (FilePath, Lexeme Text) forall k a. Ord k => k -> a -> Map k a -> Map k a Map.insert Text fname (FilePath file, Lexeme Text fn) Map Text (FilePath, Lexeme Text) decls } Just (FilePath file', Lexeme Text fn') -> do FilePath -> Lexeme Text -> Text -> State Linter () forall diags. HasDiagnostics diags => FilePath -> Lexeme Text -> Text -> DiagnosticsT diags () warn FilePath file' Lexeme Text fn' (Text -> State Linter ()) -> Text -> State Linter () forall a b. (a -> b) -> a -> b $ Text "duplicate declaration of function `" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text fname Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "'" FilePath -> Lexeme Text -> Text -> State Linter () forall diags. HasDiagnostics diags => FilePath -> Lexeme Text -> Text -> DiagnosticsT diags () warn FilePath file Lexeme Text fn (Text -> State Linter ()) -> Text -> State Linter () forall a b. (a -> b) -> a -> b $ Text "function `" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text fname Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' also declared here" State Linter (Node () (Lexeme Text)) act Node () (Lexeme Text) _ -> State Linter (Node () (Lexeme Text)) act } analyse :: [(FilePath, [Node () (Lexeme Text)])] -> [Text] analyse :: [(FilePath, [Node () (Lexeme Text)])] -> [Text] analyse [(FilePath, [Node () (Lexeme Text)])] tus = [Text] -> [Text] forall a. [a] -> [a] reverse ([Text] -> [Text]) -> (Linter -> [Text]) -> Linter -> [Text] forall b c a. (b -> c) -> (a -> b) -> a -> c . Linter -> [Text] diags (Linter -> [Text]) -> Linter -> [Text] forall a b. (a -> b) -> a -> b $ State Linter [(FilePath, [Node () (Lexeme Text)])] -> Linter -> Linter forall s a. State s a -> s -> s State.execState (AstActions Linter -> [(FilePath, [Node () (Lexeme Text)])] -> State Linter [(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 Linter linter [(FilePath, [Node () (Lexeme Text)])] tus) Linter empty