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 | 
