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

import           Control.Arrow               ((&&&))
import           Control.Monad.State.Strict  (State)
import qualified Control.Monad.State.Strict  as State
import           Data.Fix                    (Fix (..))
import           Data.List                   (sortOn)
import           Data.Map                    (Map)
import qualified Data.Map                    as Map
import           Data.Maybe                  (mapMaybe)
import           Data.Text                   (Text)
import qualified Data.Text                   as Text
import           Language.Cimple             (AlexPosn (..), Lexeme (..),
                                              LexemeClass (..), Node,
                                              NodeF (..), lexemeText)
import qualified Language.Cimple.Diagnostics as Diagnostics
import           Language.Cimple.TraverseAst (AstActions, astActions, doNode,
                                              traverseAst)
import           Text.EditDistance           (defaultEditCosts,
                                              levenshteinDistance)


maxEditDistance :: Int
maxEditDistance :: Int
maxEditDistance = Int
5


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

type Env = Map Text DeclDefn

empty :: Env
empty :: Env
empty = [(Text, DeclDefn)] -> Env
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    [ (Text
"ev_loop", FilePath -> DeclDefn
inFile FilePath
"ev.h")
    ]
  where
    inFile :: FilePath -> DeclDefn
inFile FilePath
f = 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
f, Lexeme Text
lexeme), defn :: Maybe (FilePath, Lexeme Text)
defn = (FilePath, Lexeme Text) -> Maybe (FilePath, Lexeme Text)
forall a. a -> Maybe a
Just (FilePath
f, Lexeme Text
lexeme) }
    lexeme :: Lexeme Text
lexeme = AlexPosn -> LexemeClass -> Text -> Lexeme Text
forall text. AlexPosn -> LexemeClass -> text -> Lexeme text
L (Int -> Int -> Int -> AlexPosn
AlexPn Int
0 Int
0 Int
0) LexemeClass
Eof Text
""

addDecl :: FilePath -> Lexeme Text -> State Env ()
addDecl :: FilePath -> Lexeme Text -> State Env ()
addDecl FilePath
file l :: Lexeme Text
l@(L AlexPosn
_ LexemeClass
_ Text
name) =
    (Env -> Env) -> State Env ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify ((Env -> Env) -> State Env ()) -> (Env -> Env) -> State Env ()
forall a b. (a -> b) -> a -> b
$ \Env
pairs ->
        case Text -> Env -> Maybe DeclDefn
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
name Env
pairs of
            Maybe DeclDefn
Nothing -> Text -> DeclDefn -> Env -> Env
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
name (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
l), defn :: Maybe (FilePath, Lexeme Text)
defn = Maybe (FilePath, Lexeme Text)
forall a. Maybe a
Nothing }) Env
pairs
            Just DeclDefn
dd -> Text -> DeclDefn -> Env -> Env
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
name (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
l)                 }) Env
pairs

addDefn :: FilePath -> Lexeme Text -> State Env ()
addDefn :: FilePath -> Lexeme Text -> State Env ()
addDefn FilePath
file l :: Lexeme Text
l@(L AlexPosn
_ LexemeClass
_ Text
name) =
    (Env -> Env) -> State Env ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify ((Env -> Env) -> State Env ()) -> (Env -> Env) -> State Env ()
forall a b. (a -> b) -> a -> b
$ \Env
pairs ->
        case Text -> Env -> Maybe DeclDefn
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
name Env
pairs of
            Maybe DeclDefn
Nothing -> Text -> DeclDefn -> Env -> Env
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
name (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
l) }) Env
pairs
            Just DeclDefn
dd -> Text -> DeclDefn -> Env -> Env
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
name (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
l) }) Env
pairs


