{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData        #-}
module Tokstyle.Cimple.Analysis.DeclsHaveDefns (analyse) where

import qualified Control.Monad.State.Lazy    as State
import           Data.Map                    (Map)
import qualified Data.Map                    as Map
import           Data.Maybe                  (mapMaybe)
import           Data.Text                   (Text)
import           Language.Cimple             (AstActions, Lexeme (..),
                                              LexemeClass (..), Node (..),
                                              defaultActions, doNode,
                                              traverseAst)
import qualified Language.Cimple.Diagnostics as Diagnostics
import           System.FilePath             (takeFileName)


data DeclDefn = DeclDefn
    { DeclDefn -> Maybe (FilePath, Lexeme Text)
decl :: Maybe (FilePath, Lexeme Text)
    , DeclDefn -> Maybe (FilePath, Lexeme Text)
defn :: Maybe (FilePath, Lexeme Text)
    }


collectPairs :: AstActions (Map Text DeclDefn)
collectPairs :: AstActions (Map Text DeclDefn)
collectPairs = AstActions (Map Text DeclDefn)
forall a. IdentityActions (State a) () Text
defaultActions
    { doNode :: FilePath
-> Node () (Lexeme Text)
-> State (Map Text DeclDefn) (Node () (Lexeme Text))
-> State (Map Text DeclDefn) (Node () (Lexeme Text))
doNode = \FilePath
file Node () (Lexeme Text)
node State (Map Text DeclDefn) (Node () (Lexeme Text))
act ->
        case Node () (Lexeme Text)
node of
            FunctionDecl Scope
_ (FunctionPrototype Node () (Lexeme Text)
_ fn :: Lexeme Text
fn@(L AlexPosn
_ LexemeClass
IdVar Text
fname) [Node () (Lexeme Text)]
_) Maybe (Node () (Lexeme Text))
_ -> do
                (Map Text DeclDefn -> Map Text DeclDefn)
-> State (Map Text DeclDefn) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify ((Map Text DeclDefn -> Map Text DeclDefn)
 -> State (Map Text DeclDefn) ())
-> (Map Text DeclDefn -> Map Text DeclDefn)
-> State (Map Text DeclDefn) ()
forall a b. (a -> b) -> a -> b
$ \Map Text DeclDefn
pairs ->
                    case Text -> Map Text DeclDefn -> Maybe DeclDefn
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
fname Map Text DeclDefn
pairs of
                        Maybe DeclDefn
Nothing -> Text -> DeclDefn -> Map Text DeclDefn -> Map Text DeclDefn
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
fname (DeclDefn :: Maybe (FilePath, Lexeme Text)
-> Maybe (FilePath, Lexeme Text) -> DeclDefn
DeclDefn{ decl :: Maybe (FilePath, Lexeme Text)
decl = (FilePath, Lexeme Text) -> Maybe (FilePath, Lexeme Text)
forall a. a -> Maybe a
Just (FilePath
file, Lexeme Text
fn), defn :: Maybe (FilePath, Lexeme Text)
defn = Maybe (FilePath, Lexeme Text)
forall a. Maybe a
Nothing }) Map Text DeclDefn
pairs
                        Just DeclDefn
dd -> Text -> DeclDefn -> Map Text DeclDefn -> Map Text DeclDefn
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
fname (DeclDefn
dd      { decl :: Maybe (FilePath, Lexeme Text)
decl = (FilePath, Lexeme Text) -> Maybe (FilePath, Lexeme Text)
forall a. a -> Maybe a
Just (FilePath
file, Lexeme Text
fn)                 }) Map Text DeclDefn
pairs
                State (Map Text DeclDefn) (Node () (Lexeme Text))
act

            FunctionDefn Scope
_ (FunctionPrototype Node () (Lexeme Text)
_ fn :: Lexeme Text
fn@(L AlexPosn
_ LexemeClass
IdVar Text
fname) [Node () (Lexeme Text)]
_) [Node () (Lexeme Text)]
_ -> do
                (Map Text DeclDefn -> Map Text DeclDefn)
-> State (Map Text DeclDefn) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify ((Map Text DeclDefn -> Map Text DeclDefn)
 -> State (Map Text DeclDefn) ())
-> (Map Text DeclDefn -> Map Text DeclDefn)
-> State (Map Text DeclDefn) ()
forall a b. (a -> b) -> a -> b
$ \Map Text DeclDefn
pairs ->
                    case Text -> Map Text DeclDefn -> Maybe DeclDefn
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
fname Map Text DeclDefn
pairs of
                        Maybe DeclDefn
Nothing -> Text -> DeclDefn -> Map Text DeclDefn -> Map Text DeclDefn
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
fname (DeclDefn :: Maybe (FilePath, Lexeme Text)
-> Maybe (FilePath, Lexeme Text) -> DeclDefn
DeclDefn{ decl :: Maybe (FilePath, Lexeme Text)
decl = Maybe (FilePath, Lexeme Text)
forall a. Maybe a
Nothing, defn :: Maybe (FilePath, Lexeme Text)
defn = (FilePath, Lexeme Text) -> Maybe (FilePath, Lexeme Text)
forall a. a -> Maybe a
Just (FilePath
file, Lexeme Text
fn) }) Map Text DeclDefn
pairs
                        Just DeclDefn
dd -> Text -> DeclDefn -> Map Text DeclDefn -> Map Text DeclDefn
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
fname (DeclDefn
dd      {                 defn :: Maybe (FilePath, Lexeme Text)
defn = (FilePath, Lexeme Text) -> Maybe (FilePath, Lexeme Text)
forall a. a -> Maybe a
Just (FilePath
file, Lexeme Text
fn) }) Map Text DeclDefn
pairs
                State (Map Text DeclDefn) (Node () (Lexeme Text))
act

            Node () (Lexeme Text)
_ -> State (Map Text DeclDefn) (Node () (Lexeme Text))
act
    }

analyse :: [(FilePath, [Node () (Lexeme Text)])] -> [Text]
analyse :: [(FilePath, [Node () (Lexeme Text)])] -> [Text]
analyse =
    ((FilePath, Lexeme Text) -> Text)
-> [(FilePath, Lexeme Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, Lexeme Text) -> Text
makeDiagnostic
    ([(FilePath, Lexeme Text)] -> [Text])
-> ([(FilePath, [Node () (Lexeme Text)])]
    -> [(FilePath, Lexeme Text)])
-> [(FilePath, [Node () (Lexeme Text)])]
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DeclDefn -> Maybe (FilePath, Lexeme Text))
-> [DeclDefn] -> [(FilePath, Lexeme Text)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DeclDefn -> Maybe (FilePath, Lexeme Text)
lacksDefn
    ([DeclDefn] -> [(FilePath, Lexeme Text)])
-> ([(FilePath, [Node () (Lexeme Text)])] -> [DeclDefn])
-> [(FilePath, [Node () (Lexeme Text)])]
-> [(FilePath, Lexeme Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text DeclDefn -> [DeclDefn]
forall k a. Map k a -> [a]
Map.elems
    (Map Text DeclDefn -> [DeclDefn])
-> ([(FilePath, [Node () (Lexeme Text)])] -> Map Text DeclDefn)
-> [(FilePath, [Node () (Lexeme Text)])]
-> [DeclDefn]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State (Map Text DeclDefn) [(FilePath, [Node () (Lexeme Text)])]
 -> Map Text DeclDefn -> Map Text DeclDefn)
-> Map Text DeclDefn
-> State (Map Text DeclDefn) [(FilePath, [Node () (Lexeme Text)])]
-> Map Text DeclDefn
forall a b c. (a -> b -> c) -> b -> a -> c
flip State (Map Text DeclDefn) [(FilePath, [Node () (Lexeme Text)])]
-> Map Text DeclDefn -> Map Text DeclDefn
forall s a. State s a -> s -> s
State.execState Map Text DeclDefn
forall k a. Map k a
Map.empty
    (State (Map Text DeclDefn) [(FilePath, [Node () (Lexeme Text)])]
 -> Map Text DeclDefn)
-> ([(FilePath, [Node () (Lexeme Text)])]
    -> State (Map Text DeclDefn) [(FilePath, [Node () (Lexeme Text)])])
-> [(FilePath, [Node () (Lexeme Text)])]
-> Map Text DeclDefn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AstActions (Map Text DeclDefn)
-> [(FilePath, [Node () (Lexeme Text)])]
-> State (Map Text DeclDefn) [(FilePath, [Node () (Lexeme Text)])]
forall iattr oattr itext otext a (f :: * -> *).
(TraverseAst iattr oattr itext otext a a, Applicative f) =>
AstActions f iattr oattr itext otext -> a -> f a
traverseAst AstActions (Map Text DeclDefn)
collectPairs
    ([(FilePath, [Node () (Lexeme Text)])]
 -> State (Map Text DeclDefn) [(FilePath, [Node () (Lexeme Text)])])
-> ([(FilePath, [Node () (Lexeme Text)])]
    -> [(FilePath, [Node () (Lexeme Text)])])
-> [(FilePath, [Node () (Lexeme Text)])]
-> State (Map Text DeclDefn) [(FilePath, [Node () (Lexeme Text)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FilePath, [Node () (Lexeme Text)]) -> Bool)
-> [(FilePath, [Node () (Lexeme Text)])]
-> [(FilePath, [Node () (Lexeme Text)])]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((FilePath, [Node () (Lexeme Text)]) -> Bool)
-> (FilePath, [Node () (Lexeme Text)])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath
"ccompat.h", FilePath
"tox.h"]) (FilePath -> Bool)
-> ((FilePath, [Node () (Lexeme Text)]) -> FilePath)
-> (FilePath, [Node () (Lexeme Text)])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeFileName (FilePath -> FilePath)
-> ((FilePath, [Node () (Lexeme Text)]) -> FilePath)
-> (FilePath, [Node () (Lexeme Text)])
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, [Node () (Lexeme Text)]) -> FilePath
forall a b. (a, b) -> a
fst)
  where
    lacksDefn :: DeclDefn -> Maybe (FilePath, Lexeme Text)
lacksDefn DeclDefn{Maybe (FilePath, Lexeme Text)
decl :: Maybe (FilePath, Lexeme Text)
decl :: DeclDefn -> Maybe (FilePath, Lexeme Text)
decl, defn :: DeclDefn -> Maybe (FilePath, Lexeme Text)
defn = Maybe (FilePath, Lexeme Text)
Nothing} = Maybe (FilePath, Lexeme Text)
decl
    lacksDefn DeclDefn
_                              = Maybe (FilePath, Lexeme Text)
forall a. Maybe a
Nothing

    makeDiagnostic :: (FilePath, Lexeme Text) -> Text
makeDiagnostic (FilePath
file, fn :: Lexeme Text
fn@(L AlexPosn
_ LexemeClass
_ Text
fname)) =
        FilePath -> Lexeme Text -> Text
forall text. FilePath -> Lexeme text -> Text
Diagnostics.sloc FilePath
file Lexeme Text
fn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": missing definition for `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"