{-# LANGUAGE OverloadedStrings #-}
module Tokstyle.Cimple.Analysis.FuncPrototypes (analyse) where

import qualified Control.Monad.State.Lazy    as State
import           Data.Text                   (Text)
import           Language.Cimple             (AstActions, Lexeme, Node (..),
                                              defaultActions, doNode,
                                              traverseAst)
import qualified Language.Cimple.Diagnostics as Diagnostics


linter :: AstActions [Text]
linter :: AstActions [Text]
linter = AstActions [Text]
forall a. IdentityActions (State a) () Text
defaultActions
    { doNode :: FilePath
-> Node () (Lexeme Text)
-> State [Text] (Node () (Lexeme Text))
-> State [Text] (Node () (Lexeme Text))
doNode = \FilePath
file Node () (Lexeme Text)
node State [Text] (Node () (Lexeme Text))
act ->
        case Node () (Lexeme Text)
node of
            FunctionPrototype Node () (Lexeme Text)
_ Lexeme Text
name [] -> do
                FilePath -> Lexeme Text -> Text -> DiagnosticsT [Text] ()
forall diags.
HasDiagnostics diags =>
FilePath -> Lexeme Text -> Text -> DiagnosticsT diags ()
Diagnostics.warn FilePath
file Lexeme Text
name Text
"empty parameter list must be written as (void)"
                State [Text] (Node () (Lexeme Text))
act

            Node () (Lexeme Text)
_ -> State [Text] (Node () (Lexeme Text))
act
    }

analyse :: (FilePath, [Node () (Lexeme Text)]) -> [Text]
analyse :: (FilePath, [Node () (Lexeme Text)]) -> [Text]
analyse = [Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text])
-> ((FilePath, [Node () (Lexeme Text)]) -> [Text])
-> (FilePath, [Node () (Lexeme Text)])
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State [Text] (FilePath, [Node () (Lexeme Text)])
 -> [Text] -> [Text])
-> [Text]
-> State [Text] (FilePath, [Node () (Lexeme Text)])
-> [Text]
forall a b c. (a -> b -> c) -> b -> a -> c
flip State [Text] (FilePath, [Node () (Lexeme Text)])
-> [Text] -> [Text]
forall s a. State s a -> s -> s
State.execState [] (State [Text] (FilePath, [Node () (Lexeme Text)]) -> [Text])
-> ((FilePath, [Node () (Lexeme Text)])
    -> State [Text] (FilePath, [Node () (Lexeme Text)]))
-> (FilePath, [Node () (Lexeme Text)])
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AstActions [Text]
-> (FilePath, [Node () (Lexeme Text)])
-> State [Text] (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 [Text]
linter