{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Strict            #-}
module Tokstyle.Linter.LoggerNoEscapes (descr) where

import           Control.Monad               (when)
import           Control.Monad.State.Strict  (State)
import qualified Control.Monad.State.Strict  as State
import           Data.Fix                    (Fix (..))
import           Data.Text                   (Text)
import qualified Data.Text                   as Text
import           Language.Cimple             (Lexeme (..), LiteralType (String),
                                              Node, NodeF (..), lexemeText)
import qualified Language.Cimple.Diagnostics as Diagnostics
import           Language.Cimple.TraverseAst (AstActions, astActions, doNode,
                                              traverseAst)


linter :: AstActions (State [Text]) Text
linter :: AstActions (State [Text]) Text
linter = AstActions (State [Text]) Text
forall (f :: * -> *) text. Applicative f => AstActions f text
astActions
    { doNode :: FilePath
-> Node (Lexeme Text) -> State [Text] () -> State [Text] ()
doNode = \FilePath
file Node (Lexeme Text)
node State [Text] ()
act -> case Node (Lexeme Text) -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Node (Lexeme Text)
node of
        -- LOGGER_ASSERT has its format as the third parameter.
        FunctionCall (Fix (LiteralExpr LiteralType
_ (L AlexPosn
_ LexemeClass
_ Text
"LOGGER_ASSERT"))) (Node (Lexeme Text)
_ : Node (Lexeme Text)
_ : Fix (LiteralExpr LiteralType
String Lexeme Text
fmt) : [Node (Lexeme Text)]
_)
            -> do
                FilePath -> Lexeme Text -> State [Text] ()
checkFormat FilePath
file Lexeme Text
fmt
                State [Text] ()
act

        FunctionCall (Fix (LiteralExpr LiteralType
_ (L AlexPosn
_ LexemeClass
_ Text
func))) (Node (Lexeme Text)
_ : Fix (LiteralExpr LiteralType
String Lexeme Text
fmt) : [Node (Lexeme Text)]
_)
            | Text -> Text -> Bool
Text.isPrefixOf Text
"LOGGER_" Text
func
            -> do
                FilePath -> Lexeme Text -> State [Text] ()
checkFormat FilePath
file Lexeme Text
fmt
                State [Text] ()
act

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


checkFormat :: FilePath -> Lexeme Text -> State [Text] ()
checkFormat :: FilePath -> Lexeme Text -> State [Text] ()
checkFormat FilePath
file Lexeme Text
fmt =
    Bool -> State [Text] () -> State [Text] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
"\\" Text -> Text -> Bool
`Text.isInfixOf` Text
text) (State [Text] () -> State [Text] ())
-> State [Text] () -> State [Text] ()
forall a b. (a -> b) -> a -> b
$
        FilePath -> Lexeme Text -> Text -> State [Text] ()
forall at diags.
(HasLocation at, HasDiagnostics diags) =>
FilePath -> at -> Text -> DiagnosticsT diags ()
Diagnostics.warn FilePath
file Lexeme Text
fmt (Text -> State [Text] ()) -> Text -> State [Text] ()
forall a b. (a -> b) -> a -> b
$
            Text
"logger format "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
text
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" contains escape sequences (newlines, tabs, or escaped quotes)"
    where text :: Text
text = Lexeme Text -> Text
forall text. Lexeme text -> text
lexemeText Lexeme Text
fmt


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] () -> [Text] -> [Text])
-> [Text] -> State [Text] () -> [Text]
forall a b c. (a -> b -> c) -> b -> a -> c
flip State [Text] () -> [Text] -> [Text]
forall s a. State s a -> s -> s
State.execState [] (State [Text] () -> [Text])
-> ((FilePath, [Node (Lexeme Text)]) -> State [Text] ())
-> (FilePath, [Node (Lexeme Text)])
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AstActions (State [Text]) Text
-> (FilePath, [Node (Lexeme Text)]) -> State [Text] ()
forall text a (f :: * -> *).
(TraverseAst text a, Applicative f) =>
AstActions f text -> a -> f ()
traverseAst AstActions (State [Text]) Text
linter

descr :: ((FilePath, [Node (Lexeme Text)]) -> [Text], (Text, Text))
descr :: ((FilePath, [Node (Lexeme Text)]) -> [Text], (Text, Text))
descr = ((FilePath, [Node (Lexeme Text)]) -> [Text]
analyse, (Text
"logger-no-escapes", [Text] -> Text
Text.unlines
    [ Text
"Checks that no escape sequences are present in the logger format string."
    , Text
""
    , Text
"**Reason:** newlines, tabs, or double quotes are not permitted in log outputs"
    , Text
"to ensure that each log output is a single line. It's particularly easy to"
    , Text
"accidentally add `\\n` to the end of a log format. This avoids that problem."
    ]))