From 5e3b118fbf6a45bfe24f3c4889d7b42e60eacbeb Mon Sep 17 00:00:00 2001 From: Armando Santos Date: Thu, 22 Feb 2024 11:42:18 +0000 Subject: [PATCH 1/3] Bump io-classes --- cabal.project | 4 ++-- typed-protocols/typed-protocols.cabal | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/cabal.project b/cabal.project index 96839d90..e80ff75d 100644 --- a/cabal.project +++ b/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 diff --git a/typed-protocols/typed-protocols.cabal b/typed-protocols/typed-protocols.cabal index 1d92114d..b7909c9f 100644 --- a/typed-protocols/typed-protocols.cabal +++ b/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 From b5117fb43bc245cfa906e0db4d65b02e9eb3aa0d Mon Sep 17 00:00:00 2001 From: Armando Santos Date: Thu, 22 Feb 2024 19:56:56 +0000 Subject: [PATCH 2/3] Fix --- .../src/Network/TypedProtocol/Codec/CBOR.hs | 46 +++++++------------ .../typed-protocols-cborg.cabal | 3 +- 2 files changed, 18 insertions(+), 31 deletions(-) diff --git a/typed-protocols-cborg/src/Network/TypedProtocol/Codec/CBOR.hs b/typed-protocols-cborg/src/Network/TypedProtocol/Codec/CBOR.hs index 22d1721e..f42cc9e6 100644 --- a/typed-protocols-cborg/src/Network/TypedProtocol/Codec/CBOR.hs +++ b/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,7 +56,7 @@ 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 @@ -64,27 +64,20 @@ mkCodecCborStrictBS cborMsgEncode cborMsgDecode = 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 diff --git a/typed-protocols-cborg/typed-protocols-cborg.cabal b/typed-protocols-cborg/typed-protocols-cborg.cabal index 2ed32bd1..89ffc505 100644 --- a/typed-protocols-cborg/typed-protocols-cborg.cabal +++ b/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 From 9fa5e6d40e023b8b1bc054b949909722b137ed7f Mon Sep 17 00:00:00 2001 From: Armando Santos Date: Thu, 22 Feb 2024 19:57:59 +0000 Subject: [PATCH 3/3] update CHANGELOG --- typed-protocols-cborg/CHANGELOG.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/typed-protocols-cborg/CHANGELOG.md b/typed-protocols-cborg/CHANGELOG.md index adaf4516..07d14f5d 100644 --- a/typed-protocols-cborg/CHANGELOG.md +++ b/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