Bump io-classes

cabal.project

@@ -11,8 +11,8 @@ repository cardano-haskell-packages
     d4a35cd3121aa00d18544bb0ac01c3e1691d618f462c46129271bccf39f7e8ee
 
 index-state:
-    hackage.haskell.org 2023-11-08T09:44:54Z
-  , cardano-haskell-packages 2023-05-16T03:39:10Z
+    hackage.haskell.org 2024-02-22T12:48:49Z
+  , cardano-haskell-packages 2024-02-22T11:15:34Z
 
 
 packages: ./typed-protocols

typed-protocols-cborg/CHANGELOG.md

@@ -1,5 +1,9 @@
 # Revision history for typed-protocols-cborg
 
+## next version
+
+* Bump io-classes
+
 ## 0.1.0.0 -- 2021-07-28
 
 * Initial experiments and prototyping

typed-protocols-cborg/src/Network/TypedProtocol/Codec/CBOR.hs

@@ -11,7 +11,7 @@ module Network.TypedProtocol.Codec.CBOR
   ) where
 
 import           Control.Monad.Class.MonadST (MonadST (..))
-import           Control.Monad.ST
+import           Control.Monad.Primitive
 
 import qualified Codec.CBOR.Decoding as CBOR (Decoder)
 import qualified Codec.CBOR.Encoding as CBOR (Encoding)
@@ -56,35 +56,28 @@ mkCodecCborStrictBS
 mkCodecCborStrictBS cborMsgEncode cborMsgDecode =
     Codec {
       encode = \stok msg -> convertCborEncoder (cborMsgEncode stok) msg,
-      decode = \stok     -> convertCborDecoder (cborMsgDecode stok)
+      decode = \stok     -> convertCborDecoderBS (cborMsgDecode stok)
     }
   where
     convertCborEncoder :: (a -> CBOR.Encoding) -> a -> BS.ByteString
     convertCborEncoder cborEncode =
         CBOR.toStrictByteString
       . cborEncode
 
-    convertCborDecoder
-      :: (forall s. CBOR.Decoder s a)
-      -> m (DecodeStep BS.ByteString DeserialiseFailure m a)
-    convertCborDecoder cborDecode =
-        withLiftST (convertCborDecoderBS cborDecode)
-
 convertCborDecoderBS
-  :: forall s m a. Functor m
-  => (CBOR.Decoder s a)
-  -> (forall b. ST s b -> m b)
+  :: forall m a. MonadST m
+  => CBOR.Decoder (PrimState m) a
   -> m (DecodeStep BS.ByteString DeserialiseFailure m a)
-convertCborDecoderBS cborDecode liftST =
-    go <$> liftST (CBOR.deserialiseIncremental cborDecode)
+convertCborDecoderBS cborDecode =
+    go <$> stToIO (CBOR.deserialiseIncremental cborDecode)
   where
-    go :: CBOR.IDecode s a
+    go :: CBOR.IDecode (PrimState m) a
        -> DecodeStep BS.ByteString DeserialiseFailure m a
     go (CBOR.Done  trailing _ x)
       | BS.null trailing       = DecodeDone x Nothing
       | otherwise              = DecodeDone x (Just trailing)
     go (CBOR.Fail _ _ failure) = DecodeFail failure
-    go (CBOR.Partial k)        = DecodePartial (fmap go . liftST . k)
+    go (CBOR.Partial k)        = DecodePartial (fmap go . stToIO . k)
 
 
 -- | Construct a 'Codec' for a CBOR based serialisation format, using lazy
@@ -110,7 +103,7 @@ mkCodecCborLazyBS
 mkCodecCborLazyBS  cborMsgEncode cborMsgDecode =
     Codec {
       encode = \stok msg -> convertCborEncoder (cborMsgEncode stok) msg,
-      decode = \stok     -> convertCborDecoder (cborMsgDecode stok)
+      decode = \stok     -> convertCborDecoderLBS (cborMsgDecode stok)
     }
   where
     convertCborEncoder :: (a -> CBOR.Encoding) -> a -> LBS.ByteString
@@ -119,23 +112,16 @@ mkCodecCborLazyBS  cborMsgEncode cborMsgDecode =
       . CBOR.toBuilder
       . cborEncode
 
-    convertCborDecoder
-      :: (forall s. CBOR.Decoder s a)
-      -> m (DecodeStep LBS.ByteString CBOR.DeserialiseFailure m a)
-    convertCborDecoder cborDecode =
-        withLiftST (convertCborDecoderLBS cborDecode)
-
 convertCborDecoderLBS
-  :: forall s m a. Monad m
-  => (CBOR.Decoder s a)
-  -> (forall b. ST s b -> m b)
+  :: forall m a. MonadST m
+  => CBOR.Decoder (PrimState m) a
   -> m (DecodeStep LBS.ByteString CBOR.DeserialiseFailure m a)
-convertCborDecoderLBS cborDecode liftST =
-    go [] =<< liftST (CBOR.deserialiseIncremental cborDecode)
+convertCborDecoderLBS cborDecode =
+    go [] =<< stToIO (CBOR.deserialiseIncremental cborDecode)
   where
     -- Have to mediate between a CBOR decoder that consumes strict bytestrings
     -- and our choice here that consumes lazy bytestrings.
-    go :: [BS.ByteString] -> CBOR.IDecode s a
+    go :: [BS.ByteString] -> CBOR.IDecode (PrimState m) a
        -> m (DecodeStep LBS.ByteString CBOR.DeserialiseFailure m a)
     go [] (CBOR.Done  trailing _ x)
       | BS.null trailing    = return (DecodeDone x Nothing)
@@ -147,9 +133,9 @@ convertCborDecoderLBS cborDecode liftST =
 
     -- We keep a bunch of chunks and supply the CBOR decoder with them
     -- until we run out, when we go get another bunch.
-    go (c:cs) (CBOR.Partial  k) = go cs =<< liftST (k (Just c))
+    go (c:cs) (CBOR.Partial  k) = go cs =<< stToIO (k (Just c))
     go []     (CBOR.Partial  k) = return $ DecodePartial $ \mbs -> case mbs of
-                                    Nothing -> go [] =<< liftST (k Nothing)
+                                    Nothing -> go [] =<< stToIO (k Nothing)
                                     Just bs -> go cs (CBOR.Partial k)
                                       where cs = LBS.toChunks bs
 

typed-protocols-cborg/typed-protocols-cborg.cabal

@@ -23,7 +23,8 @@ library
                      cborg           >=0.2.1 && <0.3,
 
                      io-classes,
-                     typed-protocols
+                     typed-protocols,
+                     primitive
 
   hs-source-dirs:    src
   default-language:  Haskell2010

typed-protocols/typed-protocols.cabal

@@ -32,7 +32,7 @@ library
                    , TypeOperators
                    , BangPatterns
   build-depends:     base,
-                     io-classes >= 1.0 && < 1.4
+                     io-classes >= 1.0 && < 1.5
 
   hs-source-dirs:    src
   default-language:  Haskell2010