{-# 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