packages feed

shortbytestring (empty) → 0.1.0.0

raw patch · 17 files changed

+3342/−0 lines, 17 filesdep +basedep +bytestringdep +deepseq

Dependencies added: base, bytestring, deepseq, exceptions, ghc-prim, primitive, random, shortbytestring, tasty, tasty-bench, tasty-quickcheck, template-haskell, text, word16, word8

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for shortbytestring++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2021 Julian Ospald++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ bench/Bench.hs view
@@ -0,0 +1,16 @@+module Main (main) where+++import           GHC.IO.Encoding+import           Test.Tasty.Bench++import qualified Short.BenchAll as SBA+import qualified Short.Word16.BenchAll as SWBA++++main :: IO ()+main = do+  setLocaleEncoding utf8+  defaultMain+    (SBA.benchmarks ++ SWBA.benchmarks)
+ bench/Short/BenchAll.hs view
@@ -0,0 +1,134 @@+-- |+-- Copyright   : (c) 2011 Simon Meier+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Simon Meier <iridcode@gmail.com>+-- Stability   : experimental+-- Portability : tested on GHC only+--++{-# LANGUAGE BangPatterns        #-}+{-# LANGUAGE PackageImports      #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE MagicHash           #-}++module Short.BenchAll (benchmarks) where++import Short.BenchIndices++import           Data.Monoid+import           Data.String+import           Test.Tasty.Bench+import           Prelude                               hiding (words)++import qualified "bytestring" Data.ByteString.Char8                 as S8+import "shortbytestring" Data.ByteString.Short                 ( ShortByteString )+import qualified "shortbytestring" Data.ByteString.Short             as S+++import           Foreign++import System.Random++++------------------------------------------------------------------------------+-- Benchmark+------------------------------------------------------------------------------++-- input data (NOINLINE to ensure memoization)+----------------------------------------------++-- | Few-enough repetitions to avoid making GC too expensive.+nRepl :: Int+nRepl = 10000++{-# NOINLINE intData #-}+intData :: [Int]+intData = [1..nRepl]++{-# NOINLINE byteStringData #-}+byteStringData :: ShortByteString+byteStringData = S.pack $ map fromIntegral intData++-- benchmark wrappers+---------------------++{-# INLINE benchB' #-}+benchB' :: String -> a -> (a -> ShortByteString) -> Benchmark+benchB' name x b = bench name $ whnf (S.length . b) x+++hashInt :: Int -> Int+hashInt x = iterate step x !! 10+  where+    step a = e+      where b = (a `xor` 61) `xor` (a `shiftR` 16)+            c = b + (b `shiftL` 3)+            d = c `xor` (c `shiftR` 4)+            e = d * 0x27d4eb2d++w :: Int -> Word8+w = fromIntegral++hashWord8 :: Word8 -> Word8+hashWord8 = fromIntegral . hashInt . fromIntegral++partitionStrict :: (Word8 -> Bool) -> Benchmarkable+partitionStrict p = nf (S.partition p) . randomStrict $ mkStdGen 98423098+  where randomStrict = fst . S.unfoldrN 10000 (Just . random)+++-- benchmarks+-------------+++foldInputs :: [ShortByteString]+foldInputs = map (\k -> S.pack $ if (k :: Int) <= 6 then take (2 ^ k) [32..95] else concat (replicate (2 ^ (k - 6)) [32..95])) [0..16]++largeTraversalInput :: ShortByteString+largeTraversalInput = S.concat (replicate 10 byteStringData)++smallTraversalInput :: ShortByteString+smallTraversalInput = S.toShort . S8.unlines $ map S8.pack ["The quick brown fox"]++benchmarks :: [ Benchmark ]+benchmarks =+    [ bgroup "AFP.Data.ByteString.Short"+      [ bgroup "Small payload"+        [ benchB' "mempty"        ()  (const mempty)+        , benchB' "UTF-8 String (naive)" "hello world\0" fromString+        , benchB' "String (naive)" "hello world!" fromString+        ]+      ]++    , bgroup "partition"+      [+        bgroup "strict"+        [+          bench "mostlyTrueFast"  $ partitionStrict (< (w 225))+        , bench "mostlyFalseFast" $ partitionStrict (< (w 10))+        , bench "balancedFast"    $ partitionStrict (< (w 128))++        , bench "mostlyTrueSlow"  $ partitionStrict (\x -> hashWord8 x < w 225)+        , bench "mostlyFalseSlow" $ partitionStrict (\x -> hashWord8 x < w 10)+        , bench "balancedSlow"    $ partitionStrict (\x -> hashWord8 x < w 128)+        ]+      ]+    , bgroup "folds"+      [ bgroup "foldl'" $ map (\s -> bench (show $ S.length s) $+          nf (S.foldl' (\acc x -> acc + fromIntegral x) (0 :: Int)) s) foldInputs+      , bgroup "foldr'" $ map (\s -> bench (show $ S.length s) $+          nf (S.foldr' (\x acc -> fromIntegral x + acc) (0 :: Int)) s) foldInputs+      , bgroup "filter" $ map (\s -> bench (show $ S.length s) $+          nf (S.filter odd) s) foldInputs+      ]+    , bgroup "findIndex_"+      [ bench "find"           $ nf (S.find (>= 198)) byteStringData+      ]+    , bgroup "traversals"+      [ bench "map (+1) large" $ nf (S.map (+ 1)) largeTraversalInput+      , bench "map (+1) small" $ nf (S.map (+ 1)) smallTraversalInput+      ]+    , benchIndices+    ]
+ bench/Short/BenchIndices.hs view
@@ -0,0 +1,82 @@+-- |+-- Copyright   : (c) 2020 Peter Duchovni+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Peter Duchovni <caufeminecraft+github@gmail.com>+--+-- Benchmark elemIndex, findIndex, elemIndices, and findIndices++{-# LANGUAGE BangPatterns        #-}+{-# LANGUAGE PackageImports        #-}++module Short.BenchIndices (benchIndices) where++import           Data.Maybe                            (listToMaybe)+import           Data.Monoid+import "shortbytestring" Data.ByteString.Short                 ( ShortByteString )+import           Test.Tasty.Bench+import           Prelude                               hiding (words)+import           Data.Word                             (Word8)++import qualified "shortbytestring" Data.ByteString.Short             as S+++------------------------------------------------------------------------------+-- Benchmark+------------------------------------------------------------------------------++-- ASCII \n to ensure no typos+nl :: Word8+nl = 0xa+{-# INLINE nl #-}++-- non-inlined equality test+nilEq :: Word8 -> Word8 -> Bool+{-# NOINLINE nilEq #-}+nilEq = (==)++-- lines of 200 letters from a to e, followed by repeated letter f+absurdlong :: ShortByteString+absurdlong = S.replicate 200 0x61 <> S.singleton nl+          <> S.replicate 200 0x62 <> S.singleton nl+          <> S.replicate 200 0x63 <> S.singleton nl+          <> S.replicate 200 0x64 <> S.singleton nl+          <> S.replicate 200 0x65 <> S.singleton nl+          <> S.replicate 999999 0x66++benchIndices :: Benchmark+benchIndices = bgroup "Short.BenchIndices"+    [ bgroup "ByteString strict first index" $+        [ bench "FindIndices" $ nf (listToMaybe . S.findIndices (== nl)) absurdlong+        , bench "ElemIndices" $ nf (listToMaybe . S.elemIndices     nl)  absurdlong+        , bench "FindIndex"   $ nf (S.findIndex (== nl)) absurdlong+        , bench "ElemIndex"   $ nf (S.elemIndex     nl)  absurdlong+        ]+    , bgroup "ByteString strict second index" $+        [ bench "FindIndices" $ nf (listToMaybe . tail . S.findIndices (== nl)) absurdlong+        , bench "ElemIndices" $ nf (listToMaybe . tail . S.elemIndices     nl)  absurdlong+        , bench "FindIndex"   $ nf bench_find_index_second absurdlong+        , bench "ElemIndex"   $ nf bench_elem_index_second absurdlong+        ]+    , bgroup "ByteString index equality inlining" $+        [ bench "FindIndices/inlined"     $ nf (S.findIndices    (== nl)) absurdlong+        , bench "FindIndices/non-inlined" $ nf (S.findIndices (nilEq nl)) absurdlong+        , bench "FindIndex/inlined"       $ nf (S.findIndex      (== nl)) absurdlong+        , bench "FindIndex/non-inlined"   $ nf (S.findIndex   (nilEq nl)) absurdlong+        ]+    ]++bench_find_index_second :: ShortByteString -> Maybe Int+bench_find_index_second bs =+  let isNl = (== nl)+   in case S.findIndex isNl bs of+        Just !i -> S.findIndex isNl (S.drop (i+1) bs)+        Nothing -> Nothing+{-# INLINE bench_find_index_second #-}++bench_elem_index_second :: ShortByteString -> Maybe Int+bench_elem_index_second bs =+    case S.elemIndex nl bs of+        Just !i -> S.elemIndex nl (S.drop (i+1) bs)+        Nothing -> Nothing+{-# INLINE bench_elem_index_second #-}
+ bench/Short/Word16/BenchAll.hs view
@@ -0,0 +1,135 @@+-- |+-- Copyright   : (c) 2011 Simon Meier+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Simon Meier <iridcode@gmail.com>+-- Stability   : experimental+-- Portability : tested on GHC only+--++{-# LANGUAGE BangPatterns        #-}+{-# LANGUAGE PackageImports      #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE MagicHash           #-}++module Short.Word16.BenchAll (benchmarks) where++import Short.Word16.BenchIndices++import           Data.Monoid+import           Data.String+import           Test.Tasty.Bench+import           Prelude                               hiding (words)++import qualified "bytestring" Data.ByteString.Char8                 as S8+import "shortbytestring" Data.ByteString.Short                 ( ShortByteString )+import qualified "shortbytestring" Data.ByteString.Short.Word16      as S+++import           Foreign++import System.Random+++------------------------------------------------------------------------------+-- Benchmark+------------------------------------------------------------------------------++-- input data (NOINLINE to ensure memoization)+----------------------------------------------++-- | Few-enough repetitions to avoid making GC too expensive.+nRepl :: Int+nRepl = 10000++{-# NOINLINE intData #-}+intData :: [Int]+intData = [1..nRepl]++{-# NOINLINE byteStringData #-}+byteStringData :: ShortByteString+byteStringData = S.pack $ map fromIntegral intData+++-- benchmark wrappers+---------------------+++{-# INLINE benchB' #-}+benchB' :: String -> a -> (a -> ShortByteString) -> Benchmark+benchB' name x b = bench name $ whnf (S.length . b) x+++hashInt :: Int -> Int+hashInt x = iterate step x !! 10+  where+    step a = e+      where b = (a `xor` 61) `xor` (a `shiftR` 16)+            c = b + (b `shiftL` 3)+            d = c `xor` (c `shiftR` 4)+            e = d * 0x27d4eb2d++w :: Int -> Word16+w = fromIntegral++hashWord16 :: Word16 -> Word16+hashWord16 = fromIntegral . hashInt . fromIntegral++partitionStrict :: (Word16 -> Bool) -> Benchmarkable+partitionStrict p = nf (S.partition p) . randomStrict $ mkStdGen 98423098+  where randomStrict = fst . S.unfoldrN 10000 (Just . random)+++-- benchmarks+-------------+++foldInputs :: [ShortByteString]+foldInputs = map (\k -> S.pack $ if (k :: Int) <= 6 then take (2 ^ k) [32..95] else concat (replicate (2 ^ (k - 6)) [32..95])) [0..16]++largeTraversalInput :: ShortByteString+largeTraversalInput = S.concat (replicate 10 byteStringData)++smallTraversalInput :: ShortByteString+smallTraversalInput = S.toShort . S8.unlines $ map S8.pack ["The quick brown fox"]++benchmarks :: [ Benchmark ]+benchmarks =+    [ bgroup "AFP.Data.ByteString.Short.Word16"+      [ bgroup "Small payload"+        [ benchB' "mempty"        ()  (const mempty)+        , benchB' "UTF-8 String (naive)" "hello world\0" fromString+        , benchB' "String (naive)" "hello world!" fromString+        ]+      ]++    , bgroup "partition"+      [+        bgroup "strict"+        [+          bench "mostlyTrueFast"  $ partitionStrict (< (w 225))+        , bench "mostlyFalseFast" $ partitionStrict (< (w 10))+        , bench "balancedFast"    $ partitionStrict (< (w 128))++        , bench "mostlyTrueSlow"  $ partitionStrict (\x -> hashWord16 x < w 225)+        , bench "mostlyFalseSlow" $ partitionStrict (\x -> hashWord16 x < w 10)+        , bench "balancedSlow"    $ partitionStrict (\x -> hashWord16 x < w 128)+        ]+      ]+    , bgroup "folds"+      [ bgroup "foldl'" $ map (\s -> bench (show $ S.length s) $+          nf (S.foldl' (\acc x -> acc + fromIntegral x) (0 :: Int)) s) foldInputs+      , bgroup "foldr'" $ map (\s -> bench (show $ S.length s) $+          nf (S.foldr' (\x acc -> fromIntegral x + acc) (0 :: Int)) s) foldInputs+      , bgroup "filter" $ map (\s -> bench (show $ S.length s) $+          nf (S.filter odd) s) foldInputs+      ]+    , bgroup "findIndex_"+      [ bench "find"           $ nf (S.find (>= 198)) byteStringData+      ]+    , bgroup "traversals"+      [ bench "map (+1) large" $ nf (S.map (+ 1)) largeTraversalInput+      , bench "map (+1) small" $ nf (S.map (+ 1)) smallTraversalInput+      ]+    , benchIndices+    ]
+ bench/Short/Word16/BenchIndices.hs view
@@ -0,0 +1,82 @@+-- |+-- Copyright   : (c) 2020 Peter Duchovni+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Peter Duchovni <caufeminecraft+github@gmail.com>+--+-- Benchmark elemIndex, findIndex, elemIndices, and findIndices++{-# LANGUAGE BangPatterns        #-}+{-# LANGUAGE PackageImports      #-}++module Short.Word16.BenchIndices (benchIndices) where++import           Data.Maybe                            (listToMaybe)+import           Data.Monoid+import "shortbytestring" Data.ByteString.Short                 ( ShortByteString )+import           Test.Tasty.Bench+import           Prelude                               hiding (words)+import           Data.Word                             (Word16)++import qualified "shortbytestring" Data.ByteString.Short.Word16      as S+++------------------------------------------------------------------------------+-- Benchmark+------------------------------------------------------------------------------++-- ASCII \n to ensure no typos+nl :: Word16+nl = 0xa+{-# INLINE nl #-}++-- non-inlined equality test+nilEq :: Word16 -> Word16 -> Bool+{-# NOINLINE nilEq #-}+nilEq = (==)++-- lines of 200 letters from a to e, followed by repeated letter f+absurdlong :: ShortByteString+absurdlong = S.replicate 200 0x61 <> S.singleton nl+          <> S.replicate 200 0x62 <> S.singleton nl+          <> S.replicate 200 0x63 <> S.singleton nl+          <> S.replicate 200 0x64 <> S.singleton nl+          <> S.replicate 200 0x65 <> S.singleton nl+          <> S.replicate 999999 0x66++benchIndices :: Benchmark+benchIndices = bgroup "Short.Word16.BenchIndices"+    [ bgroup "ByteString strict first index" $+        [ bench "FindIndices" $ nf (listToMaybe . S.findIndices (== nl)) absurdlong+        , bench "ElemIndices" $ nf (listToMaybe . S.elemIndices     nl)  absurdlong+        , bench "FindIndex"   $ nf (S.findIndex (== nl)) absurdlong+        , bench "ElemIndex"   $ nf (S.elemIndex     nl)  absurdlong+        ]+    , bgroup "ByteString strict second index" $+        [ bench "FindIndices" $ nf (listToMaybe . tail . S.findIndices (== nl)) absurdlong+        , bench "ElemIndices" $ nf (listToMaybe . tail . S.elemIndices     nl)  absurdlong+        , bench "FindIndex"   $ nf bench_find_index_second absurdlong+        , bench "ElemIndex"   $ nf bench_elem_index_second absurdlong+        ]+    , bgroup "ByteString index equality inlining" $+        [ bench "FindIndices/inlined"     $ nf (S.findIndices    (== nl)) absurdlong+        , bench "FindIndices/non-inlined" $ nf (S.findIndices (nilEq nl)) absurdlong+        , bench "FindIndex/inlined"       $ nf (S.findIndex      (== nl)) absurdlong+        , bench "FindIndex/non-inlined"   $ nf (S.findIndex   (nilEq nl)) absurdlong+        ]+    ]++bench_find_index_second :: ShortByteString -> Maybe Int+bench_find_index_second bs =+  let isNl = (== nl)+   in case S.findIndex isNl bs of+        Just !i -> S.findIndex isNl (S.drop (i+1) bs)+        Nothing -> Nothing+{-# INLINE bench_find_index_second #-}++bench_elem_index_second :: ShortByteString -> Maybe Int+bench_elem_index_second bs =+    case S.elemIndex nl bs of+        Just !i -> S.elemIndex nl (S.drop (i+1) bs)+        Nothing -> Nothing+{-# INLINE bench_elem_index_second #-}
+ lib/Data/ByteString/Short.hs view
@@ -0,0 +1,1006 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE UnliftedFFITypes #-}+{-# LANGUAGE PackageImports #-}++module Data.ByteString.Short+  (+  -- * Types+  ShortByteString,++  -- * Introducing and eliminating 'ShortByteString's+  empty,+  singleton,+  pack,+  unpack,+  fromShort,+  toShort,++  -- * Basic interface+  snoc,+  cons,+  append,+  last,+  tail,+  head,+  init,+  null,+  length,++  -- * Transforming ShortByteStrings+  map,+  reverse,+  intercalate,++  -- * Reducing 'ShortByteString's (folds)+  foldl,+  foldl',+  foldl1,+  foldl1',++  foldr,+  foldr',+  foldr1,+  foldr1',++  -- ** Special folds+  all,+  any,+  concat,++  -- ** Generating and unfolding ByteStrings+  replicate,+  unfoldr,+  unfoldrN,++  -- * Substrings++  -- ** Breaking strings+  take,+  takeEnd,+  takeWhileEnd,+  takeWhile,+  drop,+  dropEnd,+  dropWhile,+  dropWhileEnd,+  breakEnd,+  break,+  span,+  spanEnd,+  splitAt,+  split,+  splitWith,+  stripSuffix,+  stripPrefix,++  -- * Predicates+  isInfixOf,+  isPrefixOf,+  isSuffixOf,++  -- ** Search for arbitrary substrings+  breakSubstring,++  -- * Searching ShortByteStrings++  -- ** Searching by equality+  elem,++  -- ** Searching with a predicate+  find,+  filter,+  partition,++  -- * Indexing ShortByteStrings+  index,+  indexMaybe,+  (!?),+  elemIndex,+  elemIndices,+  count,+  findIndex,+  findIndices,++  -- * Low level conversions+  -- ** Packing 'CString's and pointers+  packCString,+  packCStringLen,++  -- ** Using ShortByteStrings as 'CString's+  useAsCString,+  useAsCStringLen,+  )+where++import Prelude hiding+    ( all+    , any+    , break+    , concat+    , drop+    , dropWhile+    , elem+    , filter+    , foldl+    , foldl1+    , foldr+    , foldr1+    , head+    , init+    , last+    , length+    , map+    , reverse+    , null+    , replicate+    , span+    , splitAt+    , tail+    , take+    , takeWhile+    )++import Data.ByteString.Short.Internal+import "bytestring" Data.ByteString.Short+    ( ShortByteString+    , empty+    , fromShort+    , index+#if MIN_VERSION_bytestring(0,11,0)+    , indexMaybe+    , (!?)+#endif+    , length+    , null+    , pack+    , toShort+    , unpack+    )+import "bytestring" Data.ByteString.Short.Internal+    ( createFromPtr )+import Data.Word8+++import qualified "bytestring" Data.ByteString.Short as BS+import qualified "bytestring" Data.ByteString.Short.Internal as BS+++import Data.ByteString.Internal+    ( memcmp )+import Foreign.Marshal.Alloc+  ( mallocBytes, free )+import GHC.List (errorEmptyList)+import Data.Bifunctor+    ( first, bimap )+import qualified Data.List as List+import qualified Data.Foldable as Foldable+import Foreign.Ptr++import GHC.Exts+import GHC.IO+import GHC.ST+    ( ST (ST) )+import GHC.Word+import Data.Bits+    ( FiniteBits (finiteBitSize), shiftL, (.&.), (.|.) )+++-- $setup+-- >>> :set -XPackageImports+-- >>> import "shortbytestring" Data.ByteString.Short++-- -----------------------------------------------------------------------------+-- Introducing and eliminating 'ShortByteString's++-- | /O(1)/ Convert a 'Word8' into a 'ShortByteString'+singleton :: Word8 -> ShortByteString+singleton = \w -> create 1 (\mba -> writeWord8Array mba 0 w)+{-# INLINE [1] singleton #-}+++-- ---------------------------------------------------------------------+-- Basic interface++infixr 5 `cons` --same as list (:)+infixl 5 `snoc`++-- | /O(n)/ Append a byte to the end of a 'ShortByteString'+-- +-- Note: copies the entire byte array+snoc :: ShortByteString -> Word8 -> ShortByteString+snoc = \sbs c -> let l = BS.length sbs+                     nl = l + 1+  in create nl $ \mba -> do+      copyByteArray (asBA sbs) 0 mba 0 nl+      writeWord8Array mba l c+{-# INLINE snoc #-}++-- | /O(n)/ 'cons' is analogous to (:) for lists.+--+-- Note: copies the entire byte array+cons :: Word8 -> ShortByteString -> ShortByteString+cons c = \sbs -> let l = BS.length sbs + 1+  in create l $ \mba -> do+      writeWord8Array mba 0 c+      copyByteArray (asBA sbs) 0 mba 1 l+{-# INLINE cons #-}++-- | /O(n)/ Append two ShortByteStrings+append :: ShortByteString -> ShortByteString -> ShortByteString+append = mappend+{-# INLINE append #-}++-- | /O(1)/ Extract the last element of a ShortByteString, which must be finite and non-empty.+-- An exception will be thrown in the case of an empty ShortByteString.+last :: ShortByteString -> Word8+last = \sbs -> case BS.null sbs of+  True -> error "empty ShortByteString"+  False -> indexWord8Array (asBA sbs) (BS.length sbs - 1)+{-# INLINE last #-}++-- | /O(n)/ Extract the elements after the head of a ShortByteString, which must be non-empty.+-- An exception will be thrown in the case of an empty ShortByteString.+--+-- Note: copies the entire byte array+tail :: ShortByteString -> ShortByteString+tail = \sbs -> +  let l = BS.length sbs+      nl = l - 1+  in case BS.null sbs of+      True -> error "empty ShortByteString"+      False -> create nl $ \mba -> copyByteArray (asBA sbs) 1 mba 0 nl+{-# INLINE tail #-}++-- | /O(1)/ Extract the first element of a ShortByteString, which must be non-empty.+-- An exception will be thrown in the case of an empty ShortByteString.+head :: ShortByteString -> Word8+head = \sbs -> case BS.null sbs of+  True -> error "empty ShortByteString"+  False -> indexWord8Array (asBA sbs) 0+{-# INLINE head #-}++-- | /O(n)/ Return all the elements of a 'ShortByteString' except the last one.+-- An exception will be thrown in the case of an empty ShortByteString.+--+-- Note: copies the entire byte array+init :: ShortByteString -> ShortByteString+init = \sbs ->+  let l = BS.length sbs+      nl = l - 1+  in case BS.null sbs of+      True -> error "empty ShortByteString"+      False -> create nl $ \mba -> copyByteArray (asBA sbs) 0 mba 0 nl+{-# INLINE init #-}+++-- ---------------------------------------------------------------------+-- Transformations++-- | /O(n)/ 'map' @f xs@ is the ShortByteString obtained by applying @f@ to each+-- element of @xs@.+map :: (Word8 -> Word8) -> ShortByteString -> ShortByteString+map f = \sbs ->+    let l = length sbs+        ba = asBA sbs+    in create l (\mba -> go ba mba 0 l)+  where+    go :: BA -> MBA s -> Int -> Int -> ST s ()+    go !ba !mba !i !l+      | i >= l = return ()+      | otherwise = do+          let w = indexWord8Array ba i+          writeWord8Array mba i (f w)+          go ba mba (i+1) l+++-- | /O(n)/ 'reverse' @xs@ efficiently returns the elements of @xs@ in reverse order.+reverse :: ShortByteString -> ShortByteString+reverse = \sbs ->+    let l = length sbs+        ba = asBA sbs+    in create l (\mba -> go ba mba 0 l)+  where+    go :: BA -> MBA s -> Int -> Int -> ST s ()+    go !ba !mba !i !l+      | i >= l = return ()+      | otherwise = do+          let w = indexWord8Array ba i+          writeWord8Array mba (l - 1 - i) w+          go ba mba (i+1) l+++-- | /O(n)/ The 'intercalate' function takes a 'ShortByteString' and a list of+-- 'ShortByteString's and concatenates the list after interspersing the first+-- argument between each element of the list.+intercalate :: ShortByteString -> [ShortByteString] -> ShortByteString+intercalate s = concat . List.intersperse s+{-# INLINE [1] intercalate #-}+++-- ---------------------------------------------------------------------+-- Reducing 'ByteString's++-- | 'foldl', applied to a binary operator, a starting value (typically+-- the left-identity of the operator), and a ShortByteString, reduces the+-- ShortByteString using the binary operator, from left to right.+--+foldl :: (a -> Word8 -> a) -> a -> ShortByteString -> a+foldl f v = List.foldl f v . unpack+{-# INLINE foldl #-}++-- | 'foldl'' is like 'foldl', but strict in the accumulator.+--+foldl' :: (a -> Word8 -> a) -> a -> ShortByteString -> a+foldl' f v = List.foldl' f v . unpack+{-# INLINE foldl' #-}++-- | 'foldr', applied to a binary operator, a starting value+-- (typically the right-identity of the operator), and a ShortByteString,+-- reduces the ShortByteString using the binary operator, from right to left.+foldr :: (Word8 -> a -> a) -> a -> ShortByteString -> a+foldr f v = List.foldr f v . unpack+{-# INLINE foldr #-}++-- | 'foldr'' is like 'foldr', but strict in the accumulator.+foldr' :: (Word8 -> a -> a) -> a -> ShortByteString -> a+foldr' k v = Foldable.foldr' k v . unpack+{-# INLINE foldr' #-}++-- | 'foldl1' is a variant of 'foldl' that has no starting value+-- argument, and thus must be applied to non-empty 'ShortByteString's.+-- An exception will be thrown in the case of an empty ShortByteString.+foldl1 :: (Word8 -> Word8 -> Word8) -> ShortByteString -> Word8+foldl1 k = List.foldl1 k . unpack+{-# INLINE foldl1 #-}++-- | 'foldl1'' is like 'foldl1', but strict in the accumulator.+-- An exception will be thrown in the case of an empty ShortByteString.+foldl1' :: (Word8 -> Word8 -> Word8) -> ShortByteString -> Word8+foldl1' k = List.foldl1' k . unpack++-- | 'foldr1' is a variant of 'foldr' that has no starting value argument,+-- and thus must be applied to non-empty 'ShortByteString's+-- An exception will be thrown in the case of an empty ShortByteString.+foldr1 :: (Word8 -> Word8 -> Word8) -> ShortByteString -> Word8+foldr1 k = List.foldr1 k . unpack+{-# INLINE foldr1 #-}++-- | 'foldr1'' is a variant of 'foldr1', but is strict in the+-- accumulator.+foldr1' :: (Word8 -> Word8 -> Word8) -> ShortByteString -> Word8+foldr1' k = \sbs -> if null sbs then errorEmptyList "foldr1'" else foldr' k (last sbs) (init sbs)+{-# INLINE foldr1' #-}++++-- ---------------------------------------------------------------------+-- Special folds++-- | /O(n)/ Applied to a predicate and a 'ShortByteString', 'all' determines+-- if all elements of the 'ShortByteString' satisfy the predicate.+all :: (Word8 -> Bool) -> ShortByteString -> Bool+all k = \sbs ->+  let l = BS.length sbs+      ba = asBA sbs+      w = indexWord8Array ba+      go !n | n >= l    = True+            | otherwise = k (w n) && go (n + 1)+  in go 0+++-- | /O(n)/ Applied to a predicate and a ByteString, 'any' determines if+-- any element of the 'ByteString' satisfies the predicate.+any :: (Word8 -> Bool) -> ShortByteString -> Bool+any k = \sbs ->+  let l = BS.length sbs+      ba = asBA sbs+      w = indexWord8Array ba+      go !n | n >= l    = False+            | otherwise = k (w n) || go (n + 1)+  in go 0+{-# INLINE [1] any #-}+++-- | /O(n)/ Concatenate a list of ShortByteStrings.+concat :: [ShortByteString] -> ShortByteString+concat = mconcat+++-- ---------------------------------------------------------------------+-- Substrings++-- | /O(n)/ 'take' @n@, applied to a ShortByteString @xs@, returns the prefix+-- of @xs@ of length @n@, or @xs@ itself if @n > 'length' xs@.+--+-- Note: copies the entire byte array+take :: Int -> ShortByteString -> ShortByteString+take = \n -> \sbs ->+  let len = min (BS.length sbs) (max 0 n)+  in create len $ \mba -> copyByteArray (asBA sbs) 0 mba 0 len+{-# INLINE take #-}++-- | Similar to 'P.takeWhile',+-- returns the longest (possibly empty) prefix of elements+-- satisfying the predicate.+takeWhile :: (Word8 -> Bool) -> ShortByteString -> ShortByteString+takeWhile f ps = take (findIndexOrLength (not . f) ps) ps+{-# INLINE [1] takeWhile #-}++-- | /O(1)/ @'takeEnd' n xs@ is equivalent to @'drop' ('length' xs - n) xs@.+-- Takes @n@ elements from end of bytestring.+--+-- >>> takeEnd 3 "abcdefg"+-- "efg"+-- >>> takeEnd 0 "abcdefg"+-- ""+-- >>> takeEnd 4 "abc"+-- "abc"+takeEnd :: Int -> ShortByteString -> ShortByteString+takeEnd n sbs+    | n >= length sbs  = sbs+    | n <= 0           = empty+    | otherwise        = drop (length sbs - n) sbs+{-# INLINE takeEnd #-}++-- | Returns the longest (possibly empty) suffix of elements+-- satisfying the predicate.+--+-- @'takeWhileEnd' p@ is equivalent to @'reverse' . 'takeWhile' p . 'reverse'@.+takeWhileEnd :: (Word8 -> Bool) -> ShortByteString -> ShortByteString+takeWhileEnd f ps = drop (findFromEndUntil (not . f) ps) ps+{-# INLINE takeWhileEnd #-}++-- | /O(n)/ 'drop' @n@ @xs@ returns the suffix of @xs@ after the first n elements, or @[]@ if @n > 'length' xs@.+--+-- Note: copies the entire byte array+drop  :: Int -> ShortByteString -> ShortByteString+drop = \n -> \sbs ->+  let len = BS.length sbs+      newLen = max 0 (len - max 0 n)+  in if | n <= 0    -> sbs+        | n >= len  -> empty+        | otherwise -> create newLen $ \mba -> copyByteArray (asBA sbs) n mba 0 newLen+{-# INLINE drop #-}++-- | /O(1)/ @'dropEnd' n xs@ is equivalent to @'take' ('length' xs - n) xs@.+-- Drops @n@ elements from end of bytestring.+--+-- >>> dropEnd 3 "abcdefg"+-- "abcd"+-- >>> dropEnd 0 "abcdefg"+-- "abcdefg"+-- >>> dropEnd 4 "abc"+-- ""+dropEnd :: Int -> ShortByteString -> ShortByteString+dropEnd n sbs+    | n <= 0           = sbs+    | n >= length sbs  = empty+    | otherwise        = take (length sbs - n) sbs++{-# INLINE dropEnd #-}+-- | Similar to 'P.dropWhile',+-- drops the longest (possibly empty) prefix of elements+-- satisfying the predicate and returns the remainder.+--+-- Note: copies the entire byte array+dropWhile :: (Word8 -> Bool) -> ShortByteString -> ShortByteString+dropWhile f = \ps -> drop (findIndexOrLength (not . f) ps) ps++-- | Similar to 'P.dropWhileEnd',+-- drops the longest (possibly empty) suffix of elements+-- satisfying the predicate and returns the remainder.+--+-- @'dropWhileEnd' p@ is equivalent to @'reverse' . 'dropWhile' p . 'reverse'@.+--+-- @since 0.10.12.0+dropWhileEnd :: (Word8 -> Bool) -> ShortByteString -> ShortByteString+dropWhileEnd f = \ps -> take (findFromEndUntil (not . f) ps) ps+{-# INLINE dropWhileEnd #-}++-- | Returns the longest (possibly empty) suffix of elements which __do not__+-- satisfy the predicate and the remainder of the string.+--+-- 'breakEnd' @p@ is equivalent to @'spanEnd' (not . p)@ and to @('takeWhileEnd' (not . p) &&& 'dropWhileEnd' (not . p))@.+breakEnd :: (Word8 -> Bool) -> ShortByteString -> (ShortByteString, ShortByteString)+breakEnd p = \sbs -> splitAt (findFromEndUntil p sbs) sbs+{-# INLINE breakEnd #-}++-- | Similar to 'P.break',+-- returns the longest (possibly empty) prefix of elements which __do not__+-- satisfy the predicate and the remainder of the string.+--+-- 'break' @p@ is equivalent to @'span' (not . p)@ and to @('takeWhile' (not . p) &&& 'dropWhile' (not . p))@.+break :: (Word8 -> Bool) -> ShortByteString -> (ShortByteString, ShortByteString)+break = \p -> \ps -> case findIndexOrLength p ps of n -> (take n ps, drop n ps)+{-# INLINE [1] break #-}++-- | Similar to 'P.span',+-- returns the longest (possibly empty) prefix of elements+-- satisfying the predicate and the remainder of the string.+--+-- 'span' @p@ is equivalent to @'break' (not . p)@ and to @('takeWhile' p &&& 'dropWhile' p)@.+--+span :: (Word8 -> Bool) -> ShortByteString -> (ShortByteString, ShortByteString)+span p = break (not . p)++-- | Returns the longest (possibly empty) suffix of elements+-- satisfying the predicate and the remainder of the string.+--+-- 'spanEnd' @p@ is equivalent to @'breakEnd' (not . p)@ and to @('takeWhileEnd' p &&& 'dropWhileEnd' p)@.+--+-- We have+--+-- > spanEnd (not . isSpace) "x y z" == ("x y ", "z")+--+-- and+--+-- > spanEnd (not . isSpace) ps+-- >    ==+-- > let (x, y) = span (not . isSpace) (reverse ps) in (reverse y, reverse x)+--+spanEnd :: (Word8 -> Bool) -> ShortByteString -> (ShortByteString, ShortByteString)+spanEnd p = \ps -> splitAt (findFromEndUntil (not.p) ps) ps++-- | /O(n)/ 'splitAt' @n xs@ is equivalent to @('take' n xs, 'drop' n xs)@.+--+-- Note: copies the substrings+splitAt :: Int -> ShortByteString -> (ShortByteString, ShortByteString)+splitAt n = \xs -> if+  | n <= 0 -> (mempty, xs)+  | n >= BS.length xs -> (xs, mempty)+  | otherwise -> (take n xs, drop n xs)++-- | /O(n)/ Break a 'ShortByteString' into pieces separated by the byte+-- argument, consuming the delimiter. I.e.+--+-- > split 10  "a\nb\nd\ne" == ["a","b","d","e"]   -- fromEnum '\n' == 10+-- > split 97  "aXaXaXa"    == ["","X","X","X",""] -- fromEnum 'a' == 97+-- > split 120 "x"          == ["",""]             -- fromEnum 'x' == 120+-- > split undefined ""     == []                  -- and not [""]+--+-- and+--+-- > intercalate [c] . split c == id+-- > split == splitWith . (==)+--+-- Note: copies the substrings+split :: Word8 -> ShortByteString -> [ShortByteString]+split w = splitWith (== w)+++-- | /O(n)/ Splits a 'ShortByteString' into components delimited by+-- separators, where the predicate returns True for a separator element.+-- The resulting components do not contain the separators.  Two adjacent+-- separators result in an empty component in the output.  eg.+--+-- > splitWith (==97) "aabbaca" == ["","","bb","c",""] -- fromEnum 'a' == 97+-- > splitWith undefined ""     == []                  -- and not [""]+--+splitWith :: (Word8 -> Bool) -> ShortByteString -> [ShortByteString]+splitWith p = \sbs -> if+  | BS.null sbs -> []+  | otherwise -> go sbs+  where+    go sbs'+      | BS.null sbs' = [mempty]+      | otherwise =+          case break p sbs' of+            (a, b)+              | BS.null b -> [a]+              | otherwise -> a : go (tail b)+++-- | /O(n)/ The 'stripSuffix' function takes two ShortByteStrings and returns 'Just'+-- the remainder of the second iff the first is its suffix, and otherwise+-- 'Nothing'.+stripSuffix :: ShortByteString -> ShortByteString -> Maybe ShortByteString+stripSuffix sbs1 sbs2 = do+  let l1 = BS.length sbs1+      l2 = BS.length sbs2+  if | l1 == 0   -> Just sbs2+     | l2 < l1   -> Nothing+     | otherwise -> unsafeDupablePerformIO $ do+         p1 <- mallocBytes l1+         p2 <- mallocBytes l2+         BS.copyToPtr sbs1 0 p1 l1+         BS.copyToPtr sbs2 0 p2 l2+         i <- memcmp p1 (p2 `plusPtr` (l2 - l1)) (fromIntegral l1)+         if i == 0+          then do+            sbs <- createFromPtr p2 (fromIntegral (l2 - l1))+            free p1+            free p2+            return $! Just sbs+          else do+            free p1+            free p2+            return Nothing++-- | /O(n)/ The 'stripPrefix' function takes two ShortByteStrings and returns 'Just'+-- the remainder of the second iff the first is its prefix, and otherwise+-- 'Nothing'.+stripPrefix :: ShortByteString -> ShortByteString -> Maybe ShortByteString+stripPrefix sbs1 sbs2 = do+  let l1 = BS.length sbs1+      l2 = BS.length sbs2+  if | l1 == 0   -> Just sbs2+     | l2 < l1   -> Nothing+     | otherwise -> unsafeDupablePerformIO $ do+         p1 <- mallocBytes l1+         p2 <- mallocBytes l2+         BS.copyToPtr sbs1 0 p1 l1+         BS.copyToPtr sbs2 0 p2 l2+         i <- memcmp p1 p2 (fromIntegral l1)+         if i == 0+          then do+            sbs <- createFromPtr (p2 `plusPtr` l1) (l2 - l1)+            free p1+            free p2+            return $! Just sbs+          else do+            free p1+            free p2+            return Nothing+++-- ---------------------------------------------------------------------+-- Unfolds and replicates+++-- | /O(n)/ 'replicate' @n x@ is a ByteString of length @n@ with @x@+-- the value of every element. The following holds:+--+-- > replicate w c = unfoldr w (\u -> Just (u,u)) c+--+-- This implementation uses @memset(3)@+replicate :: Int -> Word8 -> ShortByteString+replicate w c+    | w <= 0    = empty+    | otherwise = create w (\mba -> go mba 0)+  where+    go mba ix+      | ix < 0 || ix >= w = pure ()+      | otherwise = writeWord8Array mba ix c >> go mba (ix + 1)+{-# INLINE replicate #-}++-- | /O(n)/, where /n/ is the length of the result.  The 'unfoldr'+-- function is analogous to the List \'unfoldr\'.  'unfoldr' builds a+-- ShortByteString from a seed value.  The function takes the element and+-- returns 'Nothing' if it is done producing the ShortByteString or returns+-- 'Just' @(a,b)@, in which case, @a@ is the next byte in the string,+-- and @b@ is the seed value for further production.+--+-- This function is not efficient/safe. It will build a list of @[Word8]@+-- and run the generator until it returns `Nothing`, otherwise recurse infinitely,+-- then finally create a 'ShortByteString'.+--+-- Examples:+--+-- >    unfoldr (\x -> if x <= 5 then Just (x, x + 1) else Nothing) 0+-- > == pack [0, 1, 2, 3, 4, 5]+--+unfoldr :: (a -> Maybe (Word8, a)) -> a -> ShortByteString+unfoldr f x0 = packBytesRev $ go x0 mempty+ where+   go x words' = case f x of+                    Nothing -> words'+                    Just (w, x') -> go x' (w:words')+{-# INLINE unfoldr #-}++-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a ShortByteString from a seed+-- value.  However, the length of the result is limited by the first+-- argument to 'unfoldrN'.  This function is more efficient than 'unfoldr'+-- when the maximum length of the result is known.+--+-- This function is not efficient. It will build a full list of @[Word8]@+-- before creating a 'ShortByteString'.+--+-- The following equation relates 'unfoldrN' and 'unfoldr':+--+-- > fst (unfoldrN n f s) == take n (unfoldr f s)+--+unfoldrN :: Int -> (a -> Maybe (Word8, a)) -> a -> (ShortByteString, Maybe a)+unfoldrN i f x0 = first packBytesRev $ go (i - 1) x0 mempty+ where+   go i' x words'+    | i' < 0     = (words', Just x)+    | otherwise = case f x of+                    Nothing -> (words', Nothing)+                    Just (w, x') -> go (i' - 1) x' (w:words')+{-# INLINE unfoldrN #-}+++-- --------------------------------------------------------------------+-- Predicates++-- | Check whether one string is a substring of another.+isInfixOf :: ShortByteString -> ShortByteString -> Bool+isInfixOf p s = BS.null p || not (BS.null $ snd $ breakSubstring p s)++-- |/O(n)/ The 'isPrefixOf' function takes two ShortByteStrings and returns 'True'+isPrefixOf :: ShortByteString -> ShortByteString -> Bool+isPrefixOf sbs1 sbs2 = do+  let l1 = BS.length sbs1+      l2 = BS.length sbs2+  if | l1 == 0   -> True+     | l2 < l1   -> False+     | otherwise -> unsafeDupablePerformIO $ do+         p1 <- mallocBytes l1+         p2 <- mallocBytes l2+         BS.copyToPtr sbs1 0 p1 l1+         BS.copyToPtr sbs2 0 p2 l2+         i <- memcmp p1 p2 (fromIntegral l1)+         free p1+         free p2+         return $! i == 0++-- | /O(n)/ The 'isSuffixOf' function takes two ShortByteStrings and returns 'True'+-- iff the first is a suffix of the second.+--+-- The following holds:+--+-- > isSuffixOf x y == reverse x `isPrefixOf` reverse y+isSuffixOf :: ShortByteString -> ShortByteString -> Bool+isSuffixOf sbs1 sbs2 = do+  let l1 = BS.length sbs1+      l2 = BS.length sbs2+  if | l1 == 0   -> True+     | l2 < l1   -> False+     | otherwise -> unsafeDupablePerformIO $ do+         p1 <- mallocBytes l1+         p2 <- mallocBytes l2+         BS.copyToPtr sbs1 0 p1 l1+         BS.copyToPtr sbs2 0 p2 l2+         i <- memcmp p1 (p2 `plusPtr` (l2 - l1)) (fromIntegral l1)+         free p1+         free p2+         return $! i == 0++-- | Break a string on a substring, returning a pair of the part of the+-- string prior to the match, and the rest of the string.+--+-- The following relationships hold:+--+-- > break (== c) l == breakSubstring (singleton c) l+--+-- For example, to tokenise a string, dropping delimiters:+--+-- > tokenise x y = h : if null t then [] else tokenise x (drop (length x) t)+-- >     where (h,t) = breakSubstring x y+--+-- To skip to the first occurence of a string:+--+-- > snd (breakSubstring x y)+--+-- To take the parts of a string before a delimiter:+--+-- > fst (breakSubstring x y)+--+-- Note that calling `breakSubstring x` does some preprocessing work, so+-- you should avoid unnecessarily duplicating breakSubstring calls with the same+-- pattern.+--+breakSubstring :: ShortByteString -- ^ String to search for+               -> ShortByteString -- ^ String to search in+               -> (ShortByteString, ShortByteString) -- ^ Head and tail of string broken at substring+breakSubstring pat =+  case lp of+    0 -> (mempty,)+    1 -> breakByte (head pat)+    _ -> if lp * 8 <= finiteBitSize (0 :: Word)+             then shift+             else karpRabin+  where+    lp = BS.length pat+    karpRabin :: ShortByteString -> (ShortByteString, ShortByteString)+    karpRabin src+        | BS.length src < lp = (src,mempty)+        | otherwise = search (rollingHash $ take lp src) lp+      where+        k           = 2891336453 :: Word32+        rollingHash = foldl' (\h b -> h * k + fromIntegral b) 0+        hp          = rollingHash pat+        m           = k ^ lp+        get = fromIntegral . BS.unsafeIndex src+        search !hs !i+            | hp == hs && pat == take lp b = u+            | BS.length src <= i           = (src, mempty) -- not found+            | otherwise                    = search hs' (i + 1)+          where+            u@(_, b) = splitAt (i - lp) src+            hs' = hs * k ++                  get i -+                  m * get (i - lp)+    {-# INLINE karpRabin #-}++    shift :: ShortByteString -> (ShortByteString, ShortByteString)+    shift !src+        | BS.length src < lp = (src, mempty)+        | otherwise       = search (intoWord $ take lp src) lp+      where+        intoWord :: ShortByteString -> Word+        intoWord = foldl' (\w b -> (w `shiftL` 8) .|. fromIntegral b) 0+        wp   = intoWord pat+        mask' = (1 `shiftL` (8 * lp)) - 1+        search !w !i+            | w == wp            = splitAt (i - lp) src+            | BS.length src <= i = (src, mempty)+            | otherwise       = search w' (i + 1)+          where+            b  = fromIntegral (BS.unsafeIndex src i)+            w' = mask' .&. ((w `shiftL` 8) .|. b)+    {-# INLINE shift #-}+++-- --------------------------------------------------------------------+-- Searching ShortByteString++-- | /O(n)/ 'elem' is the 'ShortByteString' membership predicate.+elem :: Word8 -> ShortByteString -> Bool+elem c = \ps -> case elemIndex c ps of Nothing -> False ; _ -> True++-- | /O(n)/ 'filter', applied to a predicate and a ByteString,+-- returns a ByteString containing those characters that satisfy the+-- predicate.+filter :: (Word8 -> Bool) -> ShortByteString -> ShortByteString+filter k = \sbs -> if+    | null sbs  -> sbs+    | otherwise -> pack . List.filter k . unpack $ sbs+{-# INLINE filter #-}++-- | /O(n)/ The 'find' function takes a predicate and a ByteString,+-- and returns the first element in matching the predicate, or 'Nothing'+-- if there is no such element.+--+-- > find f p = case findIndex f p of Just n -> Just (p ! n) ; _ -> Nothing+--+find :: (Word8 -> Bool) -> ShortByteString -> Maybe Word8+find f = \p -> case findIndex f p of+                    Just n -> Just (p `index` n)+                    _      -> Nothing+{-# INLINE find #-}++-- | /O(n)/ The 'partition' function takes a predicate a ByteString and returns+-- the pair of ByteStrings with elements which do and do not satisfy the+-- predicate, respectively; i.e.,+--+-- > partition p bs == (filter p xs, filter (not . p) xs)+--+partition :: (Word8 -> Bool) -> ShortByteString -> (ShortByteString, ShortByteString)+partition f = \s -> if+    | null s    -> (s, s)+    | otherwise -> bimap pack pack . List.partition f . unpack $ s+++#if !MIN_VERSION_bytestring(0,11,0)+-- | /O(1)/ 'ShortByteString' index, starting from 0, that returns 'Just' if:+--+-- > 0 <= n < length bs+--+-- @since 0.11.0.0+indexMaybe :: ShortByteString -> Int -> Maybe Word8+indexMaybe sbs i+  | i >= 0 && i < length sbs = Just $! indexWord8Array (asBA sbs) i+  | otherwise                = Nothing+{-# INLINE indexMaybe #-}++-- | /O(1)/ 'ShortByteString' index, starting from 0, that returns 'Just' if:+--+-- > 0 <= n < length bs+--+-- @since 0.11.0.0+(!?) :: ShortByteString -> Int -> Maybe Word8+(!?) = indexMaybe+{-# INLINE (!?) #-}+#endif+++-- --------------------------------------------------------------------+-- Indexing ShortByteString++-- | /O(n)/ The 'elemIndex' function returns the index of the first+-- element in the given 'ShortByteString' which is equal to the query+-- element, or 'Nothing' if there is no such element.+elemIndex :: Word8 -> ShortByteString -> Maybe Int+elemIndex k = findIndex (==k)+{-# INLINE elemIndex #-}++-- | /O(n)/ The 'elemIndices' function extends 'elemIndex', by returning+-- the indices of all elements equal to the query element, in ascending order.+elemIndices :: Word8 -> ShortByteString -> [Int]+elemIndices k = findIndices (==k)++-- | count returns the number of times its argument appears in the ShortByteString+count :: Word8 -> ShortByteString -> Int+count w = List.length . elemIndices w++-- | /O(n)/ The 'findIndex' function takes a predicate and a 'ShortByteString' and+-- returns the index of the first element in the ByteString+-- satisfying the predicate.+findIndex :: (Word8 -> Bool) -> ShortByteString -> Maybe Int+findIndex k = \sbs ->+  let l = BS.length sbs+      ba = asBA sbs+      w = indexWord8Array ba+      go !n | n >= l    = Nothing+            | k (w n)   = Just n+            | otherwise = go (n + 1)+  in go 0+{-# INLINE findIndex #-}+++-- | /O(n)/ The 'findIndices' function extends 'findIndex', by returning the+-- indices of all elements satisfying the predicate, in ascending order.+findIndices :: (Word8 -> Bool) -> ShortByteString -> [Int]+findIndices k = \sbs ->+  let l = BS.length sbs+      ba = asBA sbs+      w = indexWord8Array ba+      go !n | n >= l    = []+            | k (w n)   = n : go (n + 1)+            | otherwise = go (n + 1)+  in go 0+{-# INLINE [1] findIndices #-}+++-- --------------------------------------------------------------------+-- Internal++-- Find from the end of the string using predicate+findFromEndUntil :: (Word8 -> Bool) -> ShortByteString -> Int+findFromEndUntil k sbs = go (BS.length sbs - 1)+  where+    ba = asBA sbs+    w = indexWord8Array ba+    go !n | n < 0     = 0+          | k (w n)   = n + 1+          | otherwise = go (n - 1)+{-# INLINE findFromEndUntil #-}++findIndexOrLength :: (Word8 -> Bool) -> ShortByteString -> Int+findIndexOrLength k sbs = go 0+  where+    l = BS.length sbs+    ba = asBA sbs+    w = indexWord8Array ba+    go !n | n >= l    = l+          | k (w n)   = n+          | otherwise = go (n + 1)+{-# INLINE findIndexOrLength #-}+++packBytesRev :: [Word8] -> ShortByteString+packBytesRev cs = packLenBytesRev (List.length cs) cs++packLenBytesRev :: Int -> [Word8] -> ShortByteString+packLenBytesRev len ws0 =+    create len (\mba -> go mba len ws0)+  where+    go :: MBA s -> Int -> [Word8] -> ST s ()+    go !_   !_ []     = return ()+    go !mba !i (w:ws) = do+      writeWord8Array mba (i - 1) w+      go mba (i - 1) ws+++breakByte :: Word8 -> ShortByteString -> (ShortByteString, ShortByteString)+breakByte c p = case elemIndex c p of+    Nothing -> (p, mempty)+    Just n  -> (take n p, drop n p)+{-# INLINE breakByte #-}++indexWord8Array :: BA -> Int -> Word8+indexWord8Array (BA# ba#) (I# i#) = W8# (indexWord8Array# ba# i#)++writeWord8Array :: MBA s -> Int -> Word8 -> ST s ()+writeWord8Array (MBA# mba#) (I# i#) (W8# w#) =+  ST $ \s -> case writeWord8Array# mba# i# w# s of+               s' -> (# s', () #)+
+ lib/Data/ByteString/Short/Decode.hs view
@@ -0,0 +1,149 @@+{-# LANGUAGE RankNTypes #-}++module Data.ByteString.Short.Decode (decodeUtf16LE, decodeUtf16LEWith, decodeUtf16LE', decodeUtf16LE'', decodeUtf8, decodeUtf8With, decodeUtf8') where++import Data.ByteString+    ( ByteString )+import Data.ByteString.Short+    ( ShortByteString )+import Data.Text+    ( Text )+import Data.Text.Encoding.Error+    ( OnDecodeError, UnicodeException, strictDecode )+import Data.Text.Internal.Fusion.Types+    ( Step (..), Stream (..) )+import Data.Text.Internal.Fusion.Size+    ( maxSize )+import Data.Text.Internal.Unsafe.Char+    ( unsafeChr, unsafeChr8 )+import Data.Text.Internal.Unsafe.Shift+    ( shiftL, shiftR )+import Data.Word+    ( Word16, Word8 )++import Control.Exception+    ( evaluate, try )+import qualified Data.ByteString.Short as BS+    ( index, length )+import qualified Data.Text.Encoding as E+import qualified Data.Text.Internal.Encoding.Utf16 as U16+import qualified Data.Text.Internal.Encoding.Utf8 as U8+import GHC.IO+    ( unsafeDupablePerformIO )+++-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using UTF-8+-- encoding.+streamUtf8 :: OnDecodeError -> ShortByteString -> Stream Char+streamUtf8 onErr bs = Stream next 0 (maxSize l)+    where+      l = BS.length bs+      next i+          | i >= l = Done+          | U8.validate1 x1 = Yield (unsafeChr8 x1) (i+1)+          | i+1 < l && U8.validate2 x1 x2 = Yield (U8.chr2 x1 x2) (i+2)+          | i+2 < l && U8.validate3 x1 x2 x3 = Yield (U8.chr3 x1 x2 x3) (i+3)+          | i+3 < l && U8.validate4 x1 x2 x3 x4 = Yield (U8.chr4 x1 x2 x3 x4) (i+4)+          | otherwise = decodeError "streamUtf8" "UTF-8" onErr (Just x1) (i+1)+          where+            x1 = idx i+            x2 = idx (i + 1)+            x3 = idx (i + 2)+            x4 = idx (i + 3)+            idx = BS.index bs+{-# INLINE [0] streamUtf8 #-}++-- | /O(n)/ Convert a 'ShortByteString' into a 'Stream Char', using little+-- endian UTF-16 encoding.+streamUtf16LE :: OnDecodeError -> ShortByteString -> Stream Char+streamUtf16LE onErr bs = Stream next 0 (maxSize (l `shiftR` 1))+    where+      l = BS.length bs+      {-# INLINE next #-}+      next i+          | i >= l                         = Done+          | i+1 < l && U16.validate1 x1    = Yield (unsafeChr x1) (i+2)+          | i+3 < l && U16.validate2 x1 x2 = Yield (U16.chr2 x1 x2) (i+4)+          | otherwise = decodeError "streamUtf16LE" "UTF-16LE" onErr Nothing (i+1)+          where+            x1    = idx i       + (idx (i + 1) `shiftL` 8)+            x2    = idx (i + 2) + (idx (i + 3) `shiftL` 8)+            idx = fromIntegral . BS.index bs :: Int -> Word16+{-# INLINE [0] streamUtf16LE #-}++-- | Decode text from little endian UTF-16 encoding.+decodeUtf16LEWith :: OnDecodeError -> ShortByteString -> String+decodeUtf16LEWith onErr bs = unstream (streamUtf16LE onErr bs)+{-# INLINE decodeUtf16LEWith #-}++-- | Decode text from little endian UTF-16 encoding.+--+-- If the input contains any invalid little endian UTF-16 data, an+-- exception will be thrown.  For more control over the handling of+-- invalid data, use 'decodeUtf16LEWith'.+decodeUtf16LE :: ShortByteString -> String+decodeUtf16LE = decodeUtf16LEWith strictDecode+{-# INLINE decodeUtf16LE #-}++-- | Decode text from little endian UTF-16 encoding.+decodeUtf8With :: OnDecodeError -> ShortByteString -> String+decodeUtf8With onErr bs = unstream (streamUtf8 onErr bs)+{-# INLINE decodeUtf8With #-}++-- | Decode text from little endian UTF-16 encoding.+--+-- If the input contains any invalid little endian UTF-16 data, an+-- exception will be thrown.  For more control over the handling of+-- invalid data, use 'decodeUtf16LEWith'.+decodeUtf8 :: ShortByteString -> String+decodeUtf8 = decodeUtf8With strictDecode+{-# INLINE decodeUtf8 #-}+++decodeError :: forall s. String -> String -> OnDecodeError -> Maybe Word8+            -> s -> Step s Char+decodeError func kind onErr mb i =+    case onErr desc mb of+      Nothing -> Skip i+      Just c  -> Yield c i+    where desc = "Data.Text.Internal.Encoding.Fusion." ++ func ++ ": Invalid " +++                 kind ++ " stream"++-- | /O(n)/ Convert a 'Stream Char' into a 'Text'.+unstream :: Stream Char -> String+unstream (Stream next0 s0 _) = go s0+  where+    go si =+      case next0 si of+          Done        -> []+          Skip si'    -> go si'+          Yield c si' -> c : go si'+{-# INLINE [0] unstream #-}+++-- | Decode a 'ShortByteString' containing UTF-8 encoded text.+--+-- If the input contains any invalid UTF-8 data, the relevant+-- exception will be returned, otherwise the decoded text.+decodeUtf8' :: ShortByteString -> Either UnicodeException String+decodeUtf8' = unsafeDupablePerformIO . try . evaluate . decodeUtf8With strictDecode+{-# INLINE decodeUtf8' #-}+++-- | Decode a 'ShortByteString' containing UTF-16 encoded text.+--+-- If the input contains any invalid UTF-16 data, the relevant+-- exception will be returned, otherwise the decoded text.+decodeUtf16LE' :: ShortByteString -> Either UnicodeException String+decodeUtf16LE' = unsafeDupablePerformIO . try . evaluate . decodeUtf16LEWith strictDecode+{-# INLINE decodeUtf16LE' #-}+++-- | Decode a 'ByteString' containing UTF-16 encoded text.+--+-- If the input contains any invalid UTF-16 data, the relevant+-- exception will be returned, otherwise the decoded text.+decodeUtf16LE'' :: ByteString -> Either UnicodeException Text+decodeUtf16LE'' = unsafeDupablePerformIO . try . evaluate . E.decodeUtf16LEWith strictDecode+{-# INLINE decodeUtf16LE'' #-}+
+ lib/Data/ByteString/Short/Encode.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE RankNTypes #-}++module Data.ByteString.Short.Encode (encodeUtf8, encodeUtf16LE) where++import Data.Bits+    ( shiftR, (.&.) )+import Data.ByteString.Short+    ( ShortByteString )+import Data.Char+    ( ord )+import Data.Word+    ( Word8 )++import qualified Data.ByteString.Short as BS+    ( pack )+++encodeUtf8 :: String -> ShortByteString+encodeUtf8 = BS.pack . encode+  where+    encode :: String -> [Word8]+    encode = concatMap encodeChar++    encodeChar :: Char -> [Word8]+    encodeChar = map fromIntegral . go . ord+     where+      go oc+       | oc <= 0x7f       = [oc]++       | oc <= 0x7ff      = [ 0xc0 + (oc `shiftR` 6)+                            , 0x80 + oc .&. 0x3f+                            ]++       | oc <= 0xffff     = [ 0xe0 + (oc `shiftR` 12)+                            , 0x80 + ((oc `shiftR` 6) .&. 0x3f)+                            , 0x80 + oc .&. 0x3f+                            ]+       | otherwise        = [ 0xf0 + (oc `shiftR` 18)+                            , 0x80 + ((oc `shiftR` 12) .&. 0x3f)+                            , 0x80 + ((oc `shiftR` 6) .&. 0x3f)+                            , 0x80 + oc .&. 0x3f+                            ]+{-# INLINE encodeUtf8 #-}+++encodeUtf16LE :: String -> ShortByteString+encodeUtf16LE = BS.pack . encode+  where+    encode :: String -> [Word8]+    encode = concatMap encodeChar++    encodeChar :: Char -> [Word8]+    encodeChar = map fromIntegral . go . ord+      where+        go oc+          | oc < 0x10000 = [ oc, oc `shiftR` 8 ]+          | otherwise =+            let m = oc - 0x10000+            in [ m `shiftR` 10+               , (m `shiftR` 18) + 0xD8+               , m .&. 0x3FF +               , ((m .&. 0x3FF) `shiftR` 8) + 0xDC ]+{-# INLINE encodeUtf16LE #-}
+ lib/Data/ByteString/Short/Internal.hs view
@@ -0,0 +1,232 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE UnboxedTuples #-}++module Data.ByteString.Short.Internal+  ( create+  , asBA+  , BA(..)+  , MBA(..)+  , newPinnedByteArray+  , newByteArray+  , copyByteArray+  , unsafeFreezeByteArray+  , useAsCString+  , useAsCStringLen+  , useAsCWString+  , useAsCWStringLen+  , packCString+  , packCStringLen+  , packCWString+  , packCWStringLen+  , newCWString+  )++where++import Prelude hiding+    ( length )+import GHC.Exts+import GHC.ST+    ( ST (ST), runST )+import Data.Word+import Foreign.C.String hiding (newCWString)+import Foreign.Marshal.Alloc (allocaBytes)+import Foreign.Marshal.Array (mallocArray0)+import Foreign.Storable (pokeByteOff)+import "bytestring" Data.ByteString.Short.Internal+import Control.Exception ( throwIO )+#if MIN_VERSION_bytestring(0,10,9)+import Data.ByteString.Internal (c_strlen)+#else+import Foreign.C.Types+#endif+++create :: Int -> (forall s. MBA s -> ST s ()) -> ShortByteString+create len fill =+    runST $ do+      mba <- newByteArray len+      fill mba+      BA# ba# <- unsafeFreezeByteArray mba+      return (SBS ba#)+{-# INLINE create #-}+++asBA :: ShortByteString -> BA+asBA (SBS ba#) = BA# ba#++++data BA    = BA# ByteArray#+data MBA s = MBA# (MutableByteArray# s)+++newPinnedByteArray :: Int -> ST s (MBA s)+newPinnedByteArray (I# len#) =+    ST $ \s -> case newPinnedByteArray# len# s of+                 (# s', mba# #) -> (# s', MBA# mba# #)++newByteArray :: Int -> ST s (MBA s)+newByteArray (I# len#) =+    ST $ \s -> case newByteArray# len# s of+                 (# s', mba# #) -> (# s', MBA# mba# #)++copyByteArray :: BA -> Int -> MBA s -> Int -> Int -> ST s ()+copyByteArray (BA# src#) (I# src_off#) (MBA# dst#) (I# dst_off#) (I# len#) =+    ST $ \s -> case copyByteArray# src# src_off# dst# dst_off# len# s of+                 s' -> (# s', () #)++unsafeFreezeByteArray :: MBA s -> ST s BA+unsafeFreezeByteArray (MBA# mba#) =+    ST $ \s -> case unsafeFreezeByteArray# mba# s of+                 (# s', ba# #) -> (# s', BA# ba# #)+++-- this is a copy-paste from bytestring+#if !MIN_VERSION_bytestring(0,10,9)+------------------------------------------------------------------------+-- Primop replacements++-- ---------------------------------------------------------------------+--+-- Standard C functions+--++foreign import ccall unsafe "string.h strlen" c_strlen+    :: CString -> IO CSize+++-- ---------------------------------------------------------------------+--+-- Uses our C code+--++-- | /O(n)./ Construct a new @ShortByteString@ from a @CString@. The+-- resulting @ShortByteString@ is an immutable copy of the original+-- @CString@, and is managed on the Haskell heap. The original+-- @CString@ must be null terminated.+--+-- @since 0.10.10.0+packCString :: CString -> IO ShortByteString+packCString cstr = do+  len <- c_strlen cstr+  packCStringLen (cstr, fromIntegral len)++-- | /O(n)./ Construct a new @ShortByteString@ from a @CStringLen@. The+-- resulting @ShortByteString@ is an immutable copy of the original @CStringLen@.+-- The @ShortByteString@ is a normal Haskell value and will be managed on the+-- Haskell heap.+--+-- @since 0.10.10.0+packCStringLen :: CStringLen -> IO ShortByteString+packCStringLen (cstr, len) | len >= 0 = createFromPtr cstr len+packCStringLen (_, len) =+  moduleErrorIO "packCStringLen" ("negative length: " ++ show len)++-- | /O(n) construction./ Use a @ShortByteString@ with a function requiring a+-- null-terminated @CString@.  The @CString@ is a copy and will be freed+-- automatically; it must not be stored or used after the+-- subcomputation finishes.+--+-- @since 0.10.10.0+useAsCString :: ShortByteString -> (CString -> IO a) -> IO a+useAsCString bs action =+  allocaBytes (l+1) $ \buf -> do+      copyToPtr bs 0 buf (fromIntegral l)+      pokeByteOff buf l (0::Word8)+      action buf+  where l = length bs++-- | /O(n) construction./ Use a @ShortByteString@ with a function requiring a @CStringLen@.+-- As for @useAsCString@ this function makes a copy of the original @ShortByteString@.+-- It must not be stored or used after the subcomputation finishes.+--+-- @since 0.10.10.0+useAsCStringLen :: ShortByteString -> (CStringLen -> IO a) -> IO a+useAsCStringLen bs action =+  allocaBytes l $ \buf -> do+      copyToPtr bs 0 buf (fromIntegral l)+      action (buf, l)+  where l = length bs+++#endif+++-- | /O(n)./ Construct a new @ShortByteString@ from a @CWString@. The+-- resulting @ShortByteString@ is an immutable copy of the original+-- @CWString@, and is managed on the Haskell heap. The original+-- @CWString@ must be null terminated.+--+-- @since 0.10.10.0+packCWString :: CWString -> IO ShortByteString+packCWString cstr = do+  len <- c_strlen (coerce cstr)+  packCWStringLen (cstr, fromIntegral len)++-- | /O(n)./ Construct a new @ShortByteString@ from a @CWStringLen@. The+-- resulting @ShortByteString@ is an immutable copy of the original @CWStringLen@.+-- The @ShortByteString@ is a normal Haskell value and will be managed on the+-- Haskell heap.+--+-- @since 0.10.10.0+packCWStringLen :: CWStringLen -> IO ShortByteString+packCWStringLen (cstr, len) | len >= 0 = createFromPtr cstr len+packCWStringLen (_, len) =+  moduleErrorIO "packCWStringLen" ("negative length: " ++ show len)+++-- | /O(n) construction./ Use a @ShortByteString@ with a function requiring a+-- null-terminated @CWString@.  The @CWString@ is a copy and will be freed+-- automatically; it must not be stored or used after the+-- subcomputation finishes.+--+-- @since 0.10.10.0+useAsCWString :: ShortByteString -> (CWString -> IO a) -> IO a+useAsCWString bs action =+  allocaBytes (l+1) $ \buf -> do+      copyToPtr bs 0 buf (fromIntegral l)+      pokeByteOff buf l (0::Word8)+      action buf+  where l = length bs++-- | /O(n) construction./ Use a @ShortByteString@ with a function requiring a @CWStringLen@.+-- As for @useAsCWString@ this function makes a copy of the original @ShortByteString@.+-- It must not be stored or used after the subcomputation finishes.+--+-- @since 0.10.10.0+useAsCWStringLen :: ShortByteString -> (CWStringLen -> IO a) -> IO a+useAsCWStringLen bs action =+  allocaBytes l $ \buf -> do+      copyToPtr bs 0 buf (fromIntegral l)+      action (buf, l)+  where l = length bs++-- | /O(n) construction./ Use a @ShortByteString@ with a function requiring a @CWStringLen@.+-- As for @useAsCWString@ this function makes a copy of the original @ShortByteString@.+-- It must not be stored or used after the subcomputation finishes.+--+-- @since 0.10.10.0+newCWString :: ShortByteString -> IO CWString+newCWString bs = do+  ptr <- mallocArray0 l+  copyToPtr bs 0 ptr (fromIntegral l)+  pokeByteOff ptr l (0::Word8)+  return ptr+  where l = length bs+++ -- ---------------------------------------------------------------------+-- Internal utilities++moduleErrorIO :: String -> String -> IO a+moduleErrorIO fun msg = throwIO . userError $ moduleErrorMsg fun msg+{-# NOINLINE moduleErrorIO #-}++moduleErrorMsg :: String -> String -> String+moduleErrorMsg fun msg = "Data.ByteString.Short." ++ fun ++ ':':' ':msg
+ lib/Data/ByteString/Short/Word16.hs view
@@ -0,0 +1,884 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE ViewPatterns #-}++-- |+-- Module      :  Data.ByteString.Short.Word16+-- Copyright   :  © 2021 Julian Ospald+-- License     :  MIT+--+-- Maintainer  :  Julian Ospald <hasufell@posteo.de>+-- Stability   :  experimental+-- Portability :  portable+--+-- ShortByteStrings encoded as UTF16-LE, suitable for windows FFI calls.+--+-- Word16s are *always* in BE encoding (both input and output), so e.g. 'pack'+-- takes a list of BE encoded @[Word16]@ and produces a UTF16-LE encoded ShortByteString.+--+-- Likewise, 'unpack' takes a UTF16-LE encoded ShortByteString and produces a list of BE encoded @[Word16]@.+--+-- Indices and lengths are always in respect to Word16, not Word8.+--+-- All functions will error out if the input string is not a valid UTF16 stream (uneven number of bytes).+-- So use this module with caution.+module Data.ByteString.Short.Word16 (+  -- * Types+  ShortByteString,++  -- * Introducing and eliminating 'ShortByteString's+  empty,+  singleton,+  pack,+  unpack,+  fromShort,+  toShort,++  -- * Basic interface+  snoc,+  cons,+  append,+  last,+  tail,+  head,+  init,+  null,+  length,++  -- * Transforming ShortByteStrings+  map,+  reverse,+  intercalate,++  -- * Reducing 'ShortByteString's (folds)+  foldl,+  foldl',+  foldl1,+  foldl1',++  foldr,+  foldr',+  foldr1,+  foldr1',++  -- ** Special folds+  all,+  any,+  concat,++  -- ** Generating and unfolding ByteStrings+  replicate,+  unfoldr,+  unfoldrN,++  -- * Substrings++  -- ** Breaking strings+  take,+  takeEnd,+  takeWhile,+  takeWhileEnd,+  drop,+  dropEnd,+  dropWhile,+  dropWhileEnd,+  breakEnd,+  break,+  span,+  spanEnd,+  splitAt,+  split,+  splitWith,+  stripSuffix,+  stripPrefix,++  -- * Predicates+  isInfixOf,+  isPrefixOf,+  isSuffixOf,++  -- * Searching ShortByteStrings++  -- ** Searching by equality+  elem,++  -- ** Searching with a predicate+  find,+  filter,+  partition,++  -- * Indexing ShortByteStrings+  index,+  indexMaybe,+  (!?),+  elemIndex,+  elemIndices,+  count,+  findIndex,+  findIndices,++  -- * Low level conversions+  -- ** Packing 'CString's and pointers+  packCWString,+  packCWStringLen,+  newCWString,++  -- ** Using ShortByteStrings as 'CString's+  useAsCWString,+  useAsCWStringLen+  )+where++import Data.ByteString.Short+    ( append, intercalate, isInfixOf, isPrefixOf, isSuffixOf, stripSuffix, stripPrefix, fromShort, toShort, concat )+import Data.ByteString.Short.Internal+import Data.Word16+#if !MIN_VERSION_base(4,13,0)+import Data.Monoid ((<>))+#endif+import Data.Bifunctor+    ( first, bimap )+import Prelude hiding+    ( all+    , any+    , reverse+    , break+    , concat+    , drop+    , dropWhile+    , elem+    , filter+    , foldl+    , foldl1+    , foldr+    , foldr1+    , head+    , init+    , last+    , length+    , map+    , null+    , replicate+    , span+    , splitAt+    , tail+    , take+    , takeWhile+    )+import GHC.List (errorEmptyList)+import qualified Data.Foldable as Foldable+import Data.ByteString.Short+    ( ShortByteString+    , empty+    , null+    )+import GHC.Exts+import GHC.Word+import GHC.ST+    ( ST (ST) )++import qualified "bytestring" Data.ByteString.Short.Internal as BS+import qualified Data.List as List+++-- -----------------------------------------------------------------------------+-- Introducing and eliminating 'ShortByteString's++-- | /O(1)/ Convert a 'Word16' into a 'ShortByteString'+singleton :: Word16 -> ShortByteString+singleton = \w -> create 2 (\mba -> writeWord16Array mba 0 w)+{-# INLINE [1] singleton #-}+++-- | /O(n)/. Convert a list into a 'ShortByteString'+pack :: [Word16] -> ShortByteString+pack = packBytes+++-- | /O(n)/. Convert a 'ShortByteString' into a list.+unpack :: ShortByteString -> [Word16]+unpack = unpackBytes . assertEven+++-- ---------------------------------------------------------------------+-- Basic interface++-- | This is the number of 'Word16', not 'Word8'.+length :: ShortByteString -> Int+length = (`div` 2) . BS.length . assertEven++infixr 5 `cons` --same as list (:)+infixl 5 `snoc`++-- | /O(n)/ Append a Word16 to the end of a 'ShortByteString'+-- +-- Note: copies the entire byte array+snoc :: ShortByteString -> Word16 -> ShortByteString+snoc = \(assertEven -> sbs) c -> let l = BS.length sbs+                                     nl = l + 2+  in create nl $ \mba -> do+      copyByteArray (asBA sbs) 0 mba 0 nl+      writeWord16Array mba l c+{-# INLINE snoc #-}++-- | /O(n)/ 'cons' is analogous to (:) for lists.+--+-- Note: copies the entire byte array+cons :: Word16 -> ShortByteString -> ShortByteString+cons c = \(assertEven -> sbs) -> let l = BS.length sbs+                                     nl = l + 2+  in create nl $ \mba -> do+      writeWord16Array mba 0 c+      copyByteArray (asBA sbs) 0 mba 2 nl+{-# INLINE cons #-}++-- | /O(1)/ Extract the last element of a ShortByteString, which must be finite and at least one Word16.+-- An exception will be thrown in the case of an empty ShortByteString.+last :: ShortByteString -> Word16+last = \(assertEven -> sbs) ->+  indexWord16Array (asBA sbs) (BS.length sbs - 2)+{-# INLINE last #-}++-- | /O(n)/ Extract the elements after the head of a ShortByteString, which must at least one Word16.+-- An exception will be thrown in the case of an empty ShortByteString.+--+-- Note: copies the entire byte array+tail :: ShortByteString -> ShortByteString+tail = \(assertEven -> sbs) -> +  let l = BS.length sbs+      nl = l - 2+  in if+      | l <= 0 -> sbs+      | l <= 2 -> empty+      | otherwise -> create nl $ \mba -> copyByteArray (asBA sbs) 2 mba 0 nl+{-# INLINE tail #-}++-- | /O(1)/ Extract the first element of a ShortByteString, which must be at least one Word16.+-- An exception will be thrown in the case of an empty ShortByteString.+head :: ShortByteString -> Word16+head = \(assertEven -> sbs) -> indexWord16Array (asBA sbs) 0+{-# INLINE head #-}++-- | /O(n)/ Return all the elements of a 'ShortByteString' except the last one.+-- An exception will be thrown in the case of an empty ShortByteString.+--+-- Note: copies the entire byte array+init :: ShortByteString -> ShortByteString+init = \(assertEven -> sbs) ->+  let l = BS.length sbs+      nl = l - 2+  in if+      | l <= 0 -> sbs+      | l <= 2 -> empty+      | otherwise   -> create nl $ \mba -> copyByteArray (asBA sbs) 0 mba 0 nl+{-# INLINE init #-}+++-- ---------------------------------------------------------------------+-- Transformations++-- | /O(n)/ 'map' @f xs@ is the ShortByteString obtained by applying @f@ to each+-- element of @xs@.+map :: (Word16 -> Word16) -> ShortByteString -> ShortByteString+map f = \(assertEven -> sbs) ->+    let l = BS.length sbs+        ba = asBA sbs+    in create l (\mba -> go ba mba 0 l)+  where+    go :: BA -> MBA s -> Int -> Int -> ST s ()+    go !ba !mba !i !l+      | i >= l = return ()+      | otherwise = do+          let w = indexWord16Array ba i+          writeWord16Array mba i (f w)+          go ba mba (i+2) l++-- | /O(n)/ 'reverse' @xs@ efficiently returns the elements of @xs@ in reverse order.+reverse :: ShortByteString -> ShortByteString+reverse = \(assertEven -> sbs) ->+    let l = BS.length sbs+        ba = asBA sbs+    in create l (\mba -> go ba mba 0 l)+  where+    go :: BA -> MBA s -> Int -> Int -> ST s ()+    go !ba !mba !i !l+      | i >= l = return ()+      | otherwise = do+          let w = indexWord16Array ba i+          writeWord16Array mba (l - 2 - i) w+          go ba mba (i+2) l+++-- ---------------------------------------------------------------------+-- Special folds++-- | /O(n)/ Applied to a predicate and a 'ShortByteString', 'all' determines+-- if all elements of the 'ShortByteString' satisfy the predicate.+all :: (Word16 -> Bool) -> ShortByteString -> Bool+all k = \(assertEven -> sbs) -> +  let l = BS.length sbs+      ba = asBA sbs+      w = indexWord16Array ba+      go !n | n >= l = True+            | otherwise = k (w n) && go (n + 2)+  in go 0+++-- | /O(n)/ Applied to a predicate and a ByteString, 'any' determines if+-- any element of the 'ByteString' satisfies the predicate.+any :: (Word16 -> Bool) -> ShortByteString -> Bool+any k = \(assertEven -> sbs) ->+  let l = BS.length sbs+      ba = asBA sbs+      w = indexWord16Array ba+      go !n | n >= l = False+          | otherwise = k (w n) || go (n + 2)+  in go 0+{-# INLINE [1] any #-}+++-- ---------------------------------------------------------------------+-- Unfolds and replicates+++-- | /O(n)/ 'replicate' @n x@ is a ByteString of length @n@ with @x@+-- the value of every element. The following holds:+--+-- > replicate w c = unfoldr w (\u -> Just (u,u)) c+replicate :: Int -> Word16 -> ShortByteString+replicate w c+    | w <= 0    = empty+    | otherwise = create (w * 2) (\mba -> go mba 0)+  where+    go mba ix+      | ix < 0 || ix >= w * 2 = pure ()+      | otherwise = writeWord16Array mba ix c >> go mba (ix + 2)+{-# INLINE replicate #-}++-- | /O(n)/, where /n/ is the length of the result.  The 'unfoldr'+-- function is analogous to the List \'unfoldr\'.  'unfoldr' builds a+-- ShortByteString from a seed value.  The function takes the element and+-- returns 'Nothing' if it is done producing the ShortByteString or returns+-- 'Just' @(a,b)@, in which case, @a@ is the next byte in the string,+-- and @b@ is the seed value for further production.+--+-- This function is not efficient/safe. It will build a list of @[Word16]@+-- and run the generator until it returns `Nothing`, otherwise recurse infinitely,+-- then finally create a 'ShortByteString'.+--+-- Examples:+--+-- >    unfoldr (\x -> if x <= 5 then Just (x, x + 1) else Nothing) 0+-- > == pack [0, 1, 2, 3, 4, 5]+--+unfoldr :: (a -> Maybe (Word16, a)) -> a -> ShortByteString+unfoldr f x0 = packBytesRev $ go x0 mempty+ where+   go x words' = case f x of+                    Nothing -> words'+                    Just (w, x') -> go x' (w:words')+{-# INLINE unfoldr #-}++-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a ShortByteString from a seed+-- value.  However, the length of the result is limited by the first+-- argument to 'unfoldrN'.  This function is more efficient than 'unfoldr'+-- when the maximum length of the result is known.+--+-- This function is not efficient. It will build a full list of @[Word8]@+-- before creating a 'ShortByteString'.+--+-- The following equation relates 'unfoldrN' and 'unfoldr':+--+-- > fst (unfoldrN n f s) == take n (unfoldr f s)+--+unfoldrN :: Int -> (a -> Maybe (Word16, a)) -> a -> (ShortByteString, Maybe a)+unfoldrN i f x0 = first packBytesRev $ go (i - 1) x0 mempty+ where+   go i' x words'+    | i' < 0     = (words', Just x)+    | otherwise = case f x of+                    Nothing -> (words', Nothing)+                    Just (w, x') -> go (i' - 1) x' (w:words')+{-# INLINE unfoldrN #-}+++-- --------------------------------------------------------------------+-- Predicates++++-- ---------------------------------------------------------------------+-- Substrings++-- | /O(n)/ 'take' @n@, applied to a ShortByteString @xs@, returns the prefix+-- of @xs@ of length @n@, or @xs@ itself if @n > 'length' xs@.+--+-- Note: copies the entire byte array+take :: Int  -- ^ number of Word16+     -> ShortByteString+     -> ShortByteString+take = \n -> \(assertEven -> sbs) ->+  let len = min (length sbs) (max 0 n)+      len8 = len * 2+  in create len8 $ \mba -> copyByteArray (asBA sbs) 0 mba 0 len8+{-# INLINE take #-}+++-- | /O(1)/ @'takeEnd' n xs@ is equivalent to @'drop' ('length' xs - n) xs@.+-- Takes @n@ elements from end of bytestring.+--+-- >>> takeEnd 3 "a\NULb\NULc\NULd\NULe\NULf\NULg\NUL"+-- "e\NULf\NULg\NUL"+-- >>> takeEnd 0 "a\NULb\NULc\NULd\NULe\NULf\NULg\NUL"+-- ""+-- >>> takeEnd 4 "a\NULb\NULc\NUL"+-- "a\NULb\NULc\NUL"+takeEnd :: Int -> ShortByteString -> ShortByteString+takeEnd n sbs+    | n >= length sbs  = sbs+    | n <= 0           = empty+    | otherwise        = drop (length sbs - n) sbs+{-# INLINE takeEnd #-}++-- | Similar to 'P.takeWhile',+-- returns the longest (possibly empty) prefix of elements+-- satisfying the predicate.+takeWhile :: (Word16 -> Bool) -> ShortByteString -> ShortByteString+takeWhile f ps = take (findIndexOrLength (not . f) ps) ps+{-# INLINE [1] takeWhile #-}++-- | Returns the longest (possibly empty) suffix of elements+-- satisfying the predicate.+--+-- @'takeWhileEnd' p@ is equivalent to @'reverse' . 'takeWhile' p . 'reverse'@.+takeWhileEnd :: (Word16 -> Bool) -> ShortByteString -> ShortByteString+takeWhileEnd f ps = drop (findFromEndUntil (not . f) ps) ps+{-# INLINE takeWhileEnd #-}+++-- | /O(n)/ 'drop' @n@ @xs@ returns the suffix of @xs@ after the first n elements, or @[]@ if @n > 'length' xs@.+--+-- Note: copies the entire byte array+drop  :: Int -> ShortByteString -> ShortByteString+drop = \n -> \(assertEven -> sbs) ->+  let len = length sbs+      newLen = max 0 (len - max 0 n)+  in if | n <= 0          -> sbs+        | n >= length sbs -> empty+        | otherwise       -> create (newLen * 2) $ \mba -> copyByteArray (asBA sbs) (n * 2) mba 0 (newLen * 2)+{-# INLINE drop #-}++-- | /O(1)/ @'dropEnd' n xs@ is equivalent to @'take' ('length' xs - n) xs@.+-- Drops @n@ elements from end of bytestring.+--+-- >>> dropEnd 3 "a\NULb\NULc\NULd\NULe\NULf\NULg\NUL"+-- "a\NULb\NULc\NULd\NUL"+-- >>> dropEnd 0 "a\NULb\NULc\NULd\NULe\NULf\NULg\NUL"+-- "a\NULb\NULc\NULd\NULe\NULf\NULg\NUL"+-- >>> dropEnd 4 "a\NULb\NULc\NUL"+-- ""+dropEnd :: Int -> ShortByteString -> ShortByteString+dropEnd n sbs+    | n <= 0           = sbs+    | n >= length sbs  = empty+    | otherwise        = take (length sbs - n) sbs++-- | Similar to 'P.dropWhile',+-- drops the longest (possibly empty) prefix of elements+-- satisfying the predicate and returns the remainder.+--+-- Note: copies the entire byte array+dropWhile :: (Word16 -> Bool) -> ShortByteString -> ShortByteString+dropWhile f = \(assertEven -> ps) -> drop (findIndexOrLength (not . f) ps) ps++-- | Similar to 'P.dropWhileEnd',+-- drops the longest (possibly empty) suffix of elements+-- satisfying the predicate and returns the remainder.+--+-- @'dropWhileEnd' p@ is equivalent to @'reverse' . 'dropWhile' p . 'reverse'@.+--+-- @since 0.10.12.0+dropWhileEnd :: (Word16 -> Bool) -> ShortByteString -> ShortByteString+dropWhileEnd f = \(assertEven -> ps) -> take (findFromEndUntil (not . f) ps) ps+{-# INLINE dropWhileEnd #-}++-- | Returns the longest (possibly empty) suffix of elements which __do not__+-- satisfy the predicate and the remainder of the string.+--+-- 'breakEnd' @p@ is equivalent to @'spanEnd' (not . p)@ and to @('takeWhileEnd' (not . p) &&& 'dropWhileEnd' (not . p))@.+breakEnd :: (Word16 -> Bool) -> ShortByteString -> (ShortByteString, ShortByteString)+breakEnd p = \(assertEven -> sbs) -> splitAt (findFromEndUntil p sbs) sbs+{-# INLINE breakEnd #-}++-- | Similar to 'P.break',+-- returns the longest (possibly empty) prefix of elements which __do not__+-- satisfy the predicate and the remainder of the string.+--+-- 'break' @p@ is equivalent to @'span' (not . p)@ and to @('takeWhile' (not . p) &&& 'dropWhile' (not . p))@.+break :: (Word16 -> Bool) -> ShortByteString -> (ShortByteString, ShortByteString)+break = \p -> \(assertEven -> ps) -> case findIndexOrLength p ps of n -> (take n ps, drop n ps)+{-# INLINE [1] break #-}++-- | Similar to 'P.span',+-- returns the longest (possibly empty) prefix of elements+-- satisfying the predicate and the remainder of the string.+--+-- 'span' @p@ is equivalent to @'break' (not . p)@ and to @('takeWhile' p &&& 'dropWhile' p)@.+--+span :: (Word16 -> Bool) -> ShortByteString -> (ShortByteString, ShortByteString)+span p = break (not . p) . assertEven++-- | Returns the longest (possibly empty) suffix of elements+-- satisfying the predicate and the remainder of the string.+--+-- 'spanEnd' @p@ is equivalent to @'breakEnd' (not . p)@ and to @('takeWhileEnd' p &&& 'dropWhileEnd' p)@.+--+-- We have+--+-- > spanEnd (not . isSpace) "x y z" == ("x y ", "z")+--+-- and+--+-- > spanEnd (not . isSpace) ps+-- >    ==+-- > let (x, y) = span (not . isSpace) (reverse ps) in (reverse y, reverse x)+--+spanEnd :: (Word16 -> Bool) -> ShortByteString -> (ShortByteString, ShortByteString)+spanEnd  p = \(assertEven -> ps) -> splitAt (findFromEndUntil (not.p) ps) ps++-- | /O(n)/ 'splitAt' @n xs@ is equivalent to @('take' n xs, 'drop' n xs)@.+--+-- Note: copies the substrings+splitAt :: Int -- ^ number of Word16+        -> ShortByteString+        -> (ShortByteString, ShortByteString)+splitAt n = \(assertEven -> xs) -> if+  | n <= 0 -> (mempty, xs)+  | n >= BS.length xs * 2 -> (xs, mempty)+  | otherwise -> (take n xs, drop n xs)++-- | /O(n)/ Break a 'ShortByteString' into pieces separated by the byte+-- argument, consuming the delimiter. I.e.+--+-- > split 10  "a\nb\nd\ne" == ["a","b","d","e"]   -- fromEnum '\n' == 10+-- > split 97  "aXaXaXa"    == ["","X","X","X",""] -- fromEnum 'a' == 97+-- > split 120 "x"          == ["",""]             -- fromEnum 'x' == 120+-- > split undefined ""     == []                  -- and not [""]+--+-- and+--+-- > intercalate [c] . split c == id+-- > split == splitWith . (==)+--+-- Note: copies the substrings+split :: Word16 -> ShortByteString -> [ShortByteString]+split w = splitWith (== w) . assertEven+++-- | /O(n)/ Splits a 'ShortByteString' into components delimited by+-- separators, where the predicate returns True for a separator element.+-- The resulting components do not contain the separators.  Two adjacent+-- separators result in an empty component in the output.  eg.+--+-- > splitWith (==97) "aabbaca" == ["","","bb","c",""] -- fromEnum 'a' == 97+-- > splitWith undefined ""     == []                  -- and not [""]+--+splitWith :: (Word16 -> Bool) -> ShortByteString -> [ShortByteString]+splitWith p = \(assertEven -> sbs) -> if+  | BS.null sbs -> []+  | otherwise -> go sbs+  where+    go sbs'+      | BS.null sbs' = [mempty]+      | otherwise =+          case break p sbs' of+            (a, b)+              | BS.null b -> [a]+              | otherwise -> a : go (tail b)+++-- ---------------------------------------------------------------------+-- Reducing 'ByteString's++-- | 'foldl', applied to a binary operator, a starting value (typically+-- the left-identity of the operator), and a ShortByteString, reduces the+-- ShortByteString using the binary operator, from left to right.+--+foldl :: (a -> Word16 -> a) -> a -> ShortByteString -> a+foldl f v = List.foldl f v . unpack . assertEven+{-# INLINE foldl #-}++-- | 'foldl'' is like 'foldl', but strict in the accumulator.+--+foldl' :: (a -> Word16 -> a) -> a -> ShortByteString -> a+foldl' f v = List.foldl' f v . unpack . assertEven+{-# INLINE foldl' #-}++-- | 'foldr', applied to a binary operator, a starting value+-- (typically the right-identity of the operator), and a ShortByteString,+-- reduces the ShortByteString using the binary operator, from right to left.+foldr :: (Word16 -> a -> a) -> a -> ShortByteString -> a+foldr f v = List.foldr f v . unpack . assertEven+{-# INLINE foldr #-}++-- | 'foldr'' is like 'foldr', but strict in the accumulator.+foldr' :: (Word16 -> a -> a) -> a -> ShortByteString -> a+foldr' k v = Foldable.foldr' k v . unpack . assertEven+{-# INLINE foldr' #-}++-- | 'foldl1' is a variant of 'foldl' that has no starting value+-- argument, and thus must be applied to non-empty 'ShortByteString's.+-- An exception will be thrown in the case of an empty ShortByteString.+foldl1 :: (Word16 -> Word16 -> Word16) -> ShortByteString -> Word16+foldl1 k = List.foldl1 k . unpack . assertEven+{-# INLINE foldl1 #-}++-- | 'foldl1'' is like 'foldl1', but strict in the accumulator.+-- An exception will be thrown in the case of an empty ShortByteString.+foldl1' :: (Word16 -> Word16 -> Word16) -> ShortByteString -> Word16+foldl1' k = List.foldl1' k . unpack . assertEven++-- | 'foldr1' is a variant of 'foldr' that has no starting value argument,+-- and thus must be applied to non-empty 'ShortByteString's+-- An exception will be thrown in the case of an empty ShortByteString.+foldr1 :: (Word16 -> Word16 -> Word16) -> ShortByteString -> Word16+foldr1 k = List.foldr1 k . unpack . assertEven+{-# INLINE foldr1 #-}++-- | 'foldr1'' is a variant of 'foldr1', but is strict in the+-- accumulator.+foldr1' :: (Word16 -> Word16 -> Word16) -> ShortByteString -> Word16+foldr1' k = \(assertEven -> sbs) -> if null sbs then errorEmptyList "foldr1'" else foldr' k (last sbs) (init sbs)+++-- --------------------------------------------------------------------+-- Searching ShortByteString++-- | /O(1)/ 'ShortByteString' index (subscript) operator, starting from 0.+index :: ShortByteString -> Int -> Word16+index = \(assertEven -> sbs) i ->+  let ba = asBA sbs+      w = indexWord16Array ba+  in if+    | i >= 0 && i < length sbs -> w (i * 2)+    | otherwise                -> error $ "Data.ByteString.Short.Word16.index: error in array index; "+                                   ++ show i ++ " not in range [0.." ++ show (length sbs) ++ ")"++-- | /O(1)/ 'ShortByteString' index, starting from 0, that returns 'Just' if:+--+-- > 0 <= n < length bs+--+-- @since 0.11.0.0+indexMaybe :: ShortByteString -> Int -> Maybe Word16+indexMaybe = \(assertEven -> sbs) i ->+  let ba = asBA sbs+      w = indexWord16Array ba+  in if+    | i >= 0 && i < length sbs -> Just (w (i * 2))+    | otherwise                -> Nothing+{-# INLINE indexMaybe #-}++-- | /O(1)/ 'ShortByteString' index, starting from 0, that returns 'Just' if:+--+-- > 0 <= n < length bs+--+-- @since 0.11.0.0+(!?) :: ShortByteString -> Int -> Maybe Word16+(!?) = indexMaybe+{-# INLINE (!?) #-}++-- | /O(n)/ 'elem' is the 'ShortByteString' membership predicate.+elem :: Word16 -> ShortByteString -> Bool+elem c = \ps -> case elemIndex c ps of Nothing -> False ; _ -> True++-- | /O(n)/ 'filter', applied to a predicate and a ByteString,+-- returns a ByteString containing those characters that satisfy the+-- predicate.+filter :: (Word16 -> Bool) -> ShortByteString -> ShortByteString+filter k = \sbs -> if+    | null sbs  -> sbs+    | otherwise -> pack . List.filter k . unpack . assertEven $ sbs+{-# INLINE filter #-}++-- | /O(n)/ The 'find' function takes a predicate and a ByteString,+-- and returns the first element in matching the predicate, or 'Nothing'+-- if there is no such element.+--+-- > find f p = case findIndex f p of Just n -> Just (p ! n) ; _ -> Nothing+--+find :: (Word16 -> Bool) -> ShortByteString -> Maybe Word16+find f = List.find f . unpack . assertEven+{-# INLINE find #-}++-- | /O(n)/ The 'partition' function takes a predicate a ByteString and returns+-- the pair of ByteStrings with elements which do and do not satisfy the+-- predicate, respectively; i.e.,+--+-- > partition p bs == (filter p xs, filter (not . p) xs)+--+partition :: (Word16 -> Bool) -> ShortByteString -> (ShortByteString, ShortByteString)+partition f = \s -> if+    | null s    -> (s, s)+    | otherwise -> bimap pack pack . List.partition f . unpack . assertEven $ s++-- --------------------------------------------------------------------+-- Indexing ShortByteString++-- | /O(n)/ The 'elemIndex' function returns the index of the first+-- element in the given 'ShortByteString' which is equal to the query+-- element, or 'Nothing' if there is no such element.+elemIndex :: Word16 -> ShortByteString -> Maybe Int+elemIndex k = findIndex (==k)+{-# INLINE elemIndex #-}++-- | /O(n)/ The 'elemIndices' function extends 'elemIndex', by returning+-- the indices of all elements equal to the query element, in ascending order.+elemIndices :: Word16 -> ShortByteString -> [Int]+elemIndices k = findIndices (==k)++-- | count returns the number of times its argument appears in the ShortByteString+count :: Word16 -> ShortByteString -> Int+count w = List.length . elemIndices w++-- | /O(n)/ The 'findIndex' function takes a predicate and a 'ShortByteString' and+-- returns the index of the first element in the ByteString+-- satisfying the predicate.+findIndex :: (Word16 -> Bool) -> ShortByteString -> Maybe Int+findIndex k = \sbs ->+  let l = BS.length sbs+      ba = asBA sbs+      w = indexWord16Array ba+      go !n | n >= l    = Nothing+            | k (w n)   = Just (n `div` 2)+            | otherwise = go (n + 2)+  in go 0+{-# INLINE findIndex #-}++-- | /O(n)/ The 'findIndices' function extends 'findIndex', by returning the+-- indices of all elements satisfying the predicate, in ascending order.+findIndices :: (Word16 -> Bool) -> ShortByteString -> [Int]+findIndices k = \sbs ->+  let l = BS.length sbs+      ba = asBA sbs+      w = indexWord16Array ba+      go !n | n >= l    = []+            | k (w n)   = (n `div` 2) : go (n + 2)+            | otherwise = go (n + 2)+  in go 0+{-# INLINE [1] findIndices #-}+++-- --------------------------------------------------------------------+-- Internal++-- | This isn't strictly Word16 array write. Instead it's two consecutive Word8 array+-- writes to avoid endianness issues due to primops doing automatic alignment based+-- on host platform. We want to always write LE to the byte array.+writeWord16Array :: MBA s+                 -> Int      -- ^ Word8 index (not Word16)+                 -> Word16+                 -> ST s ()+writeWord16Array (MBA# mba#) (I# i#) (W16# w#) =+  case encodeWord16LE# w# of+    (# lsb#, msb# #) ->+      (ST $ \s -> case writeWord8Array# mba# i# lsb# s of+          s' -> (# s', () #)) >>+      (ST $ \s -> case writeWord8Array# mba# (i# +# 1#) msb# s of+          s' -> (# s', () #))++-- | This isn't strictly Word16 array read. Instead it's two Word8 array reads+-- to avoid endianness issues due to primops doing automatic alignment based+-- on host platform. We expect the byte array to be LE always.+indexWord16Array :: BA+                 -> Int      -- ^ Word8 index (not Word16)+                 -> Word16+indexWord16Array (BA# ba#) (I# i#) = +  case (# indexWord8Array# ba# i#, indexWord8Array# ba# (i# +# 1#) #) of+    (# lsb#, msb# #) -> W16# ((decodeWord16LE# (# lsb#, msb# #)))+++packBytes :: [Word16] -> ShortByteString+packBytes cs = packLenBytes (List.length cs) cs++packLenBytes :: Int -> [Word16] -> ShortByteString+packLenBytes len ws0 =+    create (len * 2) (\mba -> go mba 0 ws0)+  where+    go :: MBA s -> Int -> [Word16] -> ST s ()+    go !_   !_ []     = return ()+    go !mba !i (w:ws) = do+      writeWord16Array mba i w+      go mba (i+2) ws++packBytesRev :: [Word16] -> ShortByteString+packBytesRev cs = packLenBytesRev ((List.length cs) * 2) cs++packLenBytesRev :: Int -> [Word16] -> ShortByteString+packLenBytesRev len ws0 =+    create len (\mba -> go mba len ws0)+  where+    go :: MBA s -> Int -> [Word16] -> ST s ()+    go !_   !_ []     = return ()+    go !mba !i (w:ws) = do+      writeWord16Array mba (i - 2) w+      go mba (i - 2) ws+++unpackBytes :: ShortByteString -> [Word16]+unpackBytes sbs = go len []+  where+    len = BS.length sbs+    go !i !acc+      | i < 1     = acc+      | otherwise = let !w = indexWord16Array (asBA sbs) (i - 2)+                    in go (i - 2) (w:acc)++-- Returns the index of the first match or the length of the whole+-- bytestring if nothing matched.+findIndexOrLength :: (Word16 -> Bool) -> ShortByteString -> Int+findIndexOrLength k sbs = go 0+  where+    l = BS.length sbs+    ba = asBA sbs+    w = indexWord16Array ba+    go !n | n >= l     = l `div` 2+          | k (w n)    = n `div` 2+          | otherwise  = go (n + 2)+{-# INLINE findIndexOrLength #-}+++-- | Returns the length of the substring matching, not the index.+-- If no match, returns 0.+findFromEndUntil :: (Word16 -> Bool) -> ShortByteString -> Int+findFromEndUntil k sbs = go (BS.length sbs - 2)+  where+    ba = asBA sbs+    w = indexWord16Array ba+    go !n | n < 0     = 0+          | k (w n)   = (n `div` 2) + 1+          | otherwise = go (n - 2)+{-# INLINE findFromEndUntil #-}+++assertEven :: ShortByteString -> ShortByteString+assertEven sbs@(BS.SBS barr#)+  | even (I# (sizeofByteArray# barr#)) = sbs+  | otherwise = error ("Uneven number of bytes: " <> show (BS.length sbs) <> ". This is not a Word16 bytestream.")++++encodeWord16LE# :: Word# -- ^ Word16+                -> (# Word#, Word# #) -- ^ Word8 (LSB, MSB)+encodeWord16LE# x# = (# (x# `and#` int2Word# 0xff#)+                     ,  ((x# `and#` int2Word# 0xff00#) `shiftRL#` 8#) #)++decodeWord16LE# :: (# Word#, Word# #) -- ^ Word8 (LSB, MSB)+                -> Word#              -- ^ Word16+decodeWord16LE# (# lsb#, msb# #) = ((msb# `shiftL#` 8#) `or#` lsb#)+
+ shortbytestring.cabal view
@@ -0,0 +1,93 @@+cabal-version:      3.0+name:               shortbytestring+version:            0.1.0.0+license:            MIT+license-file:       LICENSE+maintainer:         hasufell@posteo.de+author:             Julian Ospald+bug-reports:        https://github.com/hasufell/shortbytestring/issues+synopsis:           Additional ShortByteString API+description:+  Additional ShortByteString API, as well as a Word16 based UTF-16LE module.++tested-with:+  GHC ==8.0.2+   || ==8.2.2+   || ==8.4.4+   || ==8.6.5+   || ==8.8.4+   || ==8.10.6+   || ==9.0.1++category:           System+extra-doc-files:    CHANGELOG.md+extra-source-files: tests/Properties/ByteString/Common.hs++library+  exposed-modules:+    Data.ByteString.Short+    Data.ByteString.Short.Decode+    Data.ByteString.Short.Encode+    Data.ByteString.Short.Internal+    Data.ByteString.Short.Word16++  hs-source-dirs:           lib+  default-language:         Haskell2010+  build-depends:+    , base              >=4.9.1.0  && <5+    , bytestring        ^>=0.10.8.1+    , exceptions        ^>=0.10+    , primitive         ^>=0.7+    , template-haskell  >=2.10     && <2.20+    , text              >=1.2.3.0  && <1.2.6+    , word16+    , word8             ^>=0.1++  x-docspec-extra-packages: QuickCheck++benchmark bench+  main-is:          Bench.hs+  other-modules:+    Short.BenchAll+    Short.BenchIndices+    Short.Word16.BenchAll+    Short.Word16.BenchIndices++  type:             exitcode-stdio-1.0+  hs-source-dirs:   bench+  default-language: Haskell2010+  ghc-options:      -O2 -with-rtsopts=-A32m+  build-depends:+    , base             >=4.9.1.0  && <5+    , bytestring       ^>=0.10.8.1+    , deepseq          ^>=1.4+    , random           ^>=1.1+    , shortbytestring+    , tasty-bench      ^>=0.3++test-suite prop-compiled+  type:             exitcode-stdio-1.0+  main-is:          Properties.hs+  other-modules:+    Properties.ByteString.Short+    Properties.ByteString.Short.Word16++  hs-source-dirs:   tests+  include-dirs:     tests/Properties+  build-depends:+    , base              >=4.9.1.0  && <5+    , bytestring        ^>=0.10.8.1+    , deepseq+    , ghc-prim+    , shortbytestring+    , tasty+    , tasty-quickcheck+    , word16+    , word8++  ghc-options:      -fwarn-unused-binds -threaded -rtsopts+  default-language: Haskell2010++source-repository head+  type:     git+  location: https://github.com/hasufell/shortbytestring.git
+ tests/Properties.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+++import Test.Tasty++import qualified Properties.ByteString.Short as PropShort+import qualified Properties.ByteString.Short.Word16 as PropShortWord16+++------------------------------------------------------------------------+-- The entry point++main :: IO ()+main = defaultMain $ testGroup "All"+  [ testGroup "StrictWord8" PropShort.tests+  , testGroup "StrictWord16" PropShortWord16.tests+  ]+
+ tests/Properties/ByteString/Common.hs view
@@ -0,0 +1,415 @@+-- |+-- Module      : Properties.ByteString+-- Copyright   : (c) Andrew Lelechenko 2021+-- License     : BSD-style++{-# LANGUAGE CPP #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE PackageImports #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-- We are happy to sacrifice optimizations in exchange for faster compilation,+-- but need to test rewrite rules. As one can check using -ddump-rule-firings,+-- rewrite rules do not fire in -O0 mode, so we use -O1, but disable almost all+-- optimizations. It roughly halves compilation time.+{-# OPTIONS_GHC -O1 -fenable-rewrite-rules+  -fmax-simplifier-iterations=1 -fsimplifier-phases=0+  -fno-call-arity -fno-case-merge -fno-cmm-elim-common-blocks -fno-cmm-sink+  -fno-cpr-anal -fno-cse -fno-do-eta-reduction -fno-float-in -fno-full-laziness+  -fno-loopification -fno-specialise -fno-strictness #-}++#ifdef WORD8+module Properties.ByteString.Short (tests) where+import Data.Word8 (isSpace)+import qualified "shortbytestring" Data.ByteString.Short as B+#else+module Properties.ByteString.Short.Word16 (tests) where+import Data.Word16 (isSpace)+import qualified "shortbytestring" Data.ByteString.Short.Word16 as B+#endif+import "shortbytestring" Data.ByteString.Short (ShortByteString)++import Data.Word++import Control.Arrow+import Data.Foldable+import Data.List as L+import Data.Semigroup+import Data.Tuple+import Test.Tasty+import Test.Tasty.QuickCheck+import Text.Show.Functions ()++#ifdef WORD16+toElem :: Word16 -> Word16+toElem = id++swapW :: Word16 -> Word16+swapW = byteSwap16++sizedByteString :: Int -> Gen ShortByteString+sizedByteString n = do m <- choose(0, n)+                       fmap B.pack $ vectorOf m arbitrary++instance Arbitrary ShortByteString where+  arbitrary = do+    bs <- sized sizedByteString+    n  <- choose (0, 2)+    return (B.drop n bs) -- to give us some with non-0 offset++instance CoArbitrary ShortByteString where+  coarbitrary s = coarbitrary (B.unpack s)++#else+toElem :: Word8 -> Word8+toElem = id++swapW :: Word8 -> Word8+swapW = id+++sizedByteString :: Int -> Gen ShortByteString+sizedByteString n = do m <- choose(0, n)+                       fmap B.pack $ vectorOf m arbitrary++instance Arbitrary ShortByteString where+  arbitrary = do+    bs <- sized sizedByteString+    n  <- choose (0, 2)+    return (B.drop n bs) -- to give us some with non-0 offset+  shrink = map B.pack . shrink . B.unpack++instance CoArbitrary ShortByteString where+  coarbitrary s = coarbitrary (B.unpack s)++#endif++tests :: [TestTree]+tests =+  [ testProperty "pack . unpack" $+    \x -> x === B.pack (B.unpack x)+  , testProperty "unpack . pack" $+    \(map toElem -> xs) -> xs === B.unpack (B.pack xs)+  , testProperty "read . show" $+    \x -> (x :: ShortByteString) === read (show x)++  , testProperty "==" $+    \x y -> (x == y) === (B.unpack x == B.unpack y)+  , testProperty "== refl" $+    \x -> (x :: ShortByteString) == x+  , testProperty "== symm" $+    \x y -> ((x :: ShortByteString) == y) === (y == x)+  , testProperty "== pack unpack" $+    \x -> x == B.pack (B.unpack x)++  , testProperty "compare" $+    \x y -> compare x y === compare (swapW <$> B.unpack x) (swapW <$> B.unpack y)+  , testProperty "compare EQ" $+    \x -> compare (x :: ShortByteString) x == EQ+  , testProperty "compare GT" $+    \x (toElem -> c) -> compare (B.snoc x c) x == GT+  , testProperty "compare LT" $+    \x (toElem -> c) -> compare x (B.snoc x c) == LT+  , testProperty "compare GT empty" $+    \x -> not (B.null x) ==> compare x B.empty == GT+  , testProperty "compare LT empty" $+    \x -> not (B.null x) ==> compare B.empty x == LT+  , testProperty "compare GT concat" $+    \x y -> not (B.null y) ==> compare (x <> y) x == GT+  , testProperty "compare char" $+    \(toElem -> c) (toElem -> d) -> compare (swapW c) (swapW d) == compare (B.singleton c) (B.singleton d)+  , testProperty "compare unsigned" $ once $+    compare (B.singleton 255) (B.singleton 127) == GT++  , testProperty "null" $+    \x -> B.null x === null (B.unpack x)+  , testProperty "empty 0" $ once $+    B.length B.empty === 0+  , testProperty "empty []" $ once $+    B.unpack B.empty === []+  , testProperty "mempty 0" $ once $+    B.length mempty === 0+  , testProperty "mempty []" $ once $+    B.unpack mempty === []++  , testProperty "concat" $+    \xs -> B.unpack (B.concat xs) === concat (map B.unpack xs)+  , testProperty "concat [x,x]" $+    \x -> B.unpack (B.concat [x, x]) === concat [B.unpack x, B.unpack x]+  , testProperty "concat [x,[]]" $+    \x -> B.unpack (B.concat [x, B.empty]) === concat [B.unpack x, []]+  , testProperty "mconcat" $+    \xs -> B.unpack (mconcat xs) === mconcat (map B.unpack xs)+  , testProperty "mconcat [x,x]" $+    \x -> B.unpack (mconcat [x, x]) === mconcat [B.unpack x, B.unpack x]+  , testProperty "mconcat [x,[]]" $+    \x -> B.unpack (mconcat [x, B.empty]) === mconcat [B.unpack x, []]++  , testProperty "null" $+    \x -> B.null x === null (B.unpack x)+  , testProperty "reverse" $+    \x -> B.unpack (B.reverse x) === reverse (B.unpack x)+  , testProperty "all" $+    \f x -> B.all f x === all f (B.unpack x)+  , testProperty "all ==" $+    \(toElem -> c) x -> B.all (== c) x === all (== c) (B.unpack x)+  , testProperty "any" $+    \f x -> B.any f x === any f (B.unpack x)+  , testProperty "any ==" $+    \(toElem -> c) x -> B.any (== c) x === any (== c) (B.unpack x)+  , testProperty "append" $+    \x y -> B.unpack (B.append x y) === B.unpack x ++ B.unpack y+  , testProperty "mappend" $+    \x y -> B.unpack (mappend x y) === B.unpack x `mappend` B.unpack y+  , testProperty "<>" $+    \x y -> B.unpack (x <> y) === B.unpack x <> B.unpack y+  , testProperty "stimes" $+    \(Positive n) x -> stimes (n :: Int) (x :: ShortByteString) === mtimesDefault n x++  , testProperty "break" $+    \f x -> (B.unpack *** B.unpack) (B.break f x) === break f (B.unpack x)+  , testProperty "break ==" $+    \(toElem -> c) x -> (B.unpack *** B.unpack) (B.break (== c) x) === break (== c) (B.unpack x)+  , testProperty "break /=" $+    \(toElem -> c) x -> (B.unpack *** B.unpack) (B.break (/= c) x) === break (/= c) (B.unpack x)+  , testProperty "break span" $+    \f x -> B.break f x === B.span (not . f) x+  , testProperty "breakEnd" $+    \f x -> B.breakEnd f x === swap ((B.reverse *** B.reverse) (B.break f (B.reverse x)))+  , testProperty "breakEnd" $+    \f x -> B.breakEnd f x === B.spanEnd (not . f) x+#ifndef WORD16+  , testProperty "break breakSubstring" $+    \(toElem -> c) x -> B.break (== c) x === B.breakSubstring (B.singleton c) x+  , testProperty "breakSubstring" $+    \x y -> not (B.null x) ==> B.null (snd (B.breakSubstring x y)) === not (B.isInfixOf x y)+  , testProperty "breakSubstring empty" $+    \x -> B.breakSubstring B.empty x === (B.empty, x)+#endif+  , testProperty "break isSpace" $+    \x -> (B.unpack *** B.unpack) (B.break isSpace x) === break isSpace (B.unpack x)++  , testProperty "singleton" $+    \(toElem -> c) -> B.unpack (B.singleton c) === [c]+  , testProperty "cons" $+    \(toElem -> c) x -> B.unpack (B.cons c x) === c : B.unpack x+  , testProperty "cons []" $+    \(toElem -> c) -> B.unpack (B.cons c B.empty) === [c]+  , testProperty "snoc" $+    \(toElem -> c) x -> B.unpack (B.snoc x c) === B.unpack x ++ [c]+  , testProperty "snoc []" $+    \(toElem -> c) -> B.unpack (B.snoc B.empty c) === [c]++  , testProperty "drop" $+    \n x -> B.unpack (B.drop n x) === drop (fromIntegral n) (B.unpack x)+  , testProperty "drop 10" $+    \x -> B.unpack (B.drop 10 x) === drop 10 (B.unpack x)+  , testProperty "dropWhile" $+    \f x -> B.unpack (B.dropWhile f x) === dropWhile f (B.unpack x)+  , testProperty "dropWhile ==" $+    \(toElem -> c) x -> B.unpack (B.dropWhile (== c) x) === dropWhile (== c) (B.unpack x)+  , testProperty "dropWhile /=" $+    \(toElem -> c) x -> B.unpack (B.dropWhile (/= c) x) === dropWhile (/= c) (B.unpack x)+  , testProperty "dropWhile isSpace" $+    \x -> B.unpack (B.dropWhile isSpace x) === dropWhile isSpace (B.unpack x)++  , testProperty "take" $+    \n x -> B.unpack (B.take n x) === take (fromIntegral n) (B.unpack x)+  , testProperty "take 10" $+    \x -> B.unpack (B.take 10 x) === take 10 (B.unpack x)+  , testProperty "takeWhile" $+    \f x -> B.unpack (B.takeWhile f x) === takeWhile f (B.unpack x)+  , testProperty "takeWhile ==" $+    \(toElem -> c) x -> B.unpack (B.takeWhile (== c) x) === takeWhile (== c) (B.unpack x)+  , testProperty "takeWhile /=" $+    \(toElem -> c) x -> B.unpack (B.takeWhile (/= c) x) === takeWhile (/= c) (B.unpack x)++  , testProperty "takeWhile isSpace" $+    \x -> B.unpack (B.takeWhile isSpace x) === takeWhile isSpace (B.unpack x)++  , testProperty "dropEnd" $+    \n x -> B.dropEnd n x === B.take (B.length x - n) x+  , testProperty "dropWhileEnd" $+    \f x -> B.dropWhileEnd f x === B.reverse (B.dropWhile f (B.reverse x))+  , testProperty "takeEnd" $+    \n x -> B.takeEnd n x === B.drop (B.length x - n) x+  , testProperty "takeWhileEnd" $+    \f x -> B.takeWhileEnd f x === B.reverse (B.takeWhile f (B.reverse x))++  , testProperty "length" $+    \x -> B.length x === fromIntegral (length (B.unpack x))+  , testProperty "count" $+    \(toElem -> c) x -> B.count c x === fromIntegral (length (elemIndices c (B.unpack x)))+  , testProperty "filter" $+    \f x -> B.unpack (B.filter f x) === filter f (B.unpack x)+  , testProperty "filter compose" $+    \f g x -> B.filter f (B.filter g x) === B.filter (\c -> f c && g c) x+  , testProperty "filter ==" $+    \(toElem -> c) x -> B.unpack (B.filter (== c) x) === filter (== c) (B.unpack x)+  , testProperty "filter /=" $+    \(toElem -> c) x -> B.unpack (B.filter (/= c) x) === filter (/= c) (B.unpack x)+  , testProperty "partition" $+    \f x -> (B.unpack *** B.unpack) (B.partition f x) === partition f (B.unpack x)++  , testProperty "find" $+    \f x -> B.find f x === find f (B.unpack x)+  , testProperty "findIndex" $+    \f x -> B.findIndex f x === fmap fromIntegral (findIndex f (B.unpack x))+  , testProperty "findIndices" $+    \f x -> B.findIndices f x === fmap fromIntegral (findIndices f (B.unpack x))+  , testProperty "findIndices ==" $+    \(toElem -> c) x -> B.findIndices (== c) x === fmap fromIntegral (findIndices (== c) (B.unpack x))++  , testProperty "elem" $+    \(toElem -> c) x -> B.elem c x === elem c (B.unpack x)+  , testProperty "not elem" $+    \(toElem -> c) x -> not (B.elem c x) === notElem c (B.unpack x)+  , testProperty "elemIndex" $+    \(toElem -> c) x -> B.elemIndex c x === fmap fromIntegral (elemIndex c (B.unpack x))+  , testProperty "elemIndices" $+    \(toElem -> c) x -> B.elemIndices c x === fmap fromIntegral (elemIndices c (B.unpack x))++  , testProperty "isPrefixOf" $+    \x y -> B.isPrefixOf x y === isPrefixOf (B.unpack x) (B.unpack y)+  , testProperty "stripPrefix" $+    \x y -> fmap B.unpack (B.stripPrefix x y) === stripPrefix (B.unpack x) (B.unpack y)+  , testProperty "isSuffixOf" $+    \x y -> B.isSuffixOf x y === isSuffixOf (B.unpack x) (B.unpack y)+  , testProperty "stripSuffix" $+    \x y -> fmap B.unpack (B.stripSuffix x y) === stripSuffix (B.unpack x) (B.unpack y)+  , testProperty "isInfixOf" $+    \x y -> B.isInfixOf x y === isInfixOf (B.unpack x) (B.unpack y)++  , testProperty "map" $+    \f x -> B.unpack (B.map (toElem . f) x) === map (toElem . f) (B.unpack x)+  , testProperty "map compose" $+    \f g x -> B.map (toElem . f) (B.map (toElem . g) x) === B.map (toElem . f . toElem . g) x+  , testProperty "replicate" $+    \n (toElem -> c) -> B.unpack (B.replicate (fromIntegral n) c) === replicate n c+  , testProperty "replicate 0" $+    \(toElem -> c) -> B.unpack (B.replicate 0 c) === replicate 0 c++  , testProperty "span" $+    \f x -> (B.unpack *** B.unpack) (B.span f x) === span f (B.unpack x)+  , testProperty "span ==" $+    \(toElem -> c) x -> (B.unpack *** B.unpack) (B.span (== c) x) === span (== c) (B.unpack x)+  , testProperty "span /=" $+    \(toElem -> c) x -> (B.unpack *** B.unpack) (B.span (/= c) x) === span (/= c) (B.unpack x)+  , testProperty "spanEnd" $+    \f x -> B.spanEnd f x === swap ((B.reverse *** B.reverse) (B.span f (B.reverse x)))+  , testProperty "split" $+    \(toElem -> c) x -> map B.unpack (B.split c x) === split c (B.unpack x)+  , testProperty "split empty" $+    \(toElem -> c) -> B.split c B.empty === []+  , testProperty "splitWith" $+    \f x -> map B.unpack (B.splitWith f x) === splitWith f (B.unpack x)+  , testProperty "splitWith split" $+    \(toElem -> c) x -> B.splitWith (== c) x === B.split c x+  , testProperty "splitWith empty" $+    \f -> B.splitWith f B.empty === []+  , testProperty "splitWith length" $+    \f x -> let splits = B.splitWith f x; l1 = fromIntegral (length splits); l2 = B.length (B.filter f x) in+      (l1 == l2 || l1 == l2 + 1) && sum (map B.length splits) + l2 == B.length x+  , testProperty "splitAt" $+    \n x -> (B.unpack *** B.unpack) (B.splitAt n x) === splitAt (fromIntegral n) (B.unpack x)++  , testProperty "head" $+    \x -> not (B.null x) ==> B.head x === head (B.unpack x)+  , testProperty "last" $+    \x -> not (B.null x) ==> B.last x === last (B.unpack x)+  , testProperty "tail" $+    \x -> not (B.null x) ==> B.unpack (B.tail x) === tail (B.unpack x)+  , testProperty "tail length" $+    \x -> not (B.null x) ==> B.length x === 1 + B.length (B.tail x)+  , testProperty "init" $+    \x -> not (B.null x) ==> B.unpack (B.init x) === init (B.unpack x)+  , testProperty "init length" $+    \x -> not (B.null x) ==> B.length x === 1 + B.length (B.init x)++  , testProperty "foldl" $+    \f (toElem -> c) x -> B.foldl ((toElem .) . f) c x === foldl ((toElem .) . f) c (B.unpack x)+  , testProperty "foldl'" $+    \f (toElem -> c) x -> B.foldl' ((toElem .) . f) c x === foldl' ((toElem .) . f) c (B.unpack x)+  , testProperty "foldr" $+    \f (toElem -> c) x -> B.foldr ((toElem .) . f) c x === foldr ((toElem .) . f) c (B.unpack x)+  , testProperty "foldr'" $+    \f (toElem -> c) x -> B.foldr' ((toElem .) . f) c x === foldr' ((toElem .) . f) c (B.unpack x)++  , testProperty "foldl cons" $+    \x -> B.foldl (flip B.cons) B.empty x === B.reverse x+  , testProperty "foldr cons" $+    \x -> B.foldr B.cons B.empty x === x+  , testProperty "foldl special" $+    \x (toElem -> c) -> B.unpack (B.foldl (\acc t -> if t == c then acc else B.cons t acc) B.empty x) ===+      foldl (\acc t -> if t == c then acc else t : acc) [] (B.unpack x)+  , testProperty "foldr special" $+    \x (toElem -> c) -> B.unpack (B.foldr (\t acc -> if t == c then acc else B.cons t acc) B.empty x) ===+      foldr (\t acc -> if t == c then acc else t : acc) [] (B.unpack x)++  , testProperty "foldl1" $+    \f x -> not (B.null x) ==> B.foldl1 ((toElem .) . f) x === foldl1 ((toElem .) . f) (B.unpack x)+  , testProperty "foldl1'" $+    \f x -> not (B.null x) ==> B.foldl1' ((toElem .) . f) x === foldl1' ((toElem .) . f) (B.unpack x)+  , testProperty "foldr1" $+    \f x -> not (B.null x) ==> B.foldr1 ((toElem .) . f) x === foldr1 ((toElem .) . f) (B.unpack x)+  , testProperty "foldr1'" $ -- there is not Data.List.foldr1'+    \f x -> not (B.null x) ==> B.foldr1' ((toElem .) . f) x === foldr1 ((toElem .) . f) (B.unpack x)++  , testProperty "foldl1 const" $+    \x -> not (B.null x) ==> B.foldl1 const x === B.head x+  , testProperty "foldl1 flip const" $+    \x -> not (B.null x) ==> B.foldl1 (flip const) x === B.last x+  , testProperty "foldr1 const" $+    \x -> not (B.null x) ==> B.foldr1 const x === B.head x+  , testProperty "foldr1 flip const" $+    \x -> not (B.null x) ==> B.foldr1 (flip const) x === B.last x+  , testProperty "foldl1 max" $+    \x -> not (B.null x) ==> B.foldl1 max x === B.foldl max minBound x+  , testProperty "foldr1 max" $+    \x -> not (B.null x) ==> B.foldr1 max x === B.foldr max minBound x++  , testProperty "intercalate" $+    \x ys -> B.unpack (B.intercalate x ys) === intercalate (B.unpack x) (map B.unpack ys)+  , testProperty "intercalate 'c' [x,y]" $+    \(toElem -> c) x y -> B.unpack (B.intercalate (B.singleton c) [x, y]) === intercalate [c] [B.unpack x, B.unpack y]+  , testProperty "intercalate split" $+    \(toElem -> c) x -> B.intercalate (B.singleton c) (B.split c x) === x++  , testProperty "index" $+    \(NonNegative n) x -> fromIntegral n < B.length x ==> B.index x (fromIntegral n) === B.unpack x !! n+  , testProperty "indexMaybe" $+    \(NonNegative n) x -> fromIntegral n < B.length x ==> B.indexMaybe x (fromIntegral n) === Just (B.unpack x !! n)+  , testProperty "indexMaybe Nothing" $+    \n x -> (n :: Int) < 0 || fromIntegral n >= B.length x ==> B.indexMaybe x (fromIntegral n) === Nothing+  , testProperty "!?" $+    \n x -> B.indexMaybe x (fromIntegral (n :: Int)) === x B.!? (fromIntegral n)++  , testProperty "unfoldrN" $+    \n f (toElem -> c) -> B.unpack (fst (B.unfoldrN n (fmap (first toElem) . f) c)) ===+      take (fromIntegral n) (unfoldr (fmap (first toElem) . f) c)+  , testProperty "unfoldrN replicate" $+    \n (toElem -> c) -> fst (B.unfoldrN n (\t -> Just (t, t)) c) === B.replicate n c+  , testProperty "unfoldr" $+    \n a (toElem -> c) -> B.unpack (B.unfoldr (\x -> if x <= 100 * n then Just (c, x + 1 :: Int) else Nothing) a) ===+      unfoldr (\x -> if x <= 100 * n then Just (c, x + 1) else Nothing) a++  --, testProperty "unfoldr" $+  --  \n f (toElem -> a) -> B.unpack (B.take (fromIntegral n) (B.unfoldr (fmap (first toElem) . f) a)) ===+  --    take n (unfoldr (fmap (first toElem) . f) a)+  ]++stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]+stripSuffix x y = fmap reverse (stripPrefix (reverse x) (reverse y))++split :: Eq a => a -> [a] -> [[a]]+split c = splitWith (== c)++splitWith :: (a -> Bool) -> [a] -> [[a]]+splitWith _ [] = []+splitWith f ys = go [] ys+  where+    go acc [] = [reverse acc]+    go acc (x : xs)+      | f x       = reverse acc : go [] xs+      | otherwise = go (x : acc) xs+
+ tests/Properties/ByteString/Short.hs view
@@ -0,0 +1,3 @@+{-# LANGUAGE CPP #-}+#define WORD8+#include "Common.hs"
+ tests/Properties/ByteString/Short/Word16.hs view
@@ -0,0 +1,3 @@+{-# LANGUAGE CPP #-}+#define WORD16+#include "../Common.hs"