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

import           Control.Monad.State.Strict  (State)
import qualified Control.Monad.State.Strict  as State
import           Data.Fix                    (Fix (..))
import           Data.Map                    (Map)
import qualified Data.Map                    as Map
import           Data.Text                   (Text)
import qualified Data.Text                   as Text
import           Language.Cimple             (Lexeme (..), LexemeClass (..),
                                              Node, NodeF (..))
import           Language.Cimple.Diagnostics (CimplePos, Diagnostic,
                                              HasDiagnosticsRich (..))
import           Language.Cimple.TraverseAst (AstActions, astActions, doNode,
                                              traverseAst)
import           Prettyprinter               (pretty, (<+>))
import           Tokstyle.Common             (backticks, warn, warnDoc)


data Linter = Linter
    { Linter -> [Diagnostic CimplePos]
diags :: [Diagnostic CimplePos]
    , Linter -> Map Text (FilePath, Lexeme Text)
decls :: Map Text (FilePath, Lexeme Text)
    }

empty :: Linter
empty :: Linter
empty = [Diagnostic CimplePos]
-> Map Text (FilePath, Lexeme Text) -> Linter
Linter [] Map Text (FilePath, Lexeme Text)
forall k a. Map k a
Map.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}


linter :: AstActions (State Linter) Text
linter :: AstActions (StateT Linter Identity) Text
linter = AstActions (StateT Linter Identity) Text
forall (f :: * -> *) text. Applicative f => AstActions f text
astActions
    { doNode = \FilePath
file Node (Lexeme Text)
node StateT Linter Identity ()
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
_ (Fix (FunctionPrototype Node (Lexeme Text)
_ fn :: Lexeme Text
fn@(L AlexPosn
_ LexemeClass
IdVar Text
fname) [Node (Lexeme Text)]
_)) -> do
                l :: Linter
l@Linter{Map Text (FilePath, Lexeme Text)
decls :: Linter -> Map Text (FilePath, Lexeme Text)
decls :: Map Text (FilePath, Lexeme Text)
decls} <- StateT Linter Identity 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 -> StateT Linter Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
State.put Linter
l{decls = Map.insert fname (file, fn) decls }
                    Just (FilePath
file', Lexeme Text
fn') -> do
                        FilePath
-> Lexeme Text -> Doc AnsiStyle -> StateT Linter Identity ()
forall diags at.
(HasDiagnosticsRich diags CimplePos,
 HasDiagnosticInfo at CimplePos) =>
FilePath -> at -> Doc AnsiStyle -> DiagnosticsT diags ()
warnDoc FilePath
file' Lexeme Text
fn' (Doc AnsiStyle -> StateT Linter Identity ())
-> Doc AnsiStyle -> StateT Linter Identity ()
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"duplicate declaration of function" 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 (Text -> Doc AnsiStyle
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
fname)
                        FilePath
-> Lexeme Text -> Doc AnsiStyle -> StateT Linter Identity ()
forall diags at.
(HasDiagnosticsRich diags CimplePos,
 HasDiagnosticInfo at CimplePos) =>
FilePath -> at -> Doc AnsiStyle -> DiagnosticsT diags ()
warnDoc FilePath
file Lexeme Text
fn (Doc AnsiStyle -> StateT Linter Identity ())
-> Doc AnsiStyle -> StateT Linter Identity ()
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"function" 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 (Text -> Doc AnsiStyle
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
fname) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
"also declared here"

            FunctionDefn{} -> () -> StateT Linter Identity ()
forall a. a -> StateT Linter Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            NodeF (Lexeme Text) (Node (Lexeme Text))
_ -> StateT Linter Identity ()
act
    }

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

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
"declared-once", [Text] -> Text
Text.unlines
    [ Text
"Checks that any function is declared exactly once."
    , Text
""
    , Text
"**Reason:** functions should never be declared in multiple files, and within the"
    , Text
"same file, declaring it twice is unnecessary and confusing."
    ]))