{- |
Copyright: (c) 2020 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

Some 'Stan.Inspection.Inspection's require to know about AST and some
mechanism to match parts of syntax tree to the given
'PatternAst'. This information on AST expressions is taken from @HIE
files@ in a more suitable view.

This module contains an implementation of the process of retrieval of AST
information from @HIE@ files.
-}

module Stan.Hie.MatchAst
    ( hieMatchPatternAst
    ) where

import Data.Char (toLower)

import Stan.Core.List (checkWith)
import Stan.Ghc.Compat (FastString, nameOccName, occNameString)
import Stan.Hie (slice)
import Stan.Hie.Compat (ContextInfo (..), DeclType, HieAST (..), HieFile (..), Identifier,
                        IdentifierDetails (..), NodeInfo (..), TypeIndex)
import Stan.Hie.MatchType (hieMatchPatternType)
import Stan.NameMeta (NameMeta, hieMatchNameMeta)
import Stan.Pattern.Ast (Literal (..), PatternAst (..), literalAnns)
import Stan.Pattern.Type (PatternType)

import qualified Data.ByteString as BS
import qualified Data.List as Str
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set


{- | Matching function that matches current AST node with a given
pattern.
-}
hieMatchPatternAst
    :: HieFile  -- ^ HIE file
    -> HieAST TypeIndex  -- ^ Current AST node to match
    -> PatternAst  -- ^ Pattern to match against
    -> Bool  -- ^ 'True' if pattern matches AST node
hieMatchPatternAst :: HieFile -> HieAST TypeIndex -> PatternAst -> Bool
hieMatchPatternAst hie :: HieFile
hie@HieFile{..} node :: HieAST TypeIndex
node@Node{..} = \case
    PatternAstAnything -> Bool
True
    PatternAstNeg p :: PatternAst
p ->
        Bool -> Bool
not (HieFile -> HieAST TypeIndex -> PatternAst -> Bool
hieMatchPatternAst HieFile
hie HieAST TypeIndex
node PatternAst
p)
    PatternAstOr p1 :: PatternAst
p1 p2 :: PatternAst
p2 ->
           HieFile -> HieAST TypeIndex -> PatternAst -> Bool
hieMatchPatternAst HieFile
hie HieAST TypeIndex
node PatternAst
p1
        Bool -> Bool -> Bool
|| HieFile -> HieAST TypeIndex -> PatternAst -> Bool
hieMatchPatternAst HieFile
hie HieAST TypeIndex
node PatternAst
p2
    PatternAstAnd p1 :: PatternAst
p1 p2 :: PatternAst
p2 ->
           HieFile -> HieAST TypeIndex -> PatternAst -> Bool
hieMatchPatternAst HieFile
hie HieAST TypeIndex
node PatternAst
p1
        Bool -> Bool -> Bool
&& HieFile -> HieAST TypeIndex -> PatternAst -> Bool
hieMatchPatternAst HieFile
hie HieAST TypeIndex
node PatternAst
p2
    PatternAstConstant lit :: Literal
lit ->
           (FastString, FastString) -> Set (FastString, FastString) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (FastString, FastString)
literalAnns (NodeInfo TypeIndex -> Set (FastString, FastString)
forall a. NodeInfo a -> Set (FastString, FastString)
nodeAnnotations NodeInfo TypeIndex
nodeInfo)
        Bool -> Bool -> Bool
