From 34117ad24dc9faf370e2f72998d2268beec0f82a Mon Sep 17 00:00:00 2001 From: Tristan Cacqueray Date: Tue, 3 Jan 2023 19:53:45 +0000 Subject: [PATCH] Update effectful constraints See https://github.com/haskell-effectful/effectful/issues/52#issuecomment-1269155485 --- codegen/MonocleCodegen.hs | 7 +++--- src/Lentille/Bugzilla.hs | 2 +- src/Lentille/Gerrit.hs | 2 +- src/Lentille/GraphQL.hs | 6 ++--- src/Macroscope/Main.hs | 21 ++++++++++++++---- src/Macroscope/Worker.hs | 6 ++--- src/Monocle/Api/Server.hs | 6 ++--- src/Monocle/Backend/Index.hs | 26 +++++++++++----------- src/Monocle/Backend/Queries.hs | 2 +- src/Monocle/Backend/Test.hs | 2 +- src/Monocle/Effects.hs | 40 ++++++++++++++++++---------------- src/Monocle/Main.hs | 4 ++-- src/Monocle/Servant/HTTP.hs | 7 +++--- 13 files changed, 74 insertions(+), 57 deletions(-) diff --git a/codegen/MonocleCodegen.hs b/codegen/MonocleCodegen.hs index 3047cddbb..ca9fdee36 100644 --- a/codegen/MonocleCodegen.hs +++ b/codegen/MonocleCodegen.hs @@ -156,8 +156,9 @@ protoToServant pb = , "import Servant.Auth.Server (Auth, JWT, Cookie)" , "import Monocle.Api.Jwt (AuthenticatedUser)" , "import Monocle.Effects (ApiEffects)" - , "import Effectful (Eff, (:>>))" - , "import Effectful.Concurrent.MVar qualified as E" + , "import Effectful (Eff)" + , "import Effectful.Concurrent qualified as E" + , "import Effectful qualified as E" ] imports = concatMap mkImport methods @@ -188,7 +189,7 @@ protoToServant pb = <> " :> Post '[PBJSON, JSON] " <> ("Monocle.Protob." <> moduleName <> "." <> name <> "Response") server = - [ "server :: ApiEffects es => '[E.Concurrent] :>> es => ServerT MonocleAPI (Eff es)" + [ "server :: ApiEffects es => E.Concurrent E.:> es => ServerT MonocleAPI (Eff es)" , "server =" , Text.intercalate "\n :<|>" $ map mkServer methods ] diff --git a/src/Lentille/Bugzilla.hs b/src/Lentille/Bugzilla.hs index 24259378f..c40f27737 100644 --- a/src/Lentille/Bugzilla.hs +++ b/src/Lentille/Bugzilla.hs @@ -42,7 +42,7 @@ import Effectful.Dispatch.Static (SideEffects (..), evalStaticRep) ------------------------------------------------------------------------------- -- BugZilla context ------------------------------------------------------------------------------- -type BZEffects es = [BZEffect, LoggerEffect, PrometheusEffect, Retry] :>> es +type BZEffects es = (BZEffect :> es, LoggerEffect :> es, PrometheusEffect :> es, Retry :> es) -- A dummy effect to replace the legacy MonadGerrit. -- TODO: re-implement on top of HttpEffect. diff --git a/src/Lentille/Gerrit.hs b/src/Lentille/Gerrit.hs index 6c9648067..dccd706f2 100644 --- a/src/Lentille/Gerrit.hs +++ b/src/Lentille/Gerrit.hs @@ -52,7 +52,7 @@ import Effectful.Dispatch.Static (SideEffects (..), evalStaticRep) ------------------------------------------------------------------------------- -- Gerrit context ------------------------------------------------------------------------------- -type GerritEffects es = [GerritEffect, LoggerEffect, PrometheusEffect, Retry] :>> es +type GerritEffects es = (GerritEffect :> es, LoggerEffect :> es, PrometheusEffect :> es, Retry :> es) -- A dummy effect to replace the legacy MonadGerrit. -- TODO: re-implement on top of HttpEffect. diff --git a/src/Lentille/GraphQL.hs b/src/Lentille/GraphQL.hs index f54190ea8..a55d5cac5 100644 --- a/src/Lentille/GraphQL.hs +++ b/src/Lentille/GraphQL.hs @@ -41,7 +41,7 @@ import Effectful.Concurrent.MVar qualified as E import Effectful.Retry import Monocle.Effects -type GraphEffects es = [LoggerEffect, HttpEffect, PrometheusEffect, TimeEffect, Retry, Concurrent, Fail] :>> es +type GraphEffects es = (LoggerEffect :> es, HttpEffect :> es, PrometheusEffect :> es, TimeEffect :> es, Retry :> es, Concurrent :> es, Fail :> es) type GraphResponse a = (PageInfo, Maybe RateLimit, [Text], a) @@ -68,7 +68,7 @@ data GraphClient = GraphClient } newGraphClient :: - [HttpEffect, Concurrent, Fail] :>> es => + Concurrent :> es => "url" ::: Text -> Secret -> Eff es GraphClient @@ -86,7 +86,7 @@ type DoFetch es = LBS.ByteString -> WriterT [RequestLog] (Eff es) LBS.ByteString -- | The morpheus-graphql-client fetch callback, -- doc: https://hackage.haskell.org/package/morpheus-graphql-client-0.17.0/docs/Data-Morpheus-Client.html -doGraphRequest :: [HttpEffect, PrometheusEffect, LoggerEffect, Retry] :>> es => GraphClient -> DoFetch es +doGraphRequest :: (HttpEffect :> es, PrometheusEffect :> es, LoggerEffect :> es, Retry :> es) => GraphClient -> DoFetch es doGraphRequest GraphClient {..} jsonBody = do -- Prepare the request let initRequest = HTTP.parseRequest_ (from url) diff --git a/src/Macroscope/Main.hs b/src/Macroscope/Main.hs index f7d97e1e6..21573c8a3 100644 --- a/src/Macroscope/Main.hs +++ b/src/Macroscope/Main.hs @@ -74,7 +74,7 @@ getCrawlers xs = do crawlerName :: Config.Crawler -> Text crawlerName Config.Crawler {..} = name -withMonitoringServer :: [IOE, LoggerEffect, E.Concurrent] :>> es => Int -> Eff es () -> Eff es () +withMonitoringServer :: (IOE :> es, LoggerEffect :> es, E.Concurrent :> es) => Int -> Eff es () -> Eff es () withMonitoringServer port action = do -- Setup GHC metrics for prometheus void $ promRegister ghcMetrics @@ -108,7 +108,7 @@ runMacroscope port confPath client = do . runMonoClient client $ withMonitoringServer port runMacroscope' -runMacroscope' :: forall es. [IOE, MonoConfigEffect] :>> es => MacroEffects es => Eff es () +runMacroscope' :: forall es. (IOE :> es, MonoConfigEffect :> es, MacroEffects es) => Eff es () runMacroscope' = do logInfo_ "Starting to fetch streams" loop (Clients mempty mempty mempty) @@ -254,7 +254,7 @@ getClientBZ url token = do pure (url, client) -- | Boilerplate function to retrieve a client from the store -getClientGraphQL :: [HttpEffect, Concurrent, Fail] :>> es => Text -> Secret -> GetClient es GraphClient +getClientGraphQL :: Concurrent :> es => Text -> Secret -> GetClient es GraphClient getClientGraphQL url token = do clients <- gets clientsGraph (client, newClients) <- mapMutate clients (url, token) $ lift $ newGraphClient url token @@ -282,7 +282,20 @@ groupByClient = grp >>> adapt keepOrder = fmap snd . NonEmpty.reverse -- | MonadMacro is an alias for a bunch of constraints required for the macroscope process -type MacroEffects es = [GerritEffect, BZEffect, E.Reader CrawlerEnv, MonoClientEffect, HttpEffect, PrometheusEffect, LoggerEffect, TimeEffect, EnvEffect, Retry, Concurrent, Fail] :>> es +type MacroEffects es = + ( GerritEffect :> es + , BZEffect :> es + , E.Reader CrawlerEnv :> es + , MonoClientEffect :> es + , HttpEffect :> es + , PrometheusEffect :> es + , LoggerEffect :> es + , TimeEffect :> es + , EnvEffect :> es + , Retry :> es + , Concurrent :> es + , Fail :> es + ) runMacroEffects :: IOE :> es => Eff (GerritEffect : BZEffect : TimeEffect : HttpEffect : PrometheusEffect : EnvEffect : Fail : Retry : Concurrent : es) a -> Eff es a runMacroEffects = runConcurrent . runRetry . runFailIO . runEnv . runPrometheus . runHttpEffect . runTime . runBZ . runGerrit diff --git a/src/Macroscope/Worker.hs b/src/Macroscope/Worker.hs index 499ea063b..e138f9917 100644 --- a/src/Macroscope/Worker.hs +++ b/src/Macroscope/Worker.hs @@ -107,7 +107,7 @@ process logFunc postFunc = -- | 'runStream' is the main function used by macroscope runStream :: forall es. - [LoggerEffect, Retry, PrometheusEffect, E.Reader CrawlerEnv, MonoClientEffect, TimeEffect] :>> es => + (LoggerEffect :> es, Retry :> es, PrometheusEffect :> es, E.Reader CrawlerEnv :> es, MonoClientEffect :> es, TimeEffect :> es) => ApiKey -> IndexName -> CrawlerName -> @@ -141,7 +141,7 @@ runStream apiKey indexName crawlerName documentStream = do -- when it contains a Left. runStreamError :: forall es. - [LoggerEffect, Retry, PrometheusEffect, E.Reader CrawlerEnv, MonoClientEffect] :>> es => + (LoggerEffect :> es, Retry :> es, PrometheusEffect :> es, MonoClientEffect :> es) => UTCTime -> ApiKey -> IndexName -> @@ -255,7 +255,7 @@ runStreamError startTime apiKey indexName (CrawlerName crawlerName) documentStre -- | Adapt the API response getStreamOldestEntity :: - [PrometheusEffect, LoggerEffect, Retry, MonoClientEffect] :>> es => + (PrometheusEffect :> es, LoggerEffect :> es, Retry :> es, MonoClientEffect :> es) => LText -> LText -> CrawlerPB.EntityType -> diff --git a/src/Monocle/Api/Server.hs b/src/Monocle/Api/Server.hs index 0dd689d7f..f0ee1ed92 100644 --- a/src/Monocle/Api/Server.hs +++ b/src/Monocle/Api/Server.hs @@ -74,12 +74,12 @@ import Servant.Auth.Server.Internal.JWT (makeJWT) import Web.Cookie (SetCookie (..), defaultSetCookie, sameSiteStrict) -- | 'getWorkspaces' returns the list of workspace, reloading the config when the file changed. -getWorkspaces :: '[MonoConfigEffect] :>> es => Eff es [Config.Index] +getWorkspaces :: MonoConfigEffect :> es => Eff es [Config.Index] getWorkspaces = Config.workspaces . Config.csConfig <$> getReloadConfig -- | 'updateIndex' if needed - ensures index exists and refresh crawler Metadata -- note: updateIndex is the handler that needs the Concurrent Effect to modify the MVar. -updateIndex :: forall es. ApiEffects es => [MonoQuery, E.Concurrent] :>> es => Config.Index -> MVar Config.WorkspaceStatus -> Eff es () +updateIndex :: forall es. (ApiEffects es, MonoQuery :> es, E.Concurrent :> es) => Config.Index -> MVar Config.WorkspaceStatus -> Eff es () updateIndex index wsRef = E.modifyMVar_ wsRef doUpdateIfNeeded where doUpdateIfNeeded :: Config.WorkspaceStatus -> Eff es Config.WorkspaceStatus @@ -388,7 +388,7 @@ crawlerCommit _auth request = do $ Right err -- | /crawler/get_commit_info endpoint -crawlerCommitInfo :: ApiEffects es => '[E.Concurrent] :>> es => AuthResult AuthenticatedUser -> CrawlerPB.CommitInfoRequest -> Eff es CrawlerPB.CommitInfoResponse +crawlerCommitInfo :: (ApiEffects es, E.Concurrent :> es) => AuthResult AuthenticatedUser -> CrawlerPB.CommitInfoRequest -> Eff es CrawlerPB.CommitInfoResponse crawlerCommitInfo _auth request = do Config.ConfigStatus _ Config.Config {..} wsStatus <- getReloadConfig let tenants = workspaces diff --git a/src/Monocle/Backend/Index.hs b/src/Monocle/Backend/Index.hs index 4220ed23f..e8d6d2150 100644 --- a/src/Monocle/Backend/Index.hs +++ b/src/Monocle/Backend/Index.hs @@ -237,7 +237,7 @@ configDoc = BH.DocId "config" -- | Upgrade to config v1 (migrate legacy GH crawler to the new API) -- | This function looks for GitHub project crawler metadata docs and reset the -- | lastCommitAt to the lastUpdatedAt date of the most recent change of the repository. -upgradeConfigV1 :: forall es. '[E.Fail, LoggerEffect, MonoQuery] :>> es => IndexEffects es => Eff es () +upgradeConfigV1 :: forall es. (E.Fail :> es, MonoQuery :> es) => IndexEffects es => Eff es () upgradeConfigV1 = do indexName <- getIndexName logInfo "Applying migration to schema V1 on workspace" ["index" .= indexName] @@ -290,7 +290,7 @@ upgradeConfigV1 = do otherEntity -> do logInfo "Unexpected entity" ["other" .= otherEntity] -upgradeConfigV2 :: forall es. '[E.Fail, LoggerEffect, MonoQuery] :>> es => IndexEffects es => Eff es () +upgradeConfigV2 :: forall es. MonoQuery :> es => IndexEffects es => Eff es () upgradeConfigV2 = do indexName <- getIndexName logInfo "Applying migration to schema V2 on workspace" ["index" .= indexName] @@ -299,7 +299,7 @@ upgradeConfigV2 = do logInfo "Authors cache populated monocle uid" ["added" .= added] -- | Add self_merged data to event of type ChangeMergedEvent -upgradeConfigV3 :: forall es. '[E.Fail, LoggerEffect, MonoQuery] :>> es => IndexEffects es => Eff es Int +upgradeConfigV3 :: forall es. MonoQuery :> es => IndexEffects es => Eff es Int upgradeConfigV3 = do indexName <- getIndexName logInfo "Applying migration to schema V3 on workspace" ["index" .= indexName] @@ -325,7 +325,7 @@ upgradeConfigV3 = do BulkUpdate indexName (getEventDocId ev) $ toJSON ev -- | Fix duration computation that was computed in the reverse order giving negative durations -upgradeConfigV4 :: forall es. '[E.Fail, LoggerEffect, MonoQuery] :>> es => IndexEffects es => Eff es Int +upgradeConfigV4 :: forall es. MonoQuery :> es => IndexEffects es => Eff es Int upgradeConfigV4 = do indexName <- getIndexName logInfo "Applying migration to schema V4 on workspace " ["index" .= indexName] @@ -353,7 +353,7 @@ upgradeConfigV4 = do mkChangeBulkUpdate indexName change = BulkUpdate indexName (getChangeDocId change) $ toJSON change -upgrades :: forall es. '[E.Fail, LoggerEffect, MonoQuery] :>> es => IndexEffects es => [(ConfigVersion, Eff es ())] +upgrades :: forall es. (E.Fail :> es, MonoQuery :> es) => IndexEffects es => [(ConfigVersion, Eff es ())] upgrades = [ (ConfigVersion 1, upgradeConfigV1) , (ConfigVersion 2, upgradeConfigV2) @@ -383,13 +383,13 @@ getVersion = ConfigVersion . fromMaybe 0 . preview (_Object . at "version" . tra setVersion :: ConfigVersion -> Value -> Value setVersion (ConfigVersion v) = set (_Object . at "version") (Just . Number . fromInteger $ v) -getConfigVersion :: forall es. '[E.Fail, LoggerEffect, MonoQuery] :>> es => IndexEffects es => Eff es (ConfigVersion, Value) +getConfigVersion :: forall es. (E.Fail :> es, MonoQuery :> es) => IndexEffects es => Eff es (ConfigVersion, Value) getConfigVersion = do QueryConfig _ <- getQueryTarget currentConfig <- fromMaybe (object []) <$> getDocumentById configDoc pure (getVersion currentConfig, currentConfig) -ensureConfigIndex :: forall es. '[E.Fail, LoggerEffect, MonoQuery, Retry] :>> es => IndexEffects es => Eff es () +ensureConfigIndex :: forall es. (E.Fail :> es, MonoQuery :> es, Retry :> es) => IndexEffects es => Eff es () ensureConfigIndex = do QueryConfig conf <- getQueryTarget @@ -416,14 +416,14 @@ ensureConfigIndex = do traverseWorkspace action conf = do traverse_ (\ws -> localQueryTarget (QueryWorkspace ws) action) (Config.getWorkspaces conf) -ensureIndexSetup :: '[MonoQuery, LoggerEffect, ElasticEffect, Retry] :>> es => Eff es () +ensureIndexSetup :: (MonoQuery :> es, LoggerEffect :> es, ElasticEffect :> es, Retry :> es) => Eff es () ensureIndexSetup = do indexName <- getIndexName logInfo "Ensure workspace " ["index" .= indexName] createIndex indexName ChangesIndexMapping esSettings indexName (object ["index" .= object ["max_regex_length" .= (50_000 :: Int)]]) -ensureIndexCrawlerMetadata :: [E.Fail, LoggerEffect, ElasticEffect, MonoQuery] :>> es => Eff es () +ensureIndexCrawlerMetadata :: (E.Fail :> es, LoggerEffect :> es, ElasticEffect :> es, MonoQuery :> es) => Eff es () ensureIndexCrawlerMetadata = do QueryWorkspace config <- getQueryTarget traverse_ initCrawlerMetadata $ Config.crawlers config @@ -436,12 +436,12 @@ withRefresh action = do refreshResp <- esRefreshIndex index unless (BH.isSuccess refreshResp) (error $ "Unable to refresh index: " <> show resp) -ensureIndex :: '[E.Fail, LoggerEffect, MonoQuery, ElasticEffect, Retry] :>> es => Eff es () +ensureIndex :: (E.Fail :> es, LoggerEffect :> es, MonoQuery :> es, ElasticEffect :> es, Retry :> es) => Eff es () ensureIndex = do ensureIndexSetup ensureIndexCrawlerMetadata -removeIndex :: '[E.Fail, LoggerEffect, MonoQuery, ElasticEffect] :>> es => Eff es () +removeIndex :: (E.Fail :> es, MonoQuery :> es, ElasticEffect :> es) => Eff es () removeIndex = do indexName <- getIndexName _resp <- esDeleteIndex indexName @@ -672,7 +672,7 @@ data TaskDataDoc = TaskDataDoc type TaskDataOrphanDoc = TaskDataDoc -getOrphanTaskDataByChangeURL :: forall es. [ElasticEffect, MonoQuery] :>> es => [Text] -> Eff es [EChangeOrphanTD] +getOrphanTaskDataByChangeURL :: forall es. (ElasticEffect :> es, MonoQuery :> es) => [Text] -> Eff es [EChangeOrphanTD] getOrphanTaskDataByChangeURL urls = do index <- getIndexName results <- scanSearch index @@ -690,7 +690,7 @@ getOrphanTaskDataByChangeURL urls = do ] ] -getOrphanTaskDataAndDeclareAdoption :: [ElasticEffect, MonoQuery] :>> es => IndexEffects es => [Text] -> Eff es [EChangeOrphanTD] +getOrphanTaskDataAndDeclareAdoption :: MonoQuery :> es => IndexEffects es => [Text] -> Eff es [EChangeOrphanTD] getOrphanTaskDataAndDeclareAdoption urls = do oTDs <- getOrphanTaskDataByChangeURL urls void $ updateDocs $ toAdoptedDoc <$> oTDs diff --git a/src/Monocle/Backend/Queries.hs b/src/Monocle/Backend/Queries.hs index e34c89de4..17dee9dcd 100644 --- a/src/Monocle/Backend/Queries.hs +++ b/src/Monocle/Backend/Queries.hs @@ -28,7 +28,7 @@ import Streaming.Prelude qualified as Streaming import Monocle.Effects -- Legacy wrappers -simpleSearchLegacy :: [LoggerEffect, ElasticEffect] :>> es => (FromJSON a) => BH.IndexName -> BH.Search -> Eff es [BH.Hit a] +simpleSearchLegacy :: (LoggerEffect :> es, ElasticEffect :> es, FromJSON a) => BH.IndexName -> BH.Search -> Eff es [BH.Hit a] simpleSearchLegacy indexName search = BH.hits . BH.searchHits <$> esSearchLegacy indexName search ------------------------------------------------------------------------------- diff --git a/src/Monocle/Backend/Test.hs b/src/Monocle/Backend/Test.hs index 112d86aeb..04c61f422 100644 --- a/src/Monocle/Backend/Test.hs +++ b/src/Monocle/Backend/Test.hs @@ -440,7 +440,7 @@ testUpgradeConfigV1 = do getCrawlerProjectMDDocID = let entity = Project repoName in entityDocID (CrawlerName crawlerName) entity - setDocs :: [MonoQuery, ElasticEffect, LoggerEffect] :>> es => Config.Crawler -> Text -> Text -> Text -> (Eff es) () + setDocs :: (MonoQuery :> es, ElasticEffect :> es, LoggerEffect :> es) => Config.Crawler -> Text -> Text -> Text -> (Eff es) () setDocs crawler crawlerName repo1 repo2 = do -- Init crawler metadata I.initCrawlerMetadata crawler diff --git a/src/Monocle/Effects.hs b/src/Monocle/Effects.hs index 76e97c31b..e1328715a 100644 --- a/src/Monocle/Effects.hs +++ b/src/Monocle/Effects.hs @@ -36,12 +36,6 @@ -- -- `LoggerEffect :> es` meanst that the es list contains the Effect. -- --- To add multiple effect, use the ':>>' operator: --- --- `[LoggerEffect,ConfigEffect] :>> es` == `(LoggerEffect :> es, ConfigEffect :> es)` --- --- If the list contains only one item, it needs to be quoted, e.g.: `'[LoggerEffect] :>> es` --- -- * Effect execution -- -- Effect can be executed using a run* function to remove the effect from the list. @@ -109,16 +103,24 @@ import Monocle.Client.Api (crawlerAddDoc, crawlerCommit, crawlerCommitInfo) import Monocle.Protob.Crawler qualified as CrawlerPB -- the servant api, previously known as AppM -type ApiEffects es = [IOE, E.Reader AppEnv, E.Error Servant.ServerError, MonoConfigEffect, LoggerEffect, ElasticEffect, E.Fail] :>> es +type ApiEffects es = + ( IOE :> es + , E.Reader AppEnv :> es + , E.Error Servant.ServerError :> es + , MonoConfigEffect :> es + , LoggerEffect :> es + , ElasticEffect :> es + , E.Fail :> es + ) -- the effect necessary to run elastic request -type IndexEffects es = [ElasticEffect, LoggerEffect] :>> es +type IndexEffects es = (ElasticEffect :> es, LoggerEffect :> es) --- the query handler, previously known as QueryM -type QEffects es = [ElasticEffect, LoggerEffect, MonoQuery] :>> es +-- the query handler :> es, previously known as QueryM +type QEffects es = (ElasticEffect :> es, LoggerEffect :> es, MonoQuery :> es) --- the macro handler, previously known as LentilleM -type CrawlerEffects es = [LoggerEffect, MonoClientEffect] :>> es +-- the macro handler :> es, previously known as LentilleM +type CrawlerEffects es = (LoggerEffect :> es, MonoClientEffect :> es) type TestEffects es = (E.Fail :> es, IOE :> es, QEffects es) @@ -138,7 +140,7 @@ testTree = ] where testEff a b = liftIO (a @?= b) - testMonoConfig :: [MonoConfigEffect, IOE] :>> es => FilePath -> Eff es () + testMonoConfig :: (MonoConfigEffect :> es, IOE :> es) => FilePath -> Eff es () testMonoConfig fp = do -- Setup the test config let getNames c = Monocle.Config.getWorkspaceName <$> Monocle.Config.getWorkspaces (Monocle.Config.csConfig c) @@ -361,12 +363,12 @@ runElasticEffect bhEnv action = do -- bhEnv <- liftIO (BH.mkBHEnv <$> pure server <*> Monocle.Client.mkManager) evalStaticRep (ElasticEffect bhEnv) action -esSearch :: [ElasticEffect, LoggerEffect] :>> es => (ToJSON body, FromJSONField resp) => BH.IndexName -> body -> BHR.ScrollRequest -> Eff es (BH.SearchResult resp) +esSearch :: (ElasticEffect :> es, ToJSON body, FromJSONField resp) => BH.IndexName -> body -> BHR.ScrollRequest -> Eff es (BH.SearchResult resp) esSearch iname body scrollReq = do ElasticEffect env <- getStaticRep unsafeEff_ $ BH.runBH env $ BHR.search iname body scrollReq -esAdvance :: [ElasticEffect, LoggerEffect] :>> es => FromJSON resp => BH.ScrollId -> Eff es (BH.SearchResult resp) +esAdvance :: (ElasticEffect :> es, FromJSON resp) => BH.ScrollId -> Eff es (BH.SearchResult resp) esAdvance scroll = do ElasticEffect env <- getStaticRep unsafeEff_ $ BH.runBH env $ BHR.advance scroll @@ -448,7 +450,7 @@ esUpdateDocument iname ids body doc = do unsafeEff_ $ BH.runBH env $ BH.updateDocument iname ids body doc -- Legacy wrappers -esSearchLegacy :: [LoggerEffect, ElasticEffect] :>> es => (FromJSON a) => BH.IndexName -> BH.Search -> Eff es (BH.SearchResult a) +esSearchLegacy :: (LoggerEffect :> es, ElasticEffect :> es, FromJSON a) => BH.IndexName -> BH.Search -> Eff es (BH.SearchResult a) esSearchLegacy indexName search = do ElasticEffect env <- getStaticRep (rawResp, resp) <- unsafeEff_ $ BH.runBH env do @@ -498,7 +500,7 @@ retryLimit :: Int retryLimit = 7 -- | Retry HTTP network action, doubling backoff each time -httpRetry :: (HasCallStack, [PrometheusEffect, Retry, LoggerEffect] :>> es) => Text -> Eff es a -> Eff es a +httpRetry :: (HasCallStack, PrometheusEffect :> es, Retry :> es, LoggerEffect :> es) => Text -> Eff es a -> Eff es a httpRetry urlLabel baseAction = Retry.recovering policy [httpHandler] (const action) where modName = case getCallStack callStack of @@ -533,7 +535,7 @@ type TestApi = "route1" Servant.:> Get '[Servant.JSON] Natural :<|> "route2" Servant.:> Get '[Servant.JSON] Natural -type ApiEffects' es = [IOE, LoggerEffect] :>> es +type ApiEffects' es = (IOE :> es, LoggerEffect :> es) -- | serverEff is the effectful implementation of the TestAPI serverEff' :: forall es. ApiEffects' es => Servant.ServerT TestApi (Eff es) @@ -564,7 +566,7 @@ demoServant = Warp.run 8080 $ Servant.serve (Proxy @TestApi) $ liftServer es demoCrawler = runEff $ runLoggerEffect $ runHttpEffect crawlerDemo -type CrawlerEffect' es = [IOE, HttpEffect, LoggerEffect] :>> es +type CrawlerEffect' es = (IOE :> es, HttpEffect :> es, LoggerEffect :> es) crawlerDemo :: CrawlerEffect' es => Eff es () crawlerDemo = withContext ("crawler" .= ("crawler-name" :: Text)) do diff --git a/src/Monocle/Main.hs b/src/Monocle/Main.hs index 6bdb2fdf1..21646dcaa 100644 --- a/src/Monocle/Main.hs +++ b/src/Monocle/Main.hs @@ -34,7 +34,7 @@ import Effectful.Reader.Static qualified as E import Effectful.Servant qualified import Monocle.Effects -rootServer :: ApiEffects es => '[E.Concurrent] :>> es => CookieSettings -> Servant.ServerT RootAPI (Eff es) +rootServer :: (ApiEffects es, E.Concurrent Monocle.Prelude.:> es) => CookieSettings -> Servant.ServerT RootAPI (Eff es) rootServer cookieSettings = app :<|> app where app = server :<|> searchAuthorsHandler :<|> handleLogin :<|> handleLoggedIn cookieSettings @@ -115,7 +115,7 @@ run cfg = . runMonoConfig (configFile cfg) $ run' cfg aplogger -run' :: '[IOE, MonoConfigEffect] :>> es => ApiConfig -> ApacheLogger -> Eff es () +run' :: (IOE Monocle.Prelude.:> es, MonoConfigEffect Monocle.Prelude.:> es) => ApiConfig -> ApacheLogger -> Eff es () run' ApiConfig {..} aplogger = E.runConcurrent $ runLoggerEffect do conf <- Config.csConfig <$> getReloadConfig let workspaces = Config.getWorkspaces conf diff --git a/src/Monocle/Servant/HTTP.hs b/src/Monocle/Servant/HTTP.hs index fe7d4a8a6..76811edc2 100644 --- a/src/Monocle/Servant/HTTP.hs +++ b/src/Monocle/Servant/HTTP.hs @@ -7,8 +7,9 @@ -- SPDX-License-Identifier: AGPL-3.0-only module Monocle.Servant.HTTP (MonocleAPI, server) where -import Effectful (Eff, (:>>)) -import Effectful.Concurrent.MVar qualified as E +import Effectful (Eff) +import Effectful qualified as E +import Effectful.Concurrent qualified as E import Monocle.Api.Jwt (AuthenticatedUser) import Monocle.Api.Server (authGetMagicJwt, authWhoAmi, configGetAbout, configGetGroupMembers, configGetGroups, configGetProjects, configGetWorkspaces, crawlerAddDoc, crawlerCommit, crawlerCommitInfo, loginLoginValidation, metricGet, metricInfo, metricList, searchAuthor, searchCheck, searchFields, searchQuery, searchSuggestions) import Monocle.Effects (ApiEffects) @@ -42,7 +43,7 @@ type MonocleAPI = :<|> "crawler" :> "add" :> Auth '[JWT, Cookie] AuthenticatedUser :> ReqBody '[JSON] Monocle.Protob.Crawler.AddDocRequest :> Post '[PBJSON, JSON] Monocle.Protob.Crawler.AddDocResponse :<|> "crawler" :> "commit" :> Auth '[JWT, Cookie] AuthenticatedUser :> ReqBody '[JSON] Monocle.Protob.Crawler.CommitRequest :> Post '[PBJSON, JSON] Monocle.Protob.Crawler.CommitResponse :<|> "crawler" :> "get_commit_info" :> Auth '[JWT, Cookie] AuthenticatedUser :> ReqBody '[JSON] Monocle.Protob.Crawler.CommitInfoRequest :> Post '[PBJSON, JSON] Monocle.Protob.Crawler.CommitInfoResponse -server :: ApiEffects es => '[E.Concurrent] :>> es => ServerT MonocleAPI (Eff es) +server :: ApiEffects es => E.Concurrent E.:> es => ServerT MonocleAPI (Eff es) server = loginLoginValidation :<|> authGetMagicJwt