{- |
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 Prelude hiding (span)
import Stan.Core.List (checkWith)
import Stan.Ghc.Compat (nameOccName, occNameString)
import Stan.Hie (slice)
import Stan.Hie.Compat (ContextInfo (..), DeclType, HieAST (..), HieFile (..), Identifier,
                        IdentifierDetails (..), NodeInfo (..), TypeIndex, nodeInfo,
                        eqDeclType, NodeAnnotation, toNodeAnnotation)
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 Int -> PatternAst -> Bool
hieMatchPatternAst hie :: HieFile
hie@HieFile{String
[AvailInfo]
ByteString
Array Int HieTypeFlat
Module
HieASTs Int
hie_hs_file :: String
hie_module :: Module
hie_types :: Array Int HieTypeFlat
hie_asts :: HieASTs Int
hie_exports :: [AvailInfo]
hie_hs_src :: ByteString
hie_hs_file :: HieFile -> String
hie_module :: HieFile -> Module
hie_types :: HieFile -> Array Int HieTypeFlat
hie_asts :: HieFile -> HieASTs Int
hie_exports :: HieFile -> [AvailInfo]
hie_hs_src :: HieFile -> ByteString
..} node :: HieAST Int
node@Node{[HieAST Int]
Span
SourcedNodeInfo Int
sourcedNodeInfo :: SourcedNodeInfo Int
nodeSpan :: Span
nodeChildren :: [HieAST Int]
sourcedNodeInfo :: forall a. HieAST a -> SourcedNodeInfo a
nodeSpan :: forall a. HieAST a -> Span
nodeChildren :: forall a. HieAST a -> [HieAST a]
..} = \case
    PatternAst
PatternAstAnything -> Bool
True
    PatternAstNeg PatternAst
p ->
        Bool -> Bool
not (HieFile -> HieAST Int -> PatternAst -> Bool
hieMatchPatternAst HieFile
hie HieAST Int
node PatternAst
p)
    PatternAstOr PatternAst
p1 PatternAst
p2 ->
           HieFile -> HieAST Int -> PatternAst -> Bool
hieMatchPatternAst HieFile
hie HieAST Int
node PatternAst
p1
        Bool -> Bool -> Bool
|| HieFile -> HieAST Int -> PatternAst -> Bool
hieMatchPatternAst HieFile
hie HieAST Int
node PatternAst
p2
    PatternAstAnd PatternAst
p1 PatternAst
p2 ->
           HieFile -> HieAST Int -> PatternAst -> Bool
hieMatchPatternAst HieFile
hie HieAST Int
node PatternAst
p1
        Bool -> Bool -> Bool
&& HieFile -> HieAST Int -> PatternAst -> Bool
hieMatchPatternAst HieFile
hie HieAST Int
node PatternAst
p2
    PatternAstConstant Literal
lit ->
           NodeAnnotation -> Set NodeAnnotation -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member NodeAnnotation
literalAnns ((NodeAnnotation -> NodeAnnotation)
-> Set NodeAnnotation -> Set NodeAnnotation
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map NodeAnnotation -> NodeAnnotation
toNodeAnnotation (NodeInfo Int -> Set NodeAnnotation
forall a. NodeInfo a -> Set NodeAnnotation
nodeAnnotations NodeInfo Int
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 Int
n   -> (Maybe ByteString
span Maybe ByteString -> (ByteString -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int)
-> (ByteString -> String) -> ByteString -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8) Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n
                ExactStr 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 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 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
                Literal
AnyLiteral   -> Bool
True
           )
    PatternAstName NameMeta
nameMeta PatternType
patType ->
        ((Identifier, IdentifierDetails Int) -> Bool)
-> [(Identifier, IdentifierDetails Int)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (NameMeta
-> PatternType -> (Identifier, IdentifierDetails Int) -> Bool
matchNameAndType NameMeta
nameMeta PatternType
patType)
        ([(Identifier, IdentifierDetails Int)] -> Bool)
-> [(Identifier, IdentifierDetails Int)] -> Bool
forall a b. (a -> b) -> a -> b
$ Map Identifier (IdentifierDetails Int)
-> [(Identifier, IdentifierDetails Int)]
forall k a. Map k a -> [(k, a)]
Map.assocs
        (Map Identifier (IdentifierDetails Int)
 -> [(Identifier, IdentifierDetails Int)])
-> Map Identifier (IdentifierDetails Int)
-> [(Identifier, IdentifierDetails Int)]
forall a b. (a -> b) -> a -> b
$ NodeInfo Int -> Map Identifier (IdentifierDetails Int)
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers NodeInfo Int
nodeInfo'
    PatternAstNode Set NodeAnnotation
tags ->
        Set NodeAnnotation -> NodeInfo Int -> Bool
matchAnnotations Set NodeAnnotation
tags NodeInfo Int
nodeInfo'
    PatternAstNodeExact Set NodeAnnotation
tags [PatternAst]
patChildren ->
           Set NodeAnnotation -> NodeInfo Int -> Bool
matchAnnotations Set NodeAnnotation
tags NodeInfo Int
nodeInfo'
        Bool -> Bool -> Bool
&& (HieAST Int -> PatternAst -> Bool)
-> [HieAST Int] -> [PatternAst] -> Bool
forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool
checkWith (HieFile -> HieAST Int -> PatternAst -> Bool
hieMatchPatternAst HieFile
hie) [HieAST Int]
nodeChildren [PatternAst]
patChildren
    PatternAstVarName String
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 Name
x -> String
varName String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`Str.isInfixOf` (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (OccName -> String
occNameString (OccName -> String) -> OccName -> String
forall a b. (a -> b) -> a -> b
$ Name -> OccName
nameOccName Name
x)
            Left ModuleName
_ -> Bool
False
        )
        ([Identifier] -> Maybe Identifier)
-> [Identifier] -> Maybe Identifier
forall a b. (a -> b) -> a -> b
$ Map Identifier (IdentifierDetails Int) -> [Identifier]
forall k a. Map k a -> [k]
Map.keys (Map Identifier (IdentifierDetails Int) -> [Identifier])
-> Map Identifier (IdentifierDetails Int) -> [Identifier]
forall a b. (a -> b) -> a -> b
$ NodeInfo Int -> Map Identifier (IdentifierDetails Int)
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers NodeInfo Int
nodeInfo'
    PatternAstIdentifierDetailsDecl DeclType
declType -> (IdentifierDetails Int -> Bool) -> [IdentifierDetails Int] -> 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 Int -> Set ContextInfo)
-> IdentifierDetails Int
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentifierDetails Int -> Set ContextInfo
forall a. IdentifierDetails a -> Set ContextInfo
identInfo) ([IdentifierDetails Int] -> Bool)
-> [IdentifierDetails Int] -> Bool
forall a b. (a -> b) -> a -> b
$
        Map Identifier (IdentifierDetails Int) -> [IdentifierDetails Int]
forall k a. Map k a -> [a]
Map.elems (Map Identifier (IdentifierDetails Int) -> [IdentifierDetails Int])
-> Map Identifier (IdentifierDetails Int)
-> [IdentifierDetails Int]
forall a b. (a -> b) -> a -> b
$ NodeInfo Int -> Map Identifier (IdentifierDetails Int)
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers NodeInfo Int
nodeInfo'
  where
    matchAnnotations :: Set NodeAnnotation -> NodeInfo TypeIndex -> Bool
    matchAnnotations :: Set NodeAnnotation -> NodeInfo Int -> Bool
matchAnnotations Set NodeAnnotation
tags NodeInfo{[Int]
Set NodeAnnotation
Map Identifier (IdentifierDetails Int)
nodeAnnotations :: forall a. NodeInfo a -> Set NodeAnnotation
nodeIdentifiers :: forall a. NodeInfo a -> NodeIdentifiers a
nodeAnnotations :: Set NodeAnnotation
nodeType :: [Int]
nodeIdentifiers :: Map Identifier (IdentifierDetails Int)
nodeType :: forall a. NodeInfo a -> [a]
..} =
      Set NodeAnnotation
tags Set NodeAnnotation -> Set NodeAnnotation -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` (NodeAnnotation -> NodeAnnotation)
-> Set NodeAnnotation -> Set NodeAnnotation
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map NodeAnnotation -> NodeAnnotation
toNodeAnnotation Set NodeAnnotation
nodeAnnotations

    nodeInfo' :: NodeInfo Int
nodeInfo' = HieAST Int -> NodeInfo Int
forall a. Ord a => HieAST a -> NodeInfo a
Stan.Hie.Compat.nodeInfo HieAST Int
node

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

    isDecl :: DeclType -> ContextInfo -> Bool
    isDecl :: DeclType -> ContextInfo -> Bool
isDecl DeclType
myDeclType (Decl DeclType
curDeclType Maybe Span
_) = DeclType
myDeclType DeclType -> DeclType -> Bool
`eqDeclType` DeclType
curDeclType
    isDecl DeclType
_declType ContextInfo
_otherContext         = Bool
False