From 0fc6e35633ff69a8ff08784d32623f794ccba37b Mon Sep 17 00:00:00 2001
From: Yuchen Pei <hi@ypei.me>
Date: Tue, 4 Oct 2022 18:48:15 +1100
Subject: adding api to get IdentifierInfo from LocationInfo.

---
 app/Server.hs | 97 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 96 insertions(+), 1 deletion(-)

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
-- 
cgit v1.2.3