module Stan.NameMeta
( NameMeta (..)
, prettyShowNameMeta
, compareNames
, hieMatchNameMeta
, hieFindIdentifier
, baseNameFrom
, mkBaseListMeta
, mkBaseOldListMeta
, mkBaseFoldableMeta
, unorderedNameFrom
, textNameFrom
, ghcPrimNameFrom
, primTypeMeta
) where
import Stan.Core.ModuleName (ModuleName (..), fromGhcModule)
import Stan.Ghc.Compat (Name, isExternalName, moduleUnitId, nameModule, nameOccName, occNameString, showTUnitId)
import Stan.Hie.Compat (ContextInfo (IEThing), HieAST (..), IEType (Import), Identifier,
IdentifierDetails (..), NodeInfo (..), TypeIndex, nodeInfo)
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Data.Text as T
data NameMeta = NameMeta
{ NameMeta -> Text
nameMetaPackage :: !Text
, NameMeta -> ModuleName
nameMetaModuleName :: !ModuleName
, NameMeta -> Text
nameMetaName :: !Text
} deriving stock (TypeIndex -> NameMeta -> ShowS
[NameMeta] -> ShowS
NameMeta -> String
(TypeIndex -> NameMeta -> ShowS)
-> (NameMeta -> String) -> ([NameMeta] -> ShowS) -> Show NameMeta
forall a.
(TypeIndex -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: TypeIndex -> NameMeta -> ShowS
showsPrec :: TypeIndex -> NameMeta -> ShowS
$cshow :: NameMeta -> String
show :: NameMeta -> String
$cshowList :: [NameMeta] -> ShowS
showList :: [NameMeta] -> ShowS
Show, NameMeta -> NameMeta -> Bool
(NameMeta -> NameMeta -> Bool)
-> (NameMeta -> NameMeta -> Bool) -> Eq NameMeta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NameMeta -> NameMeta -> Bool
== :: NameMeta -> NameMeta -> Bool
$c/= :: NameMeta -> NameMeta -> Bool
/= :: NameMeta -> NameMeta -> Bool
Eq)
prettyShowNameMeta :: NameMeta -> Text
prettyShowNameMeta :: NameMeta -> Text
prettyShowNameMeta NameMeta{Text
ModuleName
nameMetaPackage :: NameMeta -> Text
nameMetaModuleName :: NameMeta -> ModuleName
nameMetaName :: NameMeta -> Text
nameMetaPackage :: Text
nameMetaModuleName :: ModuleName
nameMetaName :: Text
..} = Text -> [Text] -> Text
T.intercalate Text
"/"
[ Text
nameMetaPackage
, ModuleName -> Text
unModuleName ModuleName
nameMetaModuleName
, Text
nameMetaName
]
compareNames :: NameMeta -> Name -> Bool
compareNames :: NameMeta -> Name -> Bool
compareNames NameMeta{Text
ModuleName
nameMetaPackage :: NameMeta -> Text
nameMetaModuleName :: NameMeta -> ModuleName
nameMetaName :: NameMeta -> Text
nameMetaPackage :: Text
nameMetaModuleName :: ModuleName
nameMetaName :: Text
..} Name
name =
let occName :: Text
occName = String -> Text
forall a. ToText a => a -> Text
toText (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ OccName -> String
occNameString (OccName -> String) -> OccName -> String
forall a b. (a -> b) -> a -> b
$ Name -> OccName
nameOccName Name
name
moduleName :: ModuleName
moduleName = Module -> ModuleName
fromGhcModule (Module -> ModuleName) -> Module -> ModuleName
forall a b. (a -> b) -> a -> b
$ (() :: Constraint) => Name -> Module
Name -> Module
nameModule Name
name
package :: Text
package = UnitId -> Text
showTUnitId (UnitId -> Text) -> UnitId -> Text
forall a b. (a -> b) -> a -> b
$ Module -> UnitId
moduleUnitId (Module -> UnitId) -> Module -> UnitId
forall a b. (a -> b) -> a -> b
$ (() :: Constraint) => Name -> Module
Name -> Module
nameModule Name
name
in
Name -> Bool
isExternalName Name
name
Bool -> Bool -> Bool
&& Text
occName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
nameMetaName
Bool -> Bool -> Bool
&& ModuleName
moduleName ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName
nameMetaModuleName
Bool -> Bool -> Bool
&& ( Text
nameMetaPackage Text -> Text -> Bool
`T.isPrefixOf` Text
package
Bool -> Bool -> Bool
|| Text -> Text
withoutVowels Text
nameMetaPackage Text -> Text -> Bool
`T.isPrefixOf` Text
package
Bool -> Bool -> Bool
|| Text -> Text
truncatedWindows Text
nameMetaPackage Text -> Text -> Bool
`T.isPrefixOf` Text
package
)
where
withoutVowels :: Text -> Text
withoutVowels :: Text -> Text
withoutVowels = (Char -> Bool) -> Text -> Text
T.filter Char -> Bool
isNotVowel
isNotVowel :: Char -> Bool
isNotVowel :: Char -> Bool
isNotVowel = \case
Char
'a' -> Bool
False
Char
'e' -> Bool
False
Char
'i' -> Bool
False
Char
'o' -> Bool
False
Char
'u' -> Bool
False
Char
_ -> Bool
True
truncatedWindows :: Text -> Text
truncatedWindows :: Text -> Text
truncatedWindows Text
s = TypeIndex -> Text -> Text
T.take TypeIndex
13 Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_"
hieMatchNameMeta
:: NameMeta
-> (Identifier, IdentifierDetails TypeIndex)
-> Bool
hieMatchNameMeta :: NameMeta -> (Identifier, IdentifierDetails TypeIndex) -> Bool
hieMatchNameMeta NameMeta
nameMeta (Identifier
identifier, IdentifierDetails TypeIndex
details) = Maybe () -> Bool
forall a. Maybe a -> Bool
isJust (Maybe () -> Bool) -> Maybe () -> Bool
forall a b. (a -> b) -> a -> b
$ do
Right Name
name <- Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just Identifier
identifier
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard
(Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ ContextInfo -> Set ContextInfo -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember (IEType -> ContextInfo
IEThing IEType
Import) (IdentifierDetails TypeIndex -> Set ContextInfo
forall a. IdentifierDetails a -> Set ContextInfo
identInfo IdentifierDetails TypeIndex
details)
Bool -> Bool -> Bool
&& NameMeta -> Name -> Bool
compareNames NameMeta
nameMeta Name
name
hieFindIdentifier :: NameMeta -> HieAST TypeIndex -> Maybe NameMeta
hieFindIdentifier :: NameMeta -> HieAST TypeIndex -> Maybe NameMeta
hieFindIdentifier NameMeta
nameMeta =
(NameMeta
nameMeta NameMeta
-> Maybe (Identifier, IdentifierDetails TypeIndex)
-> Maybe NameMeta
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$)
(Maybe (Identifier, IdentifierDetails TypeIndex) -> Maybe NameMeta)
-> (HieAST TypeIndex
-> Maybe (Identifier, IdentifierDetails TypeIndex))
-> HieAST TypeIndex
-> Maybe NameMeta
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Identifier, IdentifierDetails TypeIndex) -> Bool)
-> [(Identifier, IdentifierDetails TypeIndex)]
-> Maybe (Identifier, IdentifierDetails TypeIndex)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (NameMeta -> (Identifier, IdentifierDetails TypeIndex) -> Bool
hieMatchNameMeta NameMeta
nameMeta)
([(Identifier, IdentifierDetails TypeIndex)]
-> Maybe (Identifier, IdentifierDetails TypeIndex))
-> (HieAST TypeIndex
-> [(Identifier, IdentifierDetails TypeIndex)])
-> HieAST TypeIndex
-> Maybe (Identifier, IdentifierDetails TypeIndex)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Identifier (IdentifierDetails TypeIndex)
-> [(Identifier, IdentifierDetails TypeIndex)]
forall k a. Map k a -> [(k, a)]
Map.assocs
(Map Identifier (IdentifierDetails TypeIndex)
-> [(Identifier, IdentifierDetails TypeIndex)])
-> (HieAST TypeIndex
-> Map Identifier (IdentifierDetails TypeIndex))
-> HieAST TypeIndex
-> [(Identifier, IdentifierDetails TypeIndex)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeInfo TypeIndex -> Map Identifier (IdentifierDetails TypeIndex)
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers
(NodeInfo TypeIndex
-> Map Identifier (IdentifierDetails TypeIndex))
-> (HieAST TypeIndex -> NodeInfo TypeIndex)
-> HieAST TypeIndex
-> Map Identifier (IdentifierDetails TypeIndex)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST TypeIndex -> NodeInfo TypeIndex
forall a. Ord a => HieAST a -> NodeInfo a
nodeInfo
infix 8 `baseNameFrom`
baseNameFrom :: Text -> ModuleName -> NameMeta
baseNameFrom :: Text -> ModuleName -> NameMeta
baseNameFrom Text
funName ModuleName
moduleName = NameMeta
{ nameMetaName :: Text
nameMetaName = Text
funName
, nameMetaModuleName :: ModuleName
nameMetaModuleName = ModuleName
moduleName
, nameMetaPackage :: Text
nameMetaPackage = Text
"base"
}
mkBaseListMeta :: Text -> NameMeta
mkBaseListMeta :: Text -> NameMeta
mkBaseListMeta = (Text -> ModuleName -> NameMeta
`baseNameFrom` ModuleName
"GHC.List")
mkBaseOldListMeta :: Text -> NameMeta
mkBaseOldListMeta :: Text -> NameMeta
mkBaseOldListMeta = (Text -> ModuleName -> NameMeta
`baseNameFrom` ModuleName
"Data.OldList")
mkBaseFoldableMeta :: Text -> NameMeta
mkBaseFoldableMeta :: Text -> NameMeta
mkBaseFoldableMeta = (Text -> ModuleName -> NameMeta
`baseNameFrom` ModuleName
"Data.Foldable")
infix 8 `unorderedNameFrom`
unorderedNameFrom :: Text -> ModuleName -> NameMeta
unorderedNameFrom :: Text -> ModuleName -> NameMeta
unorderedNameFrom Text
funName ModuleName
moduleName = NameMeta
{ nameMetaName :: Text
nameMetaName = Text
funName
, nameMetaModuleName :: ModuleName
nameMetaModuleName = ModuleName
moduleName
, nameMetaPackage :: Text
nameMetaPackage = Text
"unordered-containers"
}
infix 8 `textNameFrom`
textNameFrom :: Text -> ModuleName -> NameMeta
textNameFrom :: Text -> ModuleName -> NameMeta
textNameFrom Text
funName ModuleName
moduleName = NameMeta
{ nameMetaName :: Text
nameMetaName = Text
funName
, nameMetaModuleName :: ModuleName
nameMetaModuleName = ModuleName
moduleName
, nameMetaPackage :: Text
nameMetaPackage = Text
"text"
}
infix 8 `ghcPrimNameFrom`
ghcPrimNameFrom :: Text -> ModuleName -> NameMeta
ghcPrimNameFrom :: Text -> ModuleName -> NameMeta
ghcPrimNameFrom Text
funName ModuleName
moduleName = NameMeta
{ nameMetaName :: Text
nameMetaName = Text
funName
, nameMetaModuleName :: ModuleName
nameMetaModuleName = ModuleName
moduleName
, nameMetaPackage :: Text
nameMetaPackage = Text
"ghc-prim"
}
primTypeMeta :: Text -> NameMeta
primTypeMeta :: Text -> NameMeta
primTypeMeta = (Text -> ModuleName -> NameMeta
`ghcPrimNameFrom` ModuleName
"GHC.Types")