&& ( let span :: Maybe ByteString
span = Span -> ByteString -> Maybe ByteString
slice Span
nodeSpan ByteString
hie_hs_src in case Literal
lit of
                ExactNum n :: TypeIndex
n   -> (Maybe ByteString
span Maybe ByteString
-> (ByteString -> Maybe TypeIndex) -> Maybe TypeIndex
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> Maybe TypeIndex
forall a. Read a => FilePath -> Maybe a
readMaybe (FilePath -> Maybe TypeIndex)
-> (ByteString -> FilePath) -> ByteString -> Maybe TypeIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FilePath
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8) Maybe TypeIndex -> Maybe TypeIndex -> Bool
forall a. Eq a => a -> a -> Bool
== TypeIndex -> Maybe TypeIndex
forall a. a -> Maybe a
Just TypeIndex
n
                ExactStr s :: ByteString
s   -> Maybe ByteString
span Maybe ByteString -> Maybe ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
s
                PrefixStr s :: ByteString
s  -> Bool -> (ByteString -> Bool) -> Maybe ByteString -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (ByteString
s ByteString -> ByteString -> Bool
`BS.isPrefixOf`) Maybe ByteString
span
                ContainStr s :: ByteString
s -> Bool -> (ByteString -> Bool) -> Maybe ByteString -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (ByteString
s ByteString -> ByteString -> Bool
`BS.isInfixOf`) Maybe ByteString
span
                AnyLiteral   -> Bool
True
           )
    PatternAstName nameMeta :: NameMeta
nameMeta patType :: PatternType
patType ->
        ((Identifier, IdentifierDetails TypeIndex) -> Bool)
