aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorYuchen Pei <hi@ypei.me>2022-10-04 18:48:15 +1100
committerYuchen Pei <hi@ypei.me>2022-10-05 09:50:05 +1100
commit0fc6e35633ff69a8ff08784d32623f794ccba37b (patch)
tree96f09ca923ee2cffd4692d6188467519083cb11a
parent3d0b7a72dbf67f213470c8e123e8ef075dc5c916 (diff)
adding api to get IdentifierInfo from LocationInfo.
-rw-r--r--app/Server.hs97
1 files changed, 96 insertions, 1 deletions
diff --git a/app/Server.hs b/app/Server.hs
index 628bf19..1c9980d 100644
--- a/app/Server.hs
+++ b/app/Server.hs
@@ -48,7 +48,7 @@ import Data.IntervalMap.Interval (Interval(..), subsumes)
import qualified Data.IntervalMap.Strict as IVM
import qualified Data.List as L
import qualified Data.Map.Strict as M
-import Data.Maybe (fromMaybe, mapMaybe)
+import Data.Maybe (fromMaybe, listToMaybe, mapMaybe)
import qualified Data.Vector as V
import qualified GHC.Compact as C
import Data.Pagination
@@ -916,6 +916,8 @@ type API = GetAllPackages
:<|> GetIdentifiers
:<|> GetGlobalReferences
:<|> GetGlobalIdentifiers
+ :<|> GetGlobalIdentifierA
+ :<|> GetGlobalIdentifierE
:<|> GetHoogleDocs
type GetAllPackages = "api" :> "packages" :> Get '[JSON] AllPackages
@@ -964,6 +966,24 @@ type GetGlobalIdentifiers = "api" :> "globalIdentifiers"
:> Get '[JSON] (Headers '[Header "Link" T.Text,Header "X-Total-Count" Int]
[HCE.ExternalIdentifierInfo])
+type GetGlobalIdentifierA = "api" :> "globalIdentifierA"
+ :> Capture "packageId" PackageId
+ :> Capture "componentId" HCE.ComponentId
+ :> Capture "moduleName" HCE.HaskellModuleName
+ :> Capture "entity" HCE.LocatableEntity
+ :> Capture "name" T.Text
+ :> Get '[JSON] HCE.ExternalIdentifierInfo
+
+type GetGlobalIdentifierE = "api" :> "globalIdentifierE"
+ :> Capture "packageId" PackageId
+ :> Capture "modulePath" HCE.HaskellModulePath
+ :> Capture "lineStart" Int
+ :> Capture "columnStart" Int
+ :> Capture "lineEnd" Int
+ :> Capture "columnEnd" Int
+ :> Capture "name" T.Text
+ :> Get '[JSON] HCE.ExternalIdentifierInfo
+
type GetHoogleDocs = "api" :> "hoogleDocs"
:> Capture "packageId" PackageId
:> Capture "moduleName" HCE.HaskellModuleName
@@ -1471,6 +1491,79 @@ findGlobalIdentifiers query' mbPage mbPerPage = do
paginatedItems $
paginatedIdentifiers
+findGlobalIdentifierA ::
+ PackageId
+ -> HCE.ComponentId
+ -> HCE.HaskellModuleName
+ -> HCE.LocatableEntity
+ -> T.Text
+ -> ReaderT Environment IO HCE.ExternalIdentifierInfo
+findGlobalIdentifierA packageId componentId moduleName entity name' = do
+ let name = fixDots name'
+ maxItems = 500
+ globalIdentifierMap <- asks envGlobalIdentifierMap
+ let identifiers
+ | T.length name > 0 =
+ take maxItems $ S.toList
+ $ HCE.match (T.unpack name) globalIdentifierMap
+ | otherwise = []
+ result = L.find
+ (\(HCE.ExternalIdentifierInfo HCE.IdentifierInfo{..}) ->
+ case locationInfo of
+ -- TODO: this may never happen as it will always
+ -- be ExactLocation?
+ HCE.ApproximateLocation p m e n _ c ->
+ HCE.packageIdToText p == getPackageId packageId
+ && m == moduleName
+ && e == entity && n == name && c == componentId
+ _ ->
+ occName == HCE.OccName name
+ && externalId ==
+ Just (HCE.ExternalId (getPackageId packageId <> "|" <>
+ HCE.getHaskellModuleName moduleName <> "|" <>
+ T.pack (show entity) <> "|" <>
+ name))
+ )
+ identifiers
+ case result of
+ Just identifier -> return identifier
+ _ -> error404 "Identifier not found."
+
+findGlobalIdentifierE ::
+ PackageId
+ -> HCE.HaskellModulePath
+ -> Int -- ^ Start line
+ -> Int -- ^ Start column
+ -> Int -- ^ End line
+ -> Int -- ^ End column
+ -> T.Text -- ^ Name
+ -> ReaderT Environment IO HCE.ExternalIdentifierInfo
+findGlobalIdentifierE packageId modulePath startLine startColumn endLine endColumn name' = do
+ let name = fixDots name'
+ maxItems = 500
+ globalIdentifierMap <- asks envGlobalIdentifierMap
+ let identifiers
+ | T.length name > 0 =
+ take maxItems $ S.toList
+ $ HCE.match (T.unpack name) globalIdentifierMap
+ | otherwise = []
+ result = L.find
+ (\(HCE.ExternalIdentifierInfo HCE.IdentifierInfo{..}) ->
+ case locationInfo of
+ -- TODO: this may never happen as it will always
+ -- be ExactLocation?
+ HCE.ExactLocation p m _ sl el sc ec ->
+ HCE.packageIdToText p == getPackageId packageId
+ && m == modulePath
+ && sl == startLine && el == endLine
+ && sc == startColumn && ec == endColumn
+ _ -> False
+ )
+ identifiers
+ case result of
+ Just identifier -> return identifier
+ _ -> error404 "Identifier not found."
+
data HoogleResultItem = HoogleResultItem
{ sort :: HoogleItemSort
, moduleName :: T.Text
@@ -1767,6 +1860,8 @@ server env =
findIdentifiers :<|>
getGlobalReferences :<|>
findGlobalIdentifiers :<|>
+ findGlobalIdentifierA :<|>
+ findGlobalIdentifierE :<|>
getHoogleDocs)
where
toServantHandler :: ReaderT Environment IO a -> Handler a