{-# LANGUAGE OverloadedStrings #-}
module Tokstyle.Cimple.Analysis.FuncScopes (analyse) where

import           Control.Monad               (foldM, when)
import qualified Control.Monad.State.Lazy    as State
import           Data.Text                   (Text)
import qualified Data.Text                   as Text
import           Language.Cimple             (Lexeme (..), Node (..),
                                              Scope (..), lexemeLine,
                                              lexemeText)
import           Language.Cimple.Diagnostics (warn)


analyse :: (FilePath, [Node a (Lexeme Text)]) -> [Text]
analyse :: (FilePath, [Node a (Lexeme Text)]) -> [Text]
analyse (FilePath
file, [Node a (Lexeme Text)]
ast) = [Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ ([(Text, (Lexeme Text, Scope))], [Text]) -> [Text]
forall a b. (a, b) -> b
snd (([(Text, (Lexeme Text, Scope))], [Text]) -> [Text])
-> ([(Text, (Lexeme Text, Scope))], [Text]) -> [Text]
forall a b. (a -> b) -> a -> b
$ State [Text] [(Text, (Lexeme Text, Scope))]
-> [Text] -> ([(Text, (Lexeme Text, Scope))], [Text])
forall s a. State s a -> s -> (a, s)
State.runState (([(Text, (Lexeme Text, Scope))]
 -> Node a (Lexeme Text)
 -> State [Text] [(Text, (Lexeme Text, Scope))])
-> [(Text, (Lexeme Text, Scope))]
-> [Node a (Lexeme Text)]
-> State [Text] [(Text, (Lexeme Text, Scope))]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM [(Text, (Lexeme Text, Scope))]
-> Node a (Lexeme Text)
-> State [Text] [(Text, (Lexeme Text, Scope))]
forall diags attr.
HasDiagnostics diags =>
[(Text, (Lexeme Text, Scope))]
-> Node attr (Lexeme Text)
-> StateT diags Identity [(Text, (Lexeme Text, Scope))]
go [] [Node a (Lexeme Text)]
ast) []
  where
    go :: [(Text, (Lexeme Text, Scope))]
-> Node attr (Lexeme Text)
-> StateT diags Identity [(Text, (Lexeme Text, Scope))]
go [(Text, (Lexeme Text, Scope))]
decls (FunctionDecl Scope
declScope (FunctionPrototype Node attr (Lexeme Text)
_ Lexeme Text
name [Node attr (Lexeme Text)]
_) Maybe (Node attr (Lexeme Text))
_) =
        [(Text, (Lexeme Text, Scope))]
-> StateT diags Identity [(Text, (Lexeme Text, Scope))]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Text, (Lexeme Text, Scope))]
 -> StateT diags Identity [(Text, (Lexeme Text, Scope))])
-> [(Text, (Lexeme Text, Scope))]
-> StateT diags Identity [(Text, (Lexeme Text, Scope))]
forall a b. (a -> b) -> a -> b
$ (Lexeme Text -> Text
forall text. Lexeme text -> text
lexemeText Lexeme Text
name, (Lexeme Text
name, Scope
declScope)) (Text, (Lexeme Text, Scope))
-> [(Text, (Lexeme Text, Scope))] -> [(Text, (Lexeme Text, Scope))]
forall a. a -> [a] -> [a]
: [(Text, (Lexeme Text, Scope))]
decls
    go [(Text, (Lexeme Text, Scope))]
decls (FunctionDefn Scope
defnScope (FunctionPrototype Node attr (Lexeme Text)
_ Lexeme Text
name [Node attr (Lexeme Text)]
_) [Node attr (Lexeme Text)]
_) =
        case Text
-> [(Text, (Lexeme Text, Scope))] -> Maybe (Lexeme Text, Scope)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Lexeme Text -> Text
forall text. Lexeme text -> text
lexemeText Lexeme Text
name) [(Text, (Lexeme Text, Scope))]
decls of
            Maybe (Lexeme Text, Scope)
Nothing -> [(Text, (Lexeme Text, Scope))]
-> StateT diags Identity [(Text, (Lexeme Text, Scope))]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Text, (Lexeme Text, Scope))]
decls
            Just (Lexeme Text
decl, Scope
declScope) -> do
                Bool -> StateT diags Identity () -> StateT diags Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Scope
declScope Scope -> Scope -> Bool
forall a. Eq a => a -> a -> Bool
/= Scope
defnScope) (StateT diags Identity () -> StateT diags Identity ())
-> StateT diags Identity () -> StateT diags Identity ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Lexeme Text -> Text -> StateT diags Identity ()
forall diags.
HasDiagnostics diags =>
FilePath -> Lexeme Text -> Text -> DiagnosticsT diags ()
warn FilePath
file Lexeme Text
name (Text -> StateT diags Identity ())
-> Text -> StateT diags Identity ()
forall a b. (a -> b) -> a -> b
$
                    Lexeme Text -> Scope -> Scope -> Text
warning Lexeme Text
decl Scope
declScope Scope
defnScope
                [(Text, (Lexeme Text, Scope))]
-> StateT diags Identity [(Text, (Lexeme Text, Scope))]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Text, (Lexeme Text, Scope))]
decls
    go [(Text, (Lexeme Text, Scope))]
decls Node attr (Lexeme Text)
_ = [(Text, (Lexeme Text, Scope))]
-> StateT diags Identity [(Text, (Lexeme Text, Scope))]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Text, (Lexeme Text, Scope))]
decls

    warning :: Lexeme Text -> Scope -> Scope -> Text
warning Lexeme Text
decl Scope
declScope Scope
defnScope =
        Text
"function definition `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Lexeme Text -> Text
forall text. Lexeme text -> text
lexemeText Lexeme Text
decl
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' does not agree with its declaration about scope: "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"declaration on line " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Text.pack (Int -> FilePath
forall a. Show a => a -> FilePath
show (Lexeme Text -> Int
forall text. Lexeme text -> Int
lexemeLine Lexeme Text
decl))
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Scope -> Text
forall p. IsString p => Scope -> p
scopeKeyword Scope
declScope Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" but definition is "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Scope -> Text
forall p. IsString p => Scope -> p
scopeKeyword Scope
defnScope

    scopeKeyword :: Scope -> p
scopeKeyword Scope
Global = p
"extern"
    scopeKeyword Scope
Static = p
"static"