aboutsummaryrefslogtreecommitdiff
path: root/app/Server.hs
diff options
context:
space:
mode:
Diffstat (limited to 'app/Server.hs')
-rw-r--r--app/Server.hs65
1 files changed, 32 insertions, 33 deletions
diff --git a/app/Server.hs b/app/Server.hs
index fa786c2..a045b07 100644
--- a/app/Server.hs
+++ b/app/Server.hs
@@ -350,7 +350,7 @@ instance Store.StoreItem [HCE.ExternalIdentifierInfo] where
, TE.encodeUtf8 $ HCE.packageIdToText packageId
, "|"
, BSC.pack prefix
- ]
+ ]
instance Store.StoreItem (S.Set HCE.IdentifierSrcSpan) where
toByteString = Serialize.encode
@@ -381,7 +381,7 @@ instance (Serialize.Serialize modInfo) =>
toByteString = Serialize.encode
fromByteString = Serialize.decode
type KeyArgs (HM.HashMap HCE.HaskellModulePath modInfo) =
- (HCE.PackageId,Proxy (HM.HashMap HCE.HaskellModulePath modInfo))
+ (HCE.PackageId,Proxy (HM.HashMap HCE.HaskellModulePath modInfo))
itemKey (packageId, _) =
BSS.toShort $ BS.append "moduleMap|" $ TE.encodeUtf8 $ HCE.packageIdToText packageId
@@ -390,7 +390,7 @@ instance Store.StoreItem HCE.ExpressionInfoMap where
fromByteString = Serialize.decode
type KeyArgs HCE.ExpressionInfoMap = ( HCE.PackageId
, HCE.HaskellModulePath
- , BS.ByteString
+ , BS.ByteString
, Proxy HCE.ExpressionInfoMap)
itemKey (packageId, HCE.HaskellModulePath modulePath, topLevelExprKey, _) =
BSS.toShort $ BS.concat
@@ -400,7 +400,7 @@ instance Store.StoreItem HCE.ExpressionInfoMap where
, "|"
, TE.encodeUtf8 modulePath
, "|"
- , topLevelExprKey
+ , topLevelExprKey
]
instance Store.StoreItem (IVM.IntervalMap (Int, Int) BS.ByteString) where
@@ -418,7 +418,7 @@ instance Store.StoreItem (IVM.IntervalMap (Int, Int) BS.ByteString) where
, "|"
, TE.encodeUtf8 modulePath
]
-
+
instance Store.StoreItem HCE.DefinitionSiteMap where
toByteString = Serialize.encode
fromByteString = Serialize.decode
@@ -433,7 +433,7 @@ instance Store.StoreItem HCE.DefinitionSiteMap where
, "|"
, TE.encodeUtf8 modulePath
]
-
+
instance Store.StoreItem (V.Vector T.Text) where
toByteString = Serialize.encode
fromByteString = Serialize.decode
@@ -476,7 +476,7 @@ instance Store.StoreItem GlobalIdentifierMapWrapper where
toByteString (GlobalIdentifierMapWrapper idMap) = Serialize.encode idMap
fromByteString bs = GlobalIdentifierMapWrapper <$> Serialize.decode bs
type KeyArgs GlobalIdentifierMapWrapper = Proxy GlobalIdentifierMapWrapper
- itemKey _ = "globalIdentifierMap"
+ itemKey _ = "globalIdentifierMap"
instance Store.StoreItem [PackageVersions] where
toByteString = Serialize.encode
@@ -494,7 +494,7 @@ findTopLevelExpressions =
| subsumes (fst currentTopLevelInterval) (fst interval) -> topLevelIntervals
| subsumes (fst interval) (fst currentTopLevelInterval) ->
interval : rest
- | otherwise -> interval : topLevelIntervals)
+ | otherwise -> interval : topLevelIntervals)
[] .
IVM.assocs
@@ -768,7 +768,7 @@ loadPackages _config mbStore
, ignoreRight eitherPackageVersions
, ignoreRight eitherGlobalIdentifierMap
]
- return Nothing
+ return Nothing
loadPackages config _ = do
packageDirectories <- findDirectories (configPackagesPath config)
result <- mapM (loadPackageInfo config) packageDirectories
@@ -859,7 +859,7 @@ loadPackages config _ = do
, packagePathMapCompacted
, packageVersionsCompacted
, globalReferenceMapCompacted
- , globalIdentifierMapCompacted
+ , globalIdentifierMapCompacted
)
else return Nothing
where
@@ -941,7 +941,7 @@ type API = GetAllPackages
:<|> GetIdentifiers
:<|> GetGlobalReferences
:<|> GetGlobalIdentifiers
- :<|> GetHoogleDocs
+ :<|> GetHoogleDocs
type GetAllPackages = "api" :> "packages" :> Get '[JSON] AllPackages
@@ -979,7 +979,7 @@ type GetIdentifiers = "api" :> "identifiers"
[HCE.ExternalIdentifierInfo])
type GetGlobalReferences = "api" :> "globalReferences"
- :> Capture "externalId" HCE.ExternalId
+ :> Capture "externalId" HCE.ExternalId
:> Get '[JSON] [GlobalReferences]
type GetGlobalIdentifiers = "api" :> "globalIdentifiers"
@@ -994,7 +994,7 @@ type GetHoogleDocs = "api" :> "hoogleDocs"
:> Capture "moduleName" HCE.HaskellModuleName
:> Capture "entity" HoogleItemSort
:> Capture "name" T.Text
- :> Get '[JSON] T.Text
+ :> Get '[JSON] T.Text
instance AllCTRender '[ JSON] AllPackages where
handleAcceptH _ _ (AllPackages bytestring) =
@@ -1020,10 +1020,10 @@ instance ToHttpApiData HCE.LocatableEntity where
instance ToHttpApiData HCE.ExternalId where
toUrlPiece (HCE.ExternalId i) = i
-
+
instance ToHttpApiData PackageId where
toUrlPiece (PackageId p) = p
-
+
instance FromHttpApiData HCE.HaskellModulePath where
parseQueryParam = Right . HCE.HaskellModulePath
@@ -1035,10 +1035,10 @@ instance FromHttpApiData HCE.HaskellModuleName where
instance FromHttpApiData HCE.ExternalId where
parseQueryParam = Right . HCE.ExternalId
-
+
instance FromHttpApiData PackageId where
parseQueryParam = Right . PackageId
-
+
--------------------------------------------------------------------------------
-- Request handlers
--------------------------------------------------------------------------------
@@ -1074,7 +1074,7 @@ instance A.ToJSON SourceFile
getAllPackages :: ReaderT Environment IO AllPackages
getAllPackages = asks envPackageVersions
-
+
getExpressions ::
PackageId
-> HCE.HaskellModulePath
@@ -1287,8 +1287,8 @@ getGlobalReferences ::
HCE.ExternalId -> ReaderT Environment IO [GlobalReferences]
getGlobalReferences externalId = do
refMap <- asks envGlobalReferenceMap
- return $ maybe [] S.toDescList (HM.lookup externalId refMap)
-
+ return $ maybe [] S.toDescList (HM.lookup externalId refMap)
+
getReferences ::
PackageId
-> HCE.ExternalId
@@ -1345,7 +1345,7 @@ getReferences packageId externalId mbPage mbPerPage =
]
in case packageInfo' of
PackageInfo packageInfo ->
- mkRefsWithSource $ S.toList <$> HM.lookup externalId (HCE.externalIdOccMap packageInfo)
+ mkRefsWithSource $ S.toList <$> HM.lookup externalId (HCE.externalIdOccMap packageInfo)
PackageInfoStore pId store -> do
let eitherOccurrences =
Store.lookup
@@ -1489,7 +1489,7 @@ findIdentifiers packageId query' mbPage mbPerPage =
respond $
S.toList $
HCE.match (T.unpack $ T.drop 4 query) trie
- Left _ -> respond []
+ Left _ -> respond []
findGlobalIdentifiers ::
T.Text
@@ -1543,7 +1543,7 @@ valueToHoogleResultItem value =
| T.isInfixOf "#t" url = Just Typ
urlToSort _ = Nothing
mbResultSort = value ^? AL.key "url" . AL._String >>= urlToSort
- in HoogleResultItem <$> mbResultSort <*> mbModuleName <*> mbHtmlDocs
+ in HoogleResultItem <$> mbResultSort <*> mbModuleName <*> mbHtmlDocs
hoogleApiHost :: String
hoogleApiHost = "https://hoogle.haskell.org/"
@@ -1561,7 +1561,7 @@ getHoogleDocs packageId (HCE.HaskellModuleName moduleName) itemSort name
let hoogleQuery =
T.unpack name ++
" is:exact package:" ++ T.unpack (getPackageName packageName)
- url = hoogleApiHost ++ "?hoogle=" ++ encode hoogleQuery ++ "&mode=json"
+ url = hoogleApiHost ++ "?hoogle=" ++ encode hoogleQuery ++ "&mode=json"
error502 e =
throwServantError $
err502 {errBody = BSL.fromStrict $ BSC.pack $ show e}
@@ -1605,7 +1605,7 @@ paginateItems mbPage mbPerPage items = do
(fromIntegral totalCount)
(\offset limit -> return . L.take limit . L.drop offset $ items)
return (paginated, page, perPage, totalCount)
-
+
error404 :: BSL.ByteString -> ReaderT Environment IO a
error404 body = throwServantError $ err404 {errBody = body}
@@ -1619,7 +1619,7 @@ data PackageInfo
= PackageInfo (HCE.PackageInfo HCE.CompactModuleInfo)
| PackageInfoStore HCE.PackageId
Store.Store
-
+
withPackageInfo ::
PackageId
-> (PackageInfo -> ReaderT Environment IO a)
@@ -1709,7 +1709,7 @@ withModulePath packageInfo' componentId moduleName action =
store
case eitherModNameMap of
Right modNameMap ->
- case HM.lookup (ghcPrimHack packageInfo' moduleName) modNameMap of
+ case HM.lookup (ghcPrimHack packageInfo' moduleName) modNameMap of
Just componentMap -> case HM.lookup componentId componentMap of
Just modulePath -> action modulePath
Nothing -> case HM.lookup (HCE.ComponentId "lib") componentMap of
@@ -1748,7 +1748,7 @@ ghcPrimHack packageInfo' modName@(HCE.HaskellModuleName name) =
| packageName == "ghc-prim" && name == "GHC.Prim" ->
HCE.HaskellModuleName "GHC.Prim_"
| otherwise -> modName
-
+
parsePackageId :: PackageId -> Maybe (PackageName, Maybe Version)
parsePackageId (PackageId text) =
case T.splitOn "-" text of
@@ -1797,7 +1797,7 @@ staticMiddleware staticFilesPrefix packagePathMap _ app req callback
if exists
then callback $ sendFile path
else callback fileNotFound
- _ -> callback fileNotFound
+ _ -> callback fileNotFound
staticMiddleware _ _ mbJsDistPath _app req callback =
case mbJsDistPath of
Just jsDistPath -> do
@@ -1833,7 +1833,7 @@ sendEmbeddedFile path bs =
responseLBS
status200
[(hContentType, defaultMimeLookup $ T.pack $ takeFileName path)]
- (BSL.fromStrict bs)
+ (BSL.fromStrict bs)
fileNotFound :: Response
fileNotFound =
@@ -1843,8 +1843,7 @@ fileNotFound =
throwServantError :: (MonadIO m) => ServerError -> m a
#else
throwServantError :: (MonadIO m) => ServantErr -> m a
-#endif
-throwServantError = liftIO . throwIO
+throwServantError = liftIO . throwIO
server :: Environment -> ServerT API Handler
server env =
@@ -1852,7 +1851,7 @@ server env =
(Proxy :: Proxy API)
toServantHandler
(getAllPackages :<|>
- getDefinitionSite :<|>
+ getDefinitionSite :<|>
getExpressions :<|>
getReferences :<|>
findIdentifiers :<|>
generated by cgit v1.2.3 (git 2.25.1) at 2024-05-17 15:54:07 +0000