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
hieMatchPatternAst
:: HieFile
-> HieAST TypeIndex
-> PatternAst
-> Bool
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