-> [(Identifier, IdentifierDetails TypeIndex)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (NameMeta
-> PatternType -> (Identifier, IdentifierDetails TypeIndex) -> Bool
matchNameAndType NameMeta
nameMeta PatternType
patType)
        ([(Identifier, IdentifierDetails TypeIndex)] -> Bool)
-> [(Identifier, IdentifierDetails TypeIndex)] -> Bool
forall a b. (a -> b) -> a -> b
$ Map Identifier (IdentifierDetails TypeIndex)
-> [(Identifier, IdentifierDetails TypeIndex)]
forall k a. Map k a -> [(k, a)]
Map.assocs
        (Map Identifier (IdentifierDetails TypeIndex)
 -> [(Identifier, IdentifierDetails TypeIndex)])
-> Map Identifier (IdentifierDetails TypeIndex)
-> [(Identifier, IdentifierDetails TypeIndex)]
forall a b. (a -> b) -> a -> b
$ NodeInfo TypeIndex -> Map Identifier (IdentifierDetails TypeIndex)
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers NodeInfo TypeIndex
nodeInfo
    PatternAstNode tags :: Set (FastString, FastString)
tags ->
        Set (FastString, FastString) -> NodeInfo TypeIndex -> Bool
matchAnnotations Set (FastString, FastString)
tags NodeInfo TypeIndex
nodeInfo
    PatternAstNodeExact tags :: Set (FastString, FastString)
tags patChildren :: [PatternAst]
patChildren ->
           Set (FastString, FastString) -> NodeInfo TypeIndex -> Bool
matchAnnotations Set (FastString, FastString)
tags NodeInfo TypeIndex
nodeInfo
        Bool -> Bool -> Bool
&& (HieAST TypeIndex -> PatternAst -> Bool)
-> [HieAST TypeIndex] -> [PatternAst] -> Bool
forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool
checkWith (HieFile -> HieAST TypeIndex -> PatternAst -> Bool
hieMatchPatternAst HieFile
hie) [HieAST TypeIndex]
nodeChildren [PatternAst]
patChildren
    PatternAstVarName varName :: FilePath
varName -> Maybe Identifier -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Identifier -> Bool) -> Maybe Identifier -> Bool
forall a b. (a -> b) -> a -> b
$ (Identifier -> Bool) -> [Identifier] -> Maybe Identifier
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find
        (\case
            Right x :: Name
x -> FilePath
varName FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`Str.isInfixOf` (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (OccName -> FilePath
occNameString (OccName -> FilePath) -> OccName -> FilePath
forall a b. (a -> b) -> a -> b
$ Name -> OccName
nameOccName Name
x)
            Left _ -> Bool
False
        )
        ([Identifier] -> Maybe Identifier)
-> [Identifier] -> Maybe Identifier
forall a b. (a -> b) -> a -> b
$ Map Identifier (IdentifierDetails TypeIndex) -> [Identifier]
forall k a. Map k a -> [k]
Map.keys (Map Identifier (IdentifierDetails TypeIndex) -> [Identifier])
-> Map Identifier (IdentifierDetails TypeIndex) -> [Identifier]
forall a b. (a -> b) -> a -> b
$ NodeInfo TypeIndex -> Map Identifier (IdentifierDetails TypeIndex)
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers NodeInfo TypeIndex
nodeInfo
    PatternAstIdentifierDetailsDecl declType :: DeclType
declType -> (IdentifierDetails TypeIndex -> Bool)
-> [IdentifierDetails TypeIndex] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((ContextInfo -> Bool) -> Set ContextInfo -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (DeclType -> ContextInfo -> Bool
isDecl DeclType
declType) (Set ContextInfo -> Bool)
-> (IdentifierDetails TypeIndex -> Set ContextInfo)
-> IdentifierDetails TypeIndex
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentifierDetails TypeIndex -> Set ContextInfo
forall a. IdentifierDetails a -> Set ContextInfo
identInfo) ([IdentifierDetails TypeIndex] -> Bool)
-> [IdentifierDetails TypeIndex] -> Bool
forall a b. (a -> b) -> a -> b
$
        Map Identifier (IdentifierDetails TypeIndex)
-> [IdentifierDetails TypeIndex]
forall k a. Map k a -> [a]
Map.elems (Map Identifier (IdentifierDetails TypeIndex)
 -> [IdentifierDetails TypeIndex])
-> Map Identifier (IdentifierDetails TypeIndex)
-> [IdentifierDetails TypeIndex]
forall a b. (a -> b) -> a -> b
$ NodeInfo TypeIndex -> Map Identifier (IdentifierDetails TypeIndex)
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers NodeInfo TypeIndex
nodeInfo
  where
    matchAnnotations :: Set (FastString, FastString) -> NodeInfo TypeIndex -> Bool
    matchAnnotations :: Set (FastString, FastString) -> NodeInfo TypeIndex -> Bool
matchAnnotations tags :: Set (FastString, FastString)
tags NodeInfo{..} = Set (FastString, FastString)
tags Set (FastString, FastString)
-> Set (FastString, FastString) -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set (FastString, FastString)
nodeAnnotations

    matchNameAndType
        :: NameMeta
        -> PatternType
        -> (Identifier, IdentifierDetails TypeIndex)
        -> Bool
    matchNameAndType :: NameMeta
-> PatternType -> (Identifier, IdentifierDetails TypeIndex) -> Bool
matchNameAndType nameMeta :: NameMeta
nameMeta patType :: PatternType
patType ids :: (Identifier, IdentifierDetails TypeIndex)
ids =
        NameMeta -> (Identifier, IdentifierDetails TypeIndex) -> Bool
hieMatchNameMeta NameMeta
nameMeta (Identifier, IdentifierDetails TypeIndex)
ids
        Bool -> Bool -> Bool
&& case NodeInfo TypeIndex -> [TypeIndex]
forall a. NodeInfo a -> [a]
nodeType NodeInfo TypeIndex
nodeInfo of
            []    -> Bool
False
            t :: TypeIndex
t : _ -> Array TypeIndex HieTypeFlat -> PatternType -> TypeIndex -> Bool
hieMatchPatternType Array TypeIndex HieTypeFlat
hie_types PatternType
patType TypeIndex
t

    isDecl :: DeclType -> ContextInfo -> Bool
    isDecl :: DeclType -> ContextInfo -> Bool
isDecl myDeclType :: DeclType
myDeclType (Decl curDeclType :: DeclType
curDeclType _) = DeclType
myDeclType DeclType -> DeclType -> Bool
forall a. Eq a => a -> a -> Bool
== DeclType
curDeclType
    isDecl _declType :: DeclType
_declType _otherContext :: ContextInfo
_otherContext         = Bool
False