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

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


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
            -- Ignore all function calls where the second argument is a string
            -- literal. If it's a logger call, it's a valid one.
            FunctionCall Node () (Lexeme Text)
_ (Node () (Lexeme Text)
_:LiteralExpr LiteralType
String Lexeme Text
_:[Node () (Lexeme Text)]
_) -> State [Text] (Node () (Lexeme Text))
act
            -- LOGGER_ASSERT has its format as the third parameter.
            FunctionCall (LiteralExpr LiteralType
_ (L AlexPosn
_ LexemeClass
_ Text
"LOGGER_ASSERT")) (Node () (Lexeme Text)
_:Node () (Lexeme Text)
_:LiteralExpr LiteralType
String Lexeme Text
_:[Node () (Lexeme Text)]
_) -> State [Text] (Node () (Lexeme Text))
act

            FunctionCall (LiteralExpr LiteralType
_ name :: Lexeme Text
name@(L AlexPosn
_ LexemeClass
_ Text
func)) [Node () (Lexeme Text)]
_ | Text -> Text -> Bool
Text.isPrefixOf Text
"LOGGER_" Text
func -> 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 -> DiagnosticsT [Text] ()) -> Text -> DiagnosticsT [Text] ()
forall a b. (a -> b) -> a -> b
$ Text
"logger call `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
func Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' has a non-literal format argument"
                State [Text] (Node () (Lexeme Text))
act

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


analyse :: (FilePath, [Node () (Lexeme Text)]) -> [Text]
-- Ignore logger.h, which contains a bunch of macros that call LOGGER functions
-- with their (literal) arguments. We don't know that they are literals at this
-- point, though.
analyse :: (FilePath, [Node () (Lexeme Text)]) -> [Text]
analyse (FilePath
file, [Node () (Lexeme Text)]
_) | FilePath -> FilePath
takeFileName FilePath
file FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"logger.h" = []
analyse (FilePath, [Node () (Lexeme Text)])
tu = [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 ((FilePath, [Node () (Lexeme Text)]) -> [Text])
-> (FilePath, [Node () (Lexeme Text)]) -> [Text]
forall a b. (a -> b) -> a -> b
$ (FilePath, [Node () (Lexeme Text)])
tu