Merge pull request #1 from well-typed/edsko/support-older-bytestring

Support bytestring-0.10

.github/workflows/haskell-ci.yml

@@ -1,16 +1,16 @@
 # This GitHub workflow config has been generated by a script via
 #
-#   haskell-ci 'github' 'cabal.project' '--config' 'cabal.haskell-ci'
+#   haskell-ci 'github' 'cabal.project.ci'
 #
 # To regenerate the script (for example after adjusting tested-with) run
 #
 #   haskell-ci regenerate
 #
 # For more information, see https://github.com/haskell-CI/haskell-ci
 #
-# version: 0.17.20240109
+# version: 0.19.20240402
 #
-# REGENDATA ("0.17.20240109",["github","cabal.project","--config","cabal.haskell-ci"])
+# REGENDATA ("0.19.20240402",["github","cabal.project.ci"])
 #
 name: Haskell-CI
 on:
@@ -28,9 +28,9 @@ jobs:
     strategy:
       matrix:
         include:
-          - compiler: ghc-9.8.1
+          - compiler: ghc-9.8.2
             compilerKind: ghc
-            compilerVersion: 9.8.1
+            compilerVersion: 9.8.2
             setup-method: ghcup
             allow-failure: false
           - compiler: ghc-9.6.4
@@ -62,6 +62,7 @@ jobs:
           mkdir -p "$HOME/.ghcup/bin"
           curl -sL https://downloads.haskell.org/ghcup/0.1.20.0/x86_64-linux-ghcup-0.1.20.0 > "$HOME/.ghcup/bin/ghcup"
           chmod a+x "$HOME/.ghcup/bin/ghcup"
+          "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.8.yaml;
           "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)
           "$HOME/.ghcup/bin/ghcup" install cabal 3.10.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
           apt-get update
@@ -169,9 +170,15 @@ jobs:
           cat >> cabal.project <<EOF
           source-repository-package
             type:     git
-            location: https://github.com/FinleyMcIlwaine/bos-snappy
-            tag:      b00b103a8c522aa3adde7e922537ab6b74f73eb0
+            location: https://github.com/edsko/snappy.git
+            tag:      4f6288ea7fff56967a37ddccbd4894fad0a1b6b9
+
+          package snappy-c
+            tests:       True
+            benchmarks:  True
+            ghc-options: -Werror
           EOF
+          $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(snappy-c)$/; }' >> cabal.project.local
           cat cabal.project
           cat cabal.project.local
       - name: dump install plan

cabal.haskell-ci

@@ -1,12 +1,2 @@
+copy-fields: all
 apt: libsnappy-dev
-
--- Unconstrained build. TODO: Take this out when we drop 8.10.7
---
--- We do this just so we can build with 8.10.7 and bytestring >= 0.11. It's not
--- as simple as just saying `installed: -bytestring` since we then need to do
--- the same for all libraries in the global db that depend on bytestring, and so
--- on transitively.
---
--- There is probably a cleaner way to do this, but it's the first thing that
--- worked.
-installed: -all

cabal.project

@@ -1,6 +1,10 @@
 packages: .
 
+package snappy-c
+  tests: True
+  benchmarks: True
+
 source-repository-package
   type: git
-  location: https://github.com/FinleyMcIlwaine/bos-snappy
-  tag: b00b103a8c522aa3adde7e922537ab6b74f73eb0
+  location: https://github.com/edsko/snappy.git
+  tag: 4f6288ea7fff56967a37ddccbd4894fad0a1b6b9

cabal.project.ci

@@ -0,0 +1,11 @@
+packages: .
+
+package snappy-c
+  tests: True
+  benchmarks: True
+  ghc-options: -Werror
+
+source-repository-package
+  type: git
+  location: https://github.com/edsko/snappy.git
+  tag: 4f6288ea7fff56967a37ddccbd4894fad0a1b6b9

snappy-c.cabal

@@ -1,6 +1,6 @@
 cabal-version:      3.0
 name:               snappy-c
