calamity 0.1.14.7 → 0.1.14.8

raw patch · 5 files changed

+41/−54 lines, 5 filesdep ~di-polysemyPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: di-polysemy

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−0
• calamity.cabal +3/−3
• src/Calamity/Client/Client.hs +1/−1
• src/Calamity/Gateway/Shard.hs +20/−32
• src/Calamity/Internal/RunIntoIO.hs +11/−18

@@ -1,5 +1,11 @@ # Changelog for Calamity +## 0.1.14.8++*2020-06-21*++* Replace uses of withLowerToIO with interpretFinal (should be more performant)+ ## 0.1.14.7  *2020-06-21*

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 8d7e2384272bd3170cf997e20fa3c1aa01a622aa2f515fda81b9cde2ee1dd641+-- hash: b703a1d32e704130629ed6fcd9b163debe4dc5f03cacb736036bf9e142bde656  name:           calamity-version:        0.1.14.7+version:        0.1.14.8 synopsis:       A library for writing discord bots in haskell description:    Please see the README on GitHub at <https://github.com/nitros12/calamity#readme> category:       Network, Web@@ -149,7 +149,7 @@     , deepseq >=1.4.4.0 && <2     , deque >=0.4 && <0.5     , df1 >=0.3 && <0.5-    , di-polysemy >=0.1.3 && <0.2+    , di-polysemy >=0.1.4 && <0.2     , exceptions >=0.10 && <0.11     , fmt >=0.6 && <0.7     , focus >=1.0 && <2

@@ -112,7 +112,7 @@ runBotIO' token status intents setup = do   client <- P.embed $ newClient token   handlers <- P.embed $ newTVarIO def-  P.asyncToIOFinal . P.runAtomicStateTVar handlers . P.runReader client . Di.runDiToStderrIO . Di.push "calamity" $ do+  P.asyncToIOFinal . P.runAtomicStateTVar handlers . P.runReader client . Di.runDiToStderrIOFinal . Di.push "calamity" $ do     void $ Di.push "calamity-setup" setup     r <- shardBot status intents     case r of

