diff options
| -rw-r--r-- | app/Server.hs | 97 |
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 |