-version:            0.1.0
+version:            0.1.1
 synopsis:           Bindings to Google's Snappy: A fast compression library
 description:        [Snappy](https://github.com/google/snappy) is a fast
                     (de)compression library. It is written in C++, but a basic
@@ -21,7 +21,7 @@ tested-with:        GHC==8.10.7
                   , GHC==9.2.8
                   , GHC==9.4.8
                   , GHC==9.6.4
-                  , GHC==9.8.1
+                  , GHC==9.8.2
 
 source-repository head
   type:     git
@@ -77,7 +77,7 @@ library
       Codec.Compression.SnappyC.Internal.FrameFormat
       Codec.Compression.SnappyC.Internal.Util
   build-depends:
-    , bytestring   >= 0.11  && < 0.13
+    , bytestring   >= 0.10  && < 0.13
     , data-default >= 0.7   && < 0.8
     , digest       >= 0.0.2 && < 0.0.3
     , mtl          >= 2.2.2 && < 2.4
@@ -94,7 +94,7 @@ executable snappy-cli
   build-depends:
       snappy-c
 
-    , bytestring           >= 0.11  && < 0.13
+    , bytestring           >= 0.10  && < 0.13
     , conduit              >= 1.3.5 && < 1.4
     , data-default         >= 0.7   && < 0.8
     , optparse-applicative >= 0.18  && < 0.19
@@ -119,7 +119,7 @@ test-suite test-snappy-c
     , snappy-c
   build-depends:
       -- External dependencies
-    , bytestring       >= 0.11 && < 0.13
+    , bytestring       >= 0.10 && < 0.13
     , tasty            >= 1.5  && < 1.6
     , tasty-hunit      >= 0.10 && < 0.11
     , tasty-quickcheck >= 0.10 && < 0.11
@@ -139,7 +139,7 @@ benchmark bench-snappy-c
     , snappy-c
 
     -- external
-    , bytestring  >= 0.11  && < 0.13
+    , bytestring  >= 0.10  && < 0.13
     , criterion   >= 1.6.3 && < 1.7
     , deepseq     >= 1.4   && < 1.6
     , random      >= 1.2.1 && < 1.3
@@ -148,4 +148,4 @@ benchmark bench-snappy-c
 
   ghc-options:
       -threaded
-      -rtsopts
+      -rtsopts

src/Codec/Compression/SnappyC/Raw.hs

@@ -21,80 +21,76 @@ import Codec.Compression.SnappyC.Internal.C qualified as C
 import Data.ByteString.Internal (ByteString(..))
 import Foreign
 import System.IO.Unsafe
+import Data.ByteString.Unsafe
 
 -- | Compress the input using [Snappy](https://github.com/google/snappy/).
 --
 -- The result is in Snappy raw format, /not/ the framing format.
 compress :: ByteString -> ByteString
-compress (BS sfp slen) =
-    unsafePerformIO $ do
+compress bs = unsafePerformIO $ do
+    unsafeUseAsCStringLen bs $ \(sptr, slen) -> do
       let dlen = C.snappy_max_compressed_length (fromIntegral slen)
-      dfp <- mallocForeignPtrBytes (fromIntegral dlen)
-      withForeignPtr sfp $ \sptr ->
-        withForeignPtr dfp $ \dptr ->
-          with dlen $ \dlen_ptr ->
-            case
-              C.snappy_compress
-                (castPtr sptr)
-                (fromIntegral slen)
-                (castPtr dptr)
-                dlen_ptr
-            of
-              0 ->
-                BS dfp . fromIntegral <$> peek dlen_ptr
-              1 ->
-                error "impossible: there is no invalid input for compression"
-              2 ->
-                error "impossible: the buffer size is always set correctly"
-              status ->
-                error $
-                  "impossible: unexpected status from snappy_compress: " ++
-                  show status
+      dptr <- mallocBytes (fromIntegral dlen)
+      with dlen $ \dlen_ptr ->
+        case
+          C.snappy_compress
+            (castPtr sptr)
+            (fromIntegral slen)
+            (castPtr dptr)
+            dlen_ptr
+        of
+          0 -> do
+            len <- fromIntegral <$> peek dlen_ptr
+            unsafePackMallocCStringLen (dptr, len)
+          1 ->
+            error "impossible: there is no invalid input for compression"
+          2 ->
+            error "impossible: the buffer size is always set correctly"
+          status ->
+            error $
+              "impossible: unexpected status from snappy_compress: " ++
+              show status
 
 -- | Decompress the input using [Snappy](https://github.com/google/snappy/).
 --
 -- Returns 'Nothing' if the input is not in Snappy raw format or
 -- otherwise ill-formed.
 decompress :: ByteString -> Maybe ByteString
-decompress (BS sfp slen) =
-    unsafePerformIO $ do
-      withForeignPtr sfp $
-        \sptr ->
-          alloca $
-            \dlen_ptr ->
-              case
-                C.snappy_uncompressed_length
+decompress bs = unsafePerformIO $ do
+    unsafeUseAsCStringLen bs $ \(sptr, slen) ->
+      alloca $ \dlen_ptr ->
+        case
+          C.snappy_uncompressed_length
+            (castPtr sptr)
+            (fromIntegral slen)
+            dlen_ptr
+        of
+          0 -> do
+            dlen <- fromIntegral <$> peek dlen_ptr
+            dptr <- mallocBytes dlen
+            case
+                C.snappy_uncompress
                   (castPtr sptr)
                   (fromIntegral slen)
+                  (castPtr dptr)
                   dlen_ptr
-              of
-                0 -> do
-                  dlen <- fromIntegral <$> peek dlen_ptr
-                  dfp <- mallocForeignPtrBytes dlen
-                  withForeignPtr dfp $
-                    \dptr ->
-                      case
-                          C.snappy_uncompress
-                            (castPtr sptr)
-                            (fromIntegral slen)
-                            (castPtr dptr)
-                            dlen_ptr
-                      of
-                        0 ->
-                          Just . BS dfp . fromIntegral <$> peek dlen_ptr
-                        1 ->
-                          -- Invalid input. Successful result from
-                          -- snappy_uncompressed_length does *not* mean the
-                          -- input is completely valid
-                          return Nothing
-                        status ->
-                          error $
-                            "impossible: decompression failed with status " ++
-                            show status
-                1 ->
-                  return Nothing
-                status ->
-                  error $
-                    "impossible: snappy_uncompressed_length failed with " ++
-                    "status" ++ show status
+             of
+              0 -> do
+                len <- fromIntegral <$> peek dlen_ptr
+                Just <$> unsafePackMallocCStringLen (dptr, len)
+              1 ->
+                -- Invalid input. Successful result from
+                -- snappy_uncompressed_length does *not* mean the
+                -- input is completely valid
+                return Nothing
+              status ->
+                error $
+                  "impossible: decompression failed with status " ++
+                  show status
+          1 ->
+            return Nothing
+          status ->
+            error $
+              "impossible: snappy_uncompressed_length failed with " ++
+              "status" ++ show status