Revert base library dependencies, release 0.21.0

.github/workflows/cabal.yaml

@@ -11,15 +11,15 @@ jobs:
     strategy:
       fail-fast: false
       matrix:
-        ghc: # should mirror current stable releases: https://www.haskell.org/ghc/download.html
+        ghc:
           - '9.8'
           - '9.10'
         os: [ubuntu-latest, macOS-latest, windows-latest]
         cabal: ['latest']
 
     steps:
     - uses: actions/checkout@v3
-    - uses: haskell/actions/setup@v2 # https://github.com/haskell/actions/tree/main/setup#haskellactionssetup
+    - uses: haskell/actions/setup@v2
       with:
         ghc-version: ${{ matrix.ghc }}
 

.github/workflows/nix.yaml

@@ -19,13 +19,9 @@ jobs:
         extra_nix_config: |
           access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
 
-    # follow guide: https://nix.dev/tutorials/continuous-integration-github-actions
-    # this uses the tokens which are revokable
     - uses: cachix/cachix-action@v15
       with:
         name: jappie
-        # If you chose API tokens for write access OR if you have a private cache
-        # authToken: '${{ secrets.CACHIX_AUTH_TOKEN }}'
         signingKey: '${{ secrets.CACHIX_SIGNING_KEY }}'
-    - run: nix-build
-    - run: nix-shell --run "echo OK"
+    - run: nix-build nix/ci.nix
+    - run: nix-shell --run "cabal test"

CHANGELOG.md

@@ -1,3 +1,11 @@
+## 0.21.1
++ Reverted 0.21.0 changes: restored custom Base16/Base32/Base64 encode/decode,
+  the GHC.Prim-based `Bytes` implementation, and `readWord8OffAddr#`-based FNV
+  hashing. The `base16`, `base32`, `base64`, and `text` dependencies are removed
+  again.
++ Deleted `Data.Memory.Internal.CompatPrim64` (unreferenced).
++ Added GitHub Actions CI (nix + cabal matrix).
+
 ## 0.21.0
 
 + `Data.ByteArray.Encoding`: replaced custom Base16/Base32/Base64 encode/decode

Data/ByteArray.hs