@@ -10,6 +10,7 @@ import           Calamity.Gateway.Intents import           Calamity.Gateway.Types import           Calamity.Internal.Utils+import           Calamity.Internal.RunIntoIO import           Calamity.Metrics.Eff import           Calamity.Types.LogEff import           Calamity.Types.Token@@ -29,8 +30,7 @@ import           Data.Functor import           Data.IORef import           Data.Maybe-import           Data.Text.Lazy                  ( Text, stripPrefix )-import           Data.Text.Lazy.Lens+import qualified Data.Text.Lazy                  as L import           Data.Void  import           DiPolysemy                      hiding ( debug, error, info )@@ -50,36 +50,22 @@ import           Prelude                         hiding ( error )  import           Wuss-import qualified Data.Text.Lazy as L -data Websocket m a where-  RunWebsocket :: Text -> Text -> (Connection -> m a) -> Websocket m a--P.makeSem ''Websocket--websocketToIO :: forall r a. P.Member (P.Embed IO) r => Sem (Websocket ': r) a -> Sem r a-websocketToIO = P.interpretH-  (\case-     RunWebsocket host path a -> do-       istate <- P.getInitialStateT-       ma <- P.bindT a--       P.withLowerToIO $ \lower finish -> do-         let done :: Sem (Websocket ': r) x -> IO x-             done = lower . P.raise . websocketToIO--         runSecureClient (host ^. unpacked) 443 (path ^. unpacked)-           (\x -> do-              res <- done (ma $ istate $> x)-              finish-              pure res))+runWebsocket :: P.Members '[P.Final IO, P.Embed IO] r+  => L.Text+  -> L.Text+  -> (Connection -> P.Sem r a)+  -> P.Sem r (Maybe a)+runWebsocket host path ma = do+  inner <- bindSemToIO ma+  P.embed $ runSecureClient (L.unpack host) 443 (L.unpack path) inner  newShardState :: Shard -> ShardState newShardState shard = ShardState shard Nothing Nothing False Nothing Nothing Nothing  -- | Creates and launches a shard newShard :: P.Members '[LogEff, MetricEff, P.Embed IO, P.Final IO, P.Async] r-         => Text+         => L.Text          -> Int          -> Int          -> Token@@ -141,7 +127,7 @@         r <- atomically $ tryWriteTBMQueue' outqueue (Control v)         when r inner -  handleWSException :: SomeException -> IO (Either (ControlMessage, Maybe Text) a)+  handleWSException :: SomeException -> IO (Either (ControlMessage, Maybe L.Text) a)   handleWSException e = pure $ case fromException e of     Just (CloseRequest code _)       | code `elem` [1000, 4004, 4010, 4011] ->@@ -176,21 +162,23 @@   outerloop = P.runError . forever $ do     shard :: Shard <- P.atomicGets (^. #shardS)     let host = shard ^. #gateway-    let host' =  fromMaybe host $ stripPrefix "wss://" host+    let host' =  fromMaybe host $ L.stripPrefix "wss://" host     info $ "starting up shard "+| (shard ^. #shardID) |+" of "+| (shard ^. #shardCount) |+"" --    innerLoopVal <- websocketToIO $ runWebsocket host' "/?v=6&encoding=json" innerloop+    innerLoopVal <- runWebsocket host' "/?v=6&encoding=json" innerloop      case innerLoopVal of-      ShardFlowShutDown -> do+      Just ShardFlowShutDown -> do         info "Shutting down shard"         P.throw ShardFlowShutDown -      ShardFlowRestart ->+      Just ShardFlowRestart ->         info "Restaring shard"         -- we restart normally when we loop +      Nothing -> -- won't happen unless innerloop starts using a non-deterministic effect+        info "Restarting shard (abnormal reasons?)"+   -- | The inner loop, handles receiving a message from discord or a command message   -- and then decides what to do with it   innerloop :: ShardC r => Connection -> Sem r ShardFlowControl@@ -327,5 +315,5 @@   unlessM (P.atomicGets (^. #hbResponse)) $ do     debug "No heartbeat response, restarting shard"     wsConn <- fromJust <$> P.atomicGets (^. #wsConn)-    P.embed $ sendCloseCode wsConn 4000 ("No heartbeat in time" :: Text)+    P.embed $ sendCloseCode wsConn 4000 ("No heartbeat in time" :: L.Text)     P.throw ()

@@ -2,9 +2,7 @@  -- | Something for converting polysemy actions into IO actions module Calamity.Internal.RunIntoIO-    ( IntoIO(..)-    , runIntoIOFinal-    , intoIO+    ( runSemToIO     , bindSemToIO ) where  import           Data.Functor@@ -12,20 +10,15 @@ import qualified Polysemy                         as P import qualified Polysemy.Final                   as P -data IntoIO p r m a where-  IntoIO :: (p -> m r) -> IntoIO p r m (p -> IO (Maybe r))--runIntoIOFinal :: forall r p b a. P.Member (P.Final IO) r => P.Sem (IntoIO p b ': r) a -> P.Sem r a-runIntoIOFinal = P.interpretFinal $ \case-  IntoIO m -> do-    istate <- P.getInitialStateS-    m' <- P.bindS m-    ins <- P.getInspectorS-    P.liftS $ pure (\x -> P.inspect ins <$> m' (istate $> x))--P.makeSem ''IntoIO+runSemToIO :: forall r a. P.Member (P.Final IO) r => P.Sem r a -> P.Sem r (IO (Maybe a))+runSemToIO m = P.withStrategicToFinal $ do+  m' <- P.runS m+  ins <- P.getInspectorS+  P.liftS $ pure (P.inspect ins <$> m')  bindSemToIO :: forall r p a. P.Member (P.Final IO) r => (p -> P.Sem r a) -> P.Sem r (p -> IO (Maybe a))-bindSemToIO f = runIntoIOFinal go-  where go :: P.Sem (IntoIO p a ': r) (p -> IO (Maybe a))-        go = intoIO (P.raise . f)+bindSemToIO m = P.withStrategicToFinal $ do+  istate <- P.getInitialStateS+  m' <- P.bindS m+  ins <- P.getInspectorS+  P.liftS $ pure (\x -> P.inspect ins <$> m' (istate $> x))