{-# 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 (warn)
import           Language.Cimple.TraverseAst (AstActions, astActions, doNode,
                                              traverseAst)

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 (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 (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 [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
            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 -> State [Text] () -> State [Text] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
nesting Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxNesting) (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 is too deeply nested: "
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Text.pack (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
nesting) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is deeper than the "
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"maximum allowed of " 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
"; consider inversion or extraction"

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