diff options
Diffstat (limited to 'app')
-rw-r--r-- | app/Indexer.hs | 4 | ||||
-rw-r--r-- | app/Server.hs | 65 | ||||
-rw-r--r-- | app/Store.hs | 12 |
3 files changed, 40 insertions, 41 deletions
diff --git a/app/Indexer.hs b/app/Indexer.hs index 26fad4a..88aa7ad 100644 --- a/app/Indexer.hs +++ b/app/Indexer.hs @@ -42,7 +42,7 @@ import Options.Applicative , strOption , value ) -import Paths_haskell_code_explorer as HSE (version) +import Paths_haskell_code_explorer as HSE (version) import System.Directory (createDirectoryIfMissing) import System.Exit (ExitCode(..), exitWith) import System.FilePath ((</>)) @@ -187,7 +187,7 @@ logger loggerSet minLogLevel logLevel msg = let showLogLevel :: LogLevel -> T.Text showLogLevel LevelDebug = "[debug]" showLogLevel LevelInfo = "[info]" - showLogLevel LevelWarn = "[warn]" + showLogLevel LevelWarn = "[warn]" showLogLevel LevelError = "[error]" showLogLevel (LevelOther t) = T.concat ["[",t,"]"] text = 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 :<|> diff --git a/app/Store.hs b/app/Store.hs index 15f5736..b0ea4ae 100644 --- a/app/Store.hs +++ b/app/Store.hs @@ -30,7 +30,7 @@ import Data.Serialize ( #if MIN_VERSION_cereal(0,5,8) #else get, put -#endif +#endif ) import GHC.Generics (Generic) import Prelude hiding (lookup) @@ -43,7 +43,7 @@ data Store = Store { index :: M.Map BSS.ShortByteString Location , values :: BS.ByteString } - + data Location = Location { offset :: Int , length :: Int @@ -56,7 +56,7 @@ instance Serialize Location instance Serialize BSS.ShortByteString where put = put . BSS.fromShort get = BSS.toShort <$> get -#endif +#endif class StoreItem item where toByteString :: item -> BS.ByteString @@ -74,7 +74,7 @@ data ReadMode = ReadEntireFile | MemoryMapFile deriving (Show, Eq) - + load :: FilePath -> ReadMode -> IO (Either String Store) load directoryPath readMode = do let valuesFilePath = directoryPath </> valuesFileName @@ -99,7 +99,7 @@ load directoryPath readMode = do lookup :: (StoreItem item) => KeyArgs item -> Store -> Either String item lookup keyArgs = lookupByteString (itemKey keyArgs) - + lookupByteString :: (StoreItem item) => BSS.ShortByteString -> Store -> Either String item lookupByteString key store = @@ -127,7 +127,7 @@ createStore directoryPath action = withFile (directoryPath </> valuesFileName) WriteMode $ \valuesHandle -> do locMap <- action valuesHandle BS.writeFile (directoryPath </> indexFileName) (encode locMap) - + writeValues :: Handle -> M.Map BSS.ShortByteString Location |