sparrow 0.0.2.0 → 0.0.2.1

raw patch · 4 files changed

+55/−5 lines, 4 filesPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

Files

• sparrow.cabal +2/−2
• src/Web/Dependencies/Sparrow/Client.hs +2/−2
• src/Web/Dependencies/Sparrow/Server.hs +1/−1
• src/Web/Dependencies/Sparrow/Types.hs +50/−0

@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 309095bf67849fabbab5152d18d36076dcba4000675a82d0129d9a121f9ad671+-- hash: ca194da829dc469ef7c296f3c390fa1b36df83bd6bff4eee9cab731849fe886e  name:           sparrow-version:        0.0.2.0+version:        0.0.2.1 synopsis:       Unified streaming dependency management for web apps description:    Please see the README on Github at <https://git.localcooking.com/tooling/sparrow#readme> category:       Web

@@ -166,7 +166,7 @@             f | tls = runSecureClient (T.unpack $ printURIAuthHost host) (Strict.maybe 80 fromIntegral port) $ T.unpack $ printLocation loc               | otherwise = runClient (T.unpack $ printURIAuthHost host) (Strict.maybe 80 fromIntegral port) $ T.unpack $ printLocation loc -        x' <- runM (pingPong ((10^6) * 10) x) -- every 10 seconds+        x' <- runM (pingPong ((10^(6 :: Int)) * 10) x) -- every 10 seconds         x'' <- runM (runClientAppT (toClientAppT x'))         f x'' @@ -268,6 +268,6 @@    --   Start clients   z <- runM (runReaderT runSparrowClientT env)-  evaluate z+  _ <- evaluate z    wait ws

@@ -279,7 +279,7 @@                   liftIO (killAllOnOpenThreads env sessionID)               } -        wsApp' <- pingPong ((10^6) * 10) wsApp -- every 10 seconds+        wsApp' <- pingPong ((10^(6 :: Int)) * 10) wsApp -- every 10 seconds          (websocketsOrT defaultConnectionOptions (toServerAppT wsApp')) app req resp 

@@ -4,6 +4,7 @@   , OverloadedStrings   , RecordWildCards   , NamedFieldPuns+  , RankNTypes   #-}  module Web.Dependencies.Sparrow.Types where@@ -35,6 +36,13 @@   , serverSendCurrent :: deltaOut -> m ()   } +hoistServerArgs :: (forall a. m a -> n a) -> ServerArgs m deltaOut -> ServerArgs n deltaOut+hoistServerArgs f ServerArgs{..} = ServerArgs+  { serverDeltaReject = f serverDeltaReject+  , serverSendCurrent = f . serverSendCurrent+  }++ data ServerReturn m f initOut deltaIn deltaOut = ServerReturn   { serverInitOut   :: initOut   , serverOnOpen    :: ServerArgs m deltaOut@@ -45,15 +53,49 @@                     -> deltaIn -> m () -- ^ invoked for each receive   } +hoistServerReturn :: (forall a. m a -> n a)+                  -> (forall a. n a -> m a)+                  -> ServerReturn m f initOut deltaIn deltaOut+                  -> ServerReturn n f initOut deltaIn deltaOut+hoistServerReturn f g ServerReturn{..} = ServerReturn+  { serverInitOut+  , serverOnOpen = \args -> f $ serverOnOpen $ hoistServerArgs g args+  , serverOnReceive = \args deltaIn -> f $ serverOnReceive (hoistServerArgs g args) deltaIn+  }++ data ServerContinue m f initOut deltaIn deltaOut = ServerContinue   { serverContinue      :: Broadcast m -> m (ServerReturn m f initOut deltaIn deltaOut)   , serverOnUnsubscribe :: m ()   } +hoistServerContinue :: Monad m+                    => (forall a. m a -> n a)+                    -> (forall a. n a -> m a)+                    -> ServerContinue m f initOut deltaIn deltaOut+                    -> ServerContinue n f initOut deltaIn deltaOut+hoistServerContinue f g ServerContinue{..} = ServerContinue+  { serverContinue = \bcast -> f $ hoistServerReturn f g <$> serverContinue (hoistBroadcast g bcast)+  , serverOnUnsubscribe = f serverOnUnsubscribe+  }++ type Server m f initIn initOut deltaIn deltaOut =   initIn -> m (Maybe (ServerContinue m f initOut deltaIn deltaOut)) +hoistServer :: Monad m => Monad n+            => (forall a. m a -> n a)+            -> (forall a. n a -> m a)+            -> Server m f initIn initOut deltaIn deltaOut+            -> Server n f initIn initOut deltaIn deltaOut+hoistServer f g server = \initIn -> do+  mCont <- f $ server initIn+  case mCont of+    Nothing -> pure Nothing+    Just cont -> pure $ Just $ hoistServerContinue f g cont ++ staticServer :: MonadIO m              => Alternative f              => (initIn -> m (Maybe initOut)) -- ^ Produce an initOut@@ -134,6 +176,14 @@ -- ** Broadcast  type Broadcast m = Topic -> m (Maybe (Value -> Maybe (m ())))++hoistBroadcast :: Monad n => (forall a. m a -> n a) -> Broadcast m -> Broadcast n+hoistBroadcast f bcast = \topic -> do+  mResolve <- f (bcast topic)+  case mResolve of+    Nothing -> pure Nothing+    Just resolve -> pure $ Just $ \v -> f <$> resolve v+   -- * JSON Encodings