@@ -9,6 +9,9 @@
 --
 -- This module should be imported qualified.
 --
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 module Data.ByteArray
     (

Data/ByteArray/Bytes.hs

@@ -7,50 +7,191 @@
 --
 -- Simple and efficient byte array types
 --
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE DeriveDataTypeable #-}
 module Data.ByteArray.Bytes
     ( Bytes
     ) where
 
-import           Control.DeepSeq          (NFData(..))
-import           Data.ByteArray.Types
-import           Data.Char                (chr)
-import           Data.Foldable            (toList)
+import           Control.DeepSeq(NFData(..))
+import           GHC.Exts (unsafeCoerce#)
+import           GHC.Word
+import           GHC.Char (chr)
+import           GHC.Types
+import           GHC.Prim
+import           GHC.Ptr
 import           Data.Semigroup
+import           Data.Foldable (toList)
+import           Data.Memory.PtrMethods
+import           Data.Memory.Internal.CompatPrim
+import           Data.Memory.Internal.Compat      (unsafeDoIO)
+import           Data.ByteArray.Types
 import           Data.Typeable
-import qualified Data.ByteString          as BS
-import qualified Data.ByteString.Internal as BSI
-import           Foreign.ForeignPtr       (withForeignPtr)
-import           Foreign.Ptr              (castPtr)
+
 
 -- | Simplest Byte Array
-newtype Bytes = Bytes BS.ByteString
+data Bytes = Bytes (MutableByteArray# RealWorld)
   deriving (Typeable)
 
 instance NFData Bytes where
     rnf b = b `seq` ()
 
 instance Show Bytes where
-    showsPrec p (Bytes b) = showsPrec p (map (chr . fromIntegral) (BS.unpack b))
-
+    showsPrec p b r = showsPrec p (bytesUnpackChars b []) r
 instance Eq Bytes where
-    Bytes a == Bytes b = a == b
-
+    (==) = bytesEq
 instance Ord Bytes where
-    compare (Bytes a) (Bytes b) = compare a b
-
+    compare = bytesCompare
 instance Semigroup Bytes where
-    Bytes a <> Bytes b = Bytes (a <> b)
-    sconcat bs = Bytes $ BS.concat [b | Bytes b <- toList bs]
-
+    b1 <> b2      = unsafeDoIO $ bytesAppend b1 b2
+    sconcat       = unsafeDoIO . bytesConcat . toList
 instance Monoid Bytes where
-    mempty = Bytes BS.empty
+    mempty        = unsafeDoIO (newBytes 0)
 
 instance ByteArrayAccess Bytes where
-    length (Bytes b) = BS.length b
-    withByteArray (Bytes b) = withByteArray b
-
+    length        = bytesLength
+    withByteArray = withBytes
 instance ByteArray Bytes where
-    allocRet n f = do
-        fptr <- BSI.mallocByteString n
-        r    <- withForeignPtr fptr (f . castPtr)
-        return (r, Bytes (BSI.PS fptr 0 n))
+    allocRet = bytesAllocRet
+
+------------------------------------------------------------------------
+newBytes :: Int -> IO Bytes
+newBytes (I# sz)
+    | booleanPrim (sz <# 0#) = error "Bytes: size must be >= 0"
+    | otherwise              = IO $ \s ->
+        case newAlignedPinnedByteArray# sz 8# s of
+            (# s', mbarr #) -> (# s', Bytes mbarr #)
+
+touchBytes :: Bytes -> IO ()
+touchBytes (Bytes mba) = IO $ \s -> case touch# mba s of s' -> (# s', () #)
+{-# INLINE touchBytes #-}
+
+sizeofBytes :: Bytes -> Int
+sizeofBytes (Bytes mba) = I# (sizeofMutableByteArray# mba)
+{-# INLINE sizeofBytes #-}
+
+withPtr :: Bytes -> (Ptr p -> IO a) -> IO a
+withPtr b@(Bytes mba) f = do
+    a <- f (Ptr (byteArrayContents# (unsafeCoerce# mba)))
+    touchBytes b
+    return a
+------------------------------------------------------------------------
+
+bytesAlloc :: Int -> (Ptr p -> IO ()) -> IO Bytes
+bytesAlloc sz f = do
+    ba <- newBytes sz
+    withPtr ba f
+    return ba
+
+bytesConcat :: [Bytes] -> IO Bytes
+bytesConcat l = bytesAlloc retLen (copy l)
+  where
+    !retLen = sum $ map bytesLength l
+
+    copy []     _   = return ()
+    copy (x:xs) dst = do
+        withPtr x $ \src -> memCopy dst src chunkLen
+        copy xs (dst `plusPtr` chunkLen)
+      where
+        !chunkLen = bytesLength x
+
+bytesAppend :: Bytes -> Bytes -> IO Bytes
+bytesAppend b1 b2 = bytesAlloc retLen $ \dst -> do
+    withPtr b1 $ \s1 -> memCopy dst                  s1 len1
+    withPtr b2 $ \s2 -> memCopy (dst `plusPtr` len1) s2 len2
+  where
+    !len1   = bytesLength b1
+    !len2   = bytesLength b2
+    !retLen = len1 + len2
+
+bytesAllocRet :: Int -> (Ptr p -> IO a) -> IO (a, Bytes)
+bytesAllocRet sz f = do
+    ba <- newBytes sz
+    r <- withPtr ba f
+    return (r, ba)
+
+bytesLength :: Bytes -> Int
+bytesLength = sizeofBytes
+{-# LANGUAGE bytesLength #-}
+
+withBytes :: Bytes -> (Ptr p -> IO a) -> IO a
+withBytes = withPtr
+
+bytesEq :: Bytes -> Bytes -> Bool
+bytesEq b1@(Bytes m1) b2@(Bytes m2)
+    | l1 /= l2  = False
+    | otherwise = unsafeDoIO $ IO $ \s -> loop 0# s
+  where
+    !l1@(I# len) = bytesLength b1
+    !l2          = bytesLength b2
+
+    loop i s
+        | booleanPrim (i ==# len) = (# s, True #)
+        | otherwise               =
+            case readWord8Array# m1 i s of
+                (# s', e1 #) -> case readWord8Array# m2 i s' of
+                    (# s'', e2 #) ->
+                        if (W8# e1) == (W8# e2)
+                            then loop (i +# 1#) s''
+                            else (# s'', False #)
+    {-# INLINE loop #-}
+
+bytesCompare :: Bytes -> Bytes -> Ordering
+bytesCompare b1@(Bytes m1) b2@(Bytes m2) = unsafeDoIO $ loop 0
+  where
+    !l1  = bytesLength b1
+    !l2  = bytesLength b2
+    !len = min l1 l2
+
+    loop !i
+        | i == len =
+            if l1 == l2
+                then pure EQ
+                else if l1 > l2 then pure GT
+                                else pure LT
+        | otherwise               = do
+            e1 <- read8 m1 i
+            e2 <- read8 m2 i
+            if e1 == e2
+                then loop (i+1)
+                else if e1 < e2 then pure LT
+                                else pure GT
+
+    read8 m (I# i) = IO $ \s -> case readWord8Array# m i s of
+                                    (# s2, e #) -> (# s2, W8# e #)
+
+bytesUnpackChars :: Bytes -> String -> String
+bytesUnpackChars (Bytes mba) xs = chunkLoop 0#
+  where
+    !len = sizeofMutableByteArray# mba
+    -- chunk 64 bytes at a time
+    chunkLoop :: Int# -> [Char]
+    chunkLoop idx
+        | booleanPrim (len ==# idx) = []
+        | booleanPrim ((len -# idx) ># 63#) =
+            bytesLoop idx 64# (chunkLoop (idx +# 64#))
+        | otherwise =
+            bytesLoop idx (len -# idx) xs
+
+    bytesLoop idx chunkLenM1 paramAcc = unsafeDoIO $
+        loop (idx +# chunkLenM1 -# 1#) paramAcc
+      where loop i acc
+                | booleanPrim (i ==# idx) = do
+                    c <- rChar i
+                    return (c : acc)
+                | otherwise = do
+                    c <- rChar i
+                    loop (i -# 1#) (c : acc)
+
+    rChar :: Int# -> IO Char
+    rChar idx = IO $ \s ->
+        case readWord8Array# mba idx s of
+            (# s2, w #) -> (# s2, chr (fromIntegral (W8# w)) #)
+
+{-
+bytesShowHex :: Bytes -> String
+bytesShowHex b = showHexadecimal (withPtr b) (bytesLength b)
+{-# NOINLINE bytesShowHex #-}
+-}