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

import           Control.Monad               (when)
import           Control.Monad.State.Strict  (State)
import qualified Control.Monad.State.Strict  as State
import           Data.Fix                    (Fix (..), foldFix)
import           Data.Text                   (Text)
import qualified Data.Text                   as Text
import           Language.Cimple             (Lexeme (..), Node, NodeF (..))
import           Language.Cimple.Diagnostics (CimplePos, Diagnostic)
import           Language.Cimple.TraverseAst (AstActions, astActions, doNode,
                                              traverseAst)
import           Prettyprinter               (pretty)
import           Tokstyle.Common             (warnDoc)

maxNesting :: Int
maxNesting :: Int
maxNesting = Int
7  -- TODO(iphydf): Reduce.

countNesting :: NodeF (Lexeme Text) Int -> Int
countNesting :: NodeF (Lexeme Text) Int -> Int
countNesting = \case
    CompoundStmt [Int]
ns -> Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int -> Int -> Int) -> Int -> [Int] -> Int
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 [Int]
ns
    NodeF (Lexeme Text) Int
ns              -> (Int -> Int -> Int) -> Int -> NodeF (Lexeme Text) Int -> Int
forall a b. (a -> b -> b) -> b -> NodeF (Lexeme Text) a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 NodeF (Lexeme Text) Int
ns


linter :: AstActions (State [Diagnostic CimplePos]) Text
linter :: AstActions (StateT [Diagnostic CimplePos] Identity) Text
linter = AstActions (StateT [Diagnostic CimplePos] Identity) Text
forall (f :: * -> *) text. Applicative f => AstActions f text
astActions
    { doNode = \FilePath
file Node (Lexeme Text)
node StateT [Diagnostic CimplePos] Identity ()
act ->
        case Node (Lexeme Text) -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Node (Lexeme Text)
node of
            FunctionDefn{} ->
                let nesting :: Int
nesting = (NodeF (Lexeme Text) Int -> Int) -> Node (Lexeme Text) -> Int
forall (f :: * -> *) a. Functor f => (f a -> a) -> Fix f -> a
foldFix NodeF (Lexeme Text) Int -> Int
countNesting Node (Lexeme Text)
node in
                Bool
-> StateT [Diagnostic CimplePos] Identity ()
-> StateT [Diagnostic CimplePos] Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
nesting Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxNesting) (StateT [Diagnostic CimplePos] Identity ()
 -> StateT [Diagnostic CimplePos] Identity ())
-> StateT [Diagnostic CimplePos] Identity ()
-> StateT [Diagnostic CimplePos] Identity ()
forall a b. (a -> b) -> a -> b
$
                    FilePath
-> Node (Lexeme Text)
-> Doc AnsiStyle
-> StateT [Diagnostic CimplePos] Identity ()
forall diags at.
(HasDiagnosticsRich diags CimplePos,
 HasDiagnosticInfo at CimplePos) =>
FilePath -> at -> Doc AnsiStyle -> DiagnosticsT diags ()
warnDoc FilePath
file Node (Lexeme Text)
node (Doc AnsiStyle -> StateT [Diagnostic CimplePos] Identity ())
-> Doc AnsiStyle -> StateT [Diagnostic CimplePos] Identity ()
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"function is too deeply nested: "
                        Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Text -> Doc AnsiStyle
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (FilePath -> Text
Text.pack (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
nesting)) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
" is deeper than the "
                        Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
"maximum allowed of " Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Text -> Doc AnsiStyle
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (FilePath -> Text
Text.pack (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
maxNesting))
                        Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
"; consider inversion or extraction"

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

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
. (StateT [Diagnostic CimplePos] Identity ()
 -> [Diagnostic CimplePos] -> [Diagnostic CimplePos])
-> [Diagnostic CimplePos]
-> StateT [Diagnostic CimplePos] Identity ()
-> [Diagnostic CimplePos]
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT [Diagnostic CimplePos] Identity ()
-> [Diagnostic CimplePos] -> [Diagnostic CimplePos]
forall s a. State s a -> s -> s
State.execState [] (StateT [Diagnostic CimplePos] Identity ()
 -> [Diagnostic CimplePos])
-> ((FilePath, [Node (Lexeme Text)])
    -> StateT [Diagnostic CimplePos] Identity ())
-> (FilePath, [Node (Lexeme Text)])
-> [Diagnostic CimplePos]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AstActions (StateT [Diagnostic CimplePos] Identity) Text
-> (FilePath, [Node (Lexeme Text)])
-> StateT [Diagnostic CimplePos] Identity ()
forall text a (f :: * -> *).
(TraverseAst text a, Applicative f) =>
AstActions f text -> a -> f ()
traverseAst AstActions (StateT [Diagnostic CimplePos] Identity) 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
"nesting", [Text] -> Text
Text.unlines
    [ Text
"Warns if a function has more than " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Text.pack (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
maxNesting) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" nesting levels."
    , Text
""
    , Text
"**Reason:** deep nesting makes functions more difficult to comprehend."
    ]))