collectPairs :: AstActions (State Env) Text
collectPairs :: AstActions (State Env) Text
collectPairs = AstActions (State Env) Text
forall (f :: * -> *) text. Applicative f => AstActions f text
astActions
    { doNode :: FilePath -> Node (Lexeme Text) -> State Env () -> State Env ()
doNode = \FilePath
file Node (Lexeme Text)
node State Env ()
act ->
        case Node (Lexeme Text) -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Node (Lexeme Text)
node of
            FunctionDecl Scope
_ (Fix (FunctionPrototype Node (Lexeme Text)
_ Lexeme Text
fname [Node (Lexeme Text)]
_))   -> FilePath -> Lexeme Text -> State Env ()
addDecl FilePath
file Lexeme Text
fname
            FunctionDefn Scope
_ (Fix (FunctionPrototype Node (Lexeme Text)
_ Lexeme Text
fname [Node (Lexeme Text)]
_)) Node (Lexeme Text)
_ -> FilePath -> Lexeme Text -> State Env ()
addDefn FilePath
file Lexeme Text
fname
            TyStruct Lexeme Text
sname -> FilePath -> Lexeme Text -> State Env ()
addDecl FilePath
file Lexeme Text
sname
            Struct Lexeme Text
sname [Node (Lexeme Text)]
_ -> FilePath -> Lexeme Text -> State Env ()
addDefn FilePath
file Lexeme Text
sname

            NodeF (Lexeme Text) (Node (Lexeme Text))
_ -> State Env ()
act
    }

analyse :: [(FilePath, [Node (Lexeme Text)])] -> [Text]
analyse :: [(FilePath, [Node (Lexeme Text)])] -> [Text]
analyse =
    ([(FilePath, Lexeme Text)] -> [(FilePath, Lexeme Text)] -> [Text])
-> ([(FilePath, Lexeme Text)], [(FilePath, Lexeme Text)]) -> [Text]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (((FilePath, Lexeme Text) -> [Text])
-> [(FilePath, Lexeme Text)] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (((FilePath, Lexeme Text) -> [Text])
 -> [(FilePath, Lexeme Text)] -> [Text])
-> ([(FilePath, Lexeme Text)] -> (FilePath, Lexeme Text) -> [Text])
-> [(FilePath, Lexeme Text)]
-> [(FilePath, Lexeme Text)]
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(FilePath, Lexeme Text)] -> (FilePath, Lexeme Text) -> [Text]
makeDiagnostic)
    (([(FilePath, Lexeme Text)], [(FilePath, Lexeme Text)]) -> [Text])
-> ([(FilePath, [Node (Lexeme Text)])]
    -> ([(FilePath, 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)
defn ([DeclDefn] -> [(FilePath, Lexeme Text)])
-> ([DeclDefn] -> [(FilePath, Lexeme Text)])
-> [DeclDefn]
-> ([(FilePath, Lexeme Text)], [(FilePath, Lexeme Text)])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, 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, Lexeme Text)]))
-> ([(FilePath, [Node (Lexeme Text)])] -> [DeclDefn])
-> [(FilePath, [Node (Lexeme Text)])]
-> ([(FilePath, Lexeme Text)], [(FilePath, Lexeme Text)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env -> [DeclDefn]
forall k a. Map k a -> [a]
Map.elems
    (Env -> [DeclDefn])
-> ([(FilePath, [Node (Lexeme Text)])] -> Env)
-> [(FilePath, [Node (Lexeme Text)])]
-> [DeclDefn]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State Env () -> Env -> Env) -> Env -> State Env () -> Env
forall a b c. (a -> b -> c) -> b -> a -> c
flip State Env () -> Env -> Env
forall s a. State s a -> s -> s
State.execState Env
empty
    (State Env () -> Env)
-> ([(FilePath, [Node (Lexeme Text)])] -> State Env ())
-> [(FilePath, [Node (Lexeme Text)])]
-> Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AstActions (State Env) Text
-> [(FilePath, [Node (Lexeme Text)])] -> State Env ()
forall text a (f :: * -> *).
(TraverseAst text a, Applicative f) =>
AstActions f text -> a -> f ()
traverseAst AstActions (State Env) Text
collectPairs
  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)] -> (FilePath, Lexeme Text) -> [Text]
