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

import           Control.Monad               (unless)
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 (..), Node, NodeF (..))
import           Language.Cimple.Diagnostics (warn)
import           Language.Cimple.TraverseAst (AstActions, astActions, doNode,
                                              traverseAst)


allowed :: [Text]
allowed :: [Text]
allowed =
    [ Text
"callback"
    , Text
"cb"
    , Text
"function"
    , Text
"handler"
    ]

isValid :: Text -> Bool
isValid :: Text -> Bool
isValid Text
name = (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
`Text.isSuffixOf` Text
name) [Text]
allowed


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
            VarDecl (Fix (TyPointer (Fix TyFunc{}))) (L AlexPosn
_ LexemeClass
_ Text
varName) [Node (Lexeme Text)]
_ ->
                Bool -> State [Text] () -> State [Text] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
isValid Text
varName) (State [Text] () -> State [Text] ())
-> State [Text] () -> State [Text] ()
forall a b. (a -> b) -> a -> b
$
                    FilePath -> Node (Lexeme Text) -> Text -> State [Text] ()
forall at diags.
(HasLocation at, HasDiagnostics diags) =>
FilePath -> at -> Text -> DiagnosticsT diags ()
warn FilePath
file Node (Lexeme Text)
node (Text -> State [Text] ()) -> Text -> State [Text] ()
forall a b. (a -> b) -> a -> b
$ Text
"function pointer `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
varName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"` should end in `callback`"

            VarDecl (Fix TyFunc{}) (L AlexPosn
_ LexemeClass
_ Text
varName) [Node (Lexeme Text)]
_ ->
                Bool -> State [Text] () -> State [Text] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
isValid Text
varName) (State [Text] () -> State [Text] ())
-> State [Text] () -> State [Text] ()
forall a b. (a -> b) -> a -> b
$
                    FilePath -> Node (Lexeme Text) -> Text -> State [Text] ()
forall at diags.
(HasLocation at, HasDiagnostics diags) =>
FilePath -> at -> Text -> DiagnosticsT diags ()
warn FilePath
file Node (Lexeme Text)
node (Text -> State [Text] ()) -> Text -> State [Text] ()
forall a b. (a -> b) -> a -> b
$ Text
"function pointer parameter `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
varName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"` should end in `callback`"

            NodeF (Lexeme Text) (Node (Lexeme Text))
_ -> State [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] () -> [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
"callback-names", [Text] -> Text
Text.unlines
    [ Text
"Checks for naming conventions for callbacks. Callback names should end in"
    , Text
"`callback`, but the following list of suffixes is permitted:"
    , Text
""
    , Text -> [Text] -> Text
Text.intercalate Text
"\n" ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
x -> Text
"- `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`") ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text]
allowed
    , Text
""
    , Text
"**Reason:** naming conventions help quickly understand the code."
    ]))