{-# 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           Language.Cimple.Diagnostics (CimplePos, Diagnostic)
import           Language.Cimple.TraverseAst (AstActions, astActions, doNode,
                                              traverseAst)
import           Prettyprinter               (pretty, (<+>))
import           Tokstyle.Common             (warn, warnDoc)


linter :: AstActions (State [Diagnostic CimplePos]) Text
linter :: AstActions (State [Diagnostic CimplePos]) Text
linter = AstActions (State [Diagnostic CimplePos]) Text
forall (f :: * -> *) text. Applicative f => AstActions f text
astActions
    { doNode :: FilePath
-> Node (Lexeme Text)
-> State [Diagnostic CimplePos] ()
-> State [Diagnostic CimplePos] ()
doNode = \FilePath
file Node (Lexeme Text)
node State [Diagnostic CimplePos] ()
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 [Diagnostic CimplePos] ()
checkFormat FilePath
file Lexeme Text
fmt
                State [Diagnostic CimplePos] ()
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 [Diagnostic CimplePos] ()
checkFormat FilePath
file Lexeme Text
fmt
                State [Diagnostic CimplePos] ()
act

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


checkFormat :: FilePath -> Lexeme Text -> State [Diagnostic CimplePos] ()
checkFormat :: FilePath -> Lexeme Text -> State [Diagnostic CimplePos] ()
checkFormat FilePath
file Lexeme Text
fmt =
    Bool
-> State [Diagnostic CimplePos] ()
-> State [Diagnostic CimplePos] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
"\\" Text -> Text -> Bool
`Text.isInfixOf` Text
text) (State [Diagnostic CimplePos] ()
 -> State [Diagnostic CimplePos] ())
-> State [Diagnostic CimplePos] ()
-> State [Diagnostic CimplePos] ()
forall a b. (a -> b) -> a -> b
$
        FilePath
-> Lexeme Text -> Doc AnsiStyle -> State [Diagnostic CimplePos] ()
forall diags at.
(HasDiagnosticsRich diags CimplePos,
 HasDiagnosticInfo at CimplePos) =>
FilePath -> at -> Doc AnsiStyle -> DiagnosticsT diags ()
warnDoc FilePath
file Lexeme Text
fmt (Doc AnsiStyle -> State [Diagnostic CimplePos] ())
-> Doc AnsiStyle -> State [Diagnostic CimplePos] ()
forall a b. (a -> b) -> a -> b
$
            Doc AnsiStyle
"logger format"
            Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty Text
text
            Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
"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)]) -> [Diagnostic CimplePos]
analyse :: (FilePath, [Node (Lexeme Text)]) -> [Diagnostic CimplePos]
analyse = [Diagnostic CimplePos] -> [Diagnostic CimplePos]
forall a. [a] -> [a]
reverse ([Diagnostic CimplePos] -> [Diagnostic CimplePos])
-> ((FilePath, [Node (Lexeme Text)]) -> [Diagnostic CimplePos])
-> (FilePath, [Node (Lexeme Text)])
-> [Diagnostic CimplePos]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State [Diagnostic CimplePos] ()
 -> [Diagnostic CimplePos] -> [Diagnostic CimplePos])
-> [Diagnostic CimplePos]
-> State [Diagnostic CimplePos] ()
-> [Diagnostic CimplePos]
forall a b c. (a -> b -> c) -> b -> a -> c
flip State [Diagnostic CimplePos] ()
-> [Diagnostic CimplePos] -> [Diagnostic CimplePos]
forall s a. State s a -> s -> s
State.execState [] (State [Diagnostic CimplePos] () -> [Diagnostic CimplePos])
-> ((FilePath, [Node (Lexeme Text)])
    -> State [Diagnostic CimplePos] ())
-> (FilePath, [Node (Lexeme Text)])
-> [Diagnostic CimplePos]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AstActions (State [Diagnostic CimplePos]) Text
-> (FilePath, [Node (Lexeme Text)])
-> State [Diagnostic CimplePos] ()
forall text a (f :: * -> *).
(TraverseAst text a, Applicative f) =>
AstActions f text -> a -> f ()
traverseAst AstActions (State [Diagnostic CimplePos]) Text
linter

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
"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."
    ]))