makeDiagnostic :: [(FilePath, Lexeme Text)] -> (FilePath, Lexeme Text) -> [Text]
makeDiagnostic [(FilePath, Lexeme Text)]
defns (FilePath
file, fn :: Lexeme Text
fn@(L AlexPosn
_ LexemeClass
_ Text
name)) =
    FilePath -> Lexeme Text -> Text
forall a. HasLocation a => FilePath -> a -> 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
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`"
    Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
suggestion
  where
    dists :: [(a, Lexeme Text)] -> [(Int, (a, Lexeme Text))]
dists = ((Int, (a, Lexeme Text)) -> Int)
-> [(Int, (a, Lexeme Text))] -> [(Int, (a, Lexeme Text))]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Int, (a, Lexeme Text)) -> Int
forall a b. (a, b) -> a
fst ([(Int, (a, Lexeme Text))] -> [(Int, (a, Lexeme Text))])
-> ([(a, Lexeme Text)] -> [(Int, (a, Lexeme Text))])
-> [(a, Lexeme Text)]
-> [(Int, (a, Lexeme Text))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, Lexeme Text) -> (Int, (a, Lexeme Text)))
-> [(a, Lexeme Text)] -> [(Int, (a, Lexeme Text))]
forall a b. (a -> b) -> [a] -> [b]
map ((EditCosts -> FilePath -> FilePath -> Int
levenshteinDistance EditCosts
defaultEditCosts (Lexeme Text -> FilePath
normalise Lexeme Text
fn) (FilePath -> Int)
-> ((a, Lexeme Text) -> FilePath) -> (a, Lexeme Text) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lexeme Text -> FilePath
normalise (Lexeme Text -> FilePath)
-> ((a, Lexeme Text) -> Lexeme Text)
-> (a, Lexeme Text)
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Lexeme Text) -> Lexeme Text
forall a b. (a, b) -> b
snd) ((a, Lexeme Text) -> Int)
-> ((a, Lexeme Text) -> (a, Lexeme Text))
-> (a, Lexeme Text)
-> (Int, (a, Lexeme Text))
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (a, Lexeme Text) -> (a, Lexeme Text)
forall a. a -> a
id)
    normalise :: Lexeme Text -> FilePath
normalise = Text -> FilePath
Text.unpack (Text -> FilePath)
-> (Lexeme Text -> Text) -> Lexeme Text -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.toLower (Text -> Text) -> (Lexeme Text -> Text) -> Lexeme Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lexeme Text -> Text
forall text. Lexeme text -> text
lexemeText

    suggestion :: [Text]
suggestion =
        case [(FilePath, Lexeme Text)] -> [(Int, (FilePath, Lexeme Text))]
forall a. [(a, Lexeme Text)] -> [(Int, (a, Lexeme Text))]
dists [(FilePath, Lexeme Text)]
defns of
            (Int
d, (FilePath
dfile, dn :: Lexeme Text
dn@(L AlexPosn
_ LexemeClass
_ Text
dname))):[(Int, (FilePath, Lexeme Text))]
_ | Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
maxEditDistance ->
                [FilePath -> Lexeme Text -> Text
forall a. HasLocation a => FilePath -> a -> Text
Diagnostics.sloc FilePath
dfile Lexeme Text
dn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": did you mean `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`?"]
            [(Int, (FilePath, Lexeme Text))]
_ -> []

descr :: ([(FilePath, [Node (Lexeme Text)])] -> [Text], (Text, Text))
descr :: ([(FilePath, [Node (Lexeme Text)])] -> [Text], (Text, Text))
descr = ([(FilePath, [Node (Lexeme Text)])] -> [Text]
analyse, (Text
"decls-have-defns", [Text] -> Text
Text.unlines
    [ Text
"Checks that all function declarations also have matching definitions."
    , Text
""
    , Text
"**Reason:** extern function declarations without definitions are not implemented"
    , Text
"and cannot be used. This likely means the declaration was forgotten when"
    , Text
"deleting a function."
    ]))