{-# LANGUAGE Trustworthy, MagicHash, MultiParamTypeClasses, FlexibleInstances #-}

{- |
    Module      :  SDP.ByteString
    Copyright   :  (c) Andrey Mulik 2019
    License     :  BSD-style
    Maintainer  :  work.a.mulik@gmail.com
    Portability :  non-portable (GHC Extensions)
    
    "SDP.ByteString" provides @sdp@ instances for strict 'ByteString'.
-}
module SDP.ByteString
(
  -- * Exports
  module System.IO.Classes,
  
  module SDP.Indexed,
  module SDP.Sort,
  module SDP.Scan,
  
  -- * ByteString
  ByteString, SByteString
)
where

import Prelude ()
import SDP.SafePrelude
import SDP.SortM.Tim
import SDP.Indexed
import SDP.Sort
import SDP.Scan

import SDP.Prim.SBytes
import SDP.Bytes.ST

import Data.ByteString.Internal ( unsafeCreate )
import Data.ByteString          (  ByteString  )
import qualified Data.ByteString as B

import Data.Coerce
import Data.Maybe

import Foreign.Storable ( Storable ( poke ) )
import Foreign.Ptr      ( plusPtr )

import Control.Exception.SDP

import System.IO.Classes

default ()

--------------------------------------------------------------------------------

-- | Type synomym to avoid ambiguity.
type SByteString = ByteString

--------------------------------------------------------------------------------

{- Nullable and Estimate instances. -}

instance Nullable ByteString
  where
    lzero :: ByteString
lzero  = ByteString
B.empty
    isNull :: ByteString -> Bool
isNull = ByteString -> Bool
B.null

instance Estimate ByteString
  where
    <==> :: Compare ByteString
(<==>) = (Int -> Int -> Ordering)
-> (ByteString -> Int) -> Compare ByteString
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Int -> Int -> Ordering
forall o. Ord o => Compare o
(<=>) ByteString -> Int
forall b i. Bordered b i => b -> Int
sizeOf
    .<=. :: ByteString -> ByteString -> Bool
(.<=.) = (Int -> Int -> Bool)
-> (ByteString -> Int) -> ByteString -> ByteString -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(<=)  ByteString -> Int
forall b i. Bordered b i => b -> Int
sizeOf
    .>=. :: ByteString -> ByteString -> Bool
(.>=.) = (Int -> Int -> Bool)
-> (ByteString -> Int) -> ByteString -> ByteString -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(>=)  ByteString -> Int
forall b i. Bordered b i => b -> Int
sizeOf
    .>. :: ByteString -> ByteString -> Bool
(.>.)  = (Int -> Int -> Bool)
-> (ByteString -> Int) -> ByteString -> ByteString -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(>)   ByteString -> Int
forall b i. Bordered b i => b -> Int
sizeOf
    .<. :: ByteString -> ByteString -> Bool
(.<.)  = (Int -> Int -> Bool)
-> (ByteString -> Int) -> ByteString -> ByteString -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(<)   ByteString -> Int
forall b i. Bordered b i => b -> Int
sizeOf
    
    <.=> :: ByteString -> Int -> Ordering
(<.=>) = Int -> Int -> Ordering
forall o. Ord o => Compare o
(<=>) (Int -> Int -> Ordering)
-> (ByteString -> Int) -> ByteString -> Int -> Ordering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
forall b i. Bordered b i => b -> Int
sizeOf
    .>= :: ByteString -> Int -> Bool
(.>=)  = Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(>=)  (Int -> Int -> Bool)
-> (ByteString -> Int) -> ByteString -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
forall b i. Bordered b i => b -> Int
sizeOf
    .<= :: ByteString -> Int -> Bool
(.<=)  = Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(<=)  (Int -> Int -> Bool)
-> (ByteString -> Int) -> ByteString -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
forall b i. Bordered b i => b -> Int
sizeOf
    .> :: ByteString -> Int -> Bool
(.>)   = Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(>)   (Int -> Int -> Bool)
-> (ByteString -> Int) -> ByteString -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
forall b i. Bordered b i => b -> Int
sizeOf
    .< :: ByteString -> Int -> Bool
(.<)   = Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(<)   (Int -> Int -> Bool)
-> (ByteString -> Int) -> ByteString -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
forall b i. Bordered b i => b -> Int
sizeOf

--------------------------------------------------------------------------------

{- Bordered, Linear and Split instances. -}

instance Bordered ByteString Int
  where
    lower :: ByteString -> Int
lower      = Int -> ByteString -> Int
forall a b. a -> b -> a
const Int
0
    sizeOf :: ByteString -> Int
sizeOf     = ByteString -> Int
B.length
    upper :: ByteString -> Int
upper   ByteString
bs = ByteString -> Int
forall b i. Bordered b i => b -> Int
sizeOf ByteString
bs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    bounds :: ByteString -> (Int, Int)
bounds  ByteString
bs = (Int
0, ByteString -> Int
forall b i. Bordered b i => b -> Int
sizeOf ByteString
bs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    indices :: ByteString -> [Int]
indices ByteString
bs = [Int
0 .. ByteString -> Int
forall b i. Bordered b i => b -> Int
sizeOf ByteString
bs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
    indexIn :: ByteString -> Int -> Bool
indexIn ByteString
bs = \ Int
i -> Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< ByteString -> Int
forall b i. Bordered b i => b -> Int
sizeOf ByteString
bs

instance Linear ByteString Word8
  where
    single :: Word8 -> ByteString
single = Word8 -> ByteString
B.singleton
    toHead :: Word8 -> ByteString -> ByteString
toHead = Word8 -> ByteString -> ByteString
B.cons
    toLast :: ByteString -> Word8 -> ByteString
toLast = ByteString -> Word8 -> ByteString
B.snoc
    head :: ByteString -> Word8
head   = ByteString -> Word8
B.head
    tail :: ByteString -> ByteString
tail   = ByteString -> ByteString
B.tail
    last :: ByteString -> Word8
last   = ByteString -> Word8
B.last
    init :: ByteString -> ByteString
init   = ByteString -> ByteString
B.init
    
    uncons' :: ByteString -> Maybe (Word8, ByteString)
uncons' = ByteString -> Maybe (Word8, ByteString)
B.uncons
    unsnoc' :: ByteString -> Maybe (ByteString, Word8)
unsnoc' = ByteString -> Maybe (ByteString, Word8)
B.unsnoc
    
    uncons :: ByteString -> (Word8, ByteString)
uncons = (Word8, ByteString)
-> Maybe (Word8, ByteString) -> (Word8, ByteString)
forall a. a -> Maybe a -> a
fromMaybe (String -> (Word8, ByteString)
forall a. String -> a
pfailEx String
"uncons") (Maybe (Word8, ByteString) -> (Word8, ByteString))
-> (ByteString -> Maybe (Word8, ByteString))
-> ByteString
-> (Word8, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Word8, ByteString)
B.uncons
    unsnoc :: ByteString -> (ByteString, Word8)
unsnoc = (ByteString, Word8)
-> Maybe (ByteString, Word8) -> (ByteString, Word8)
forall a. a -> Maybe a -> a
fromMaybe (String -> (ByteString, Word8)
forall a. String -> a
pfailEx String
"unsnoc") (Maybe (ByteString, Word8) -> (ByteString, Word8))
-> (ByteString -> Maybe (ByteString, Word8))
-> ByteString
-> (ByteString, Word8)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (ByteString, Word8)
B.unsnoc
    
    fromFoldable :: f Word8 -> ByteString
fromFoldable f Word8
es = Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate (f Word8 -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length f Word8
es) Ptr Word8 -> IO ()
fromFoldable'
      where
        fromFoldable' :: Ptr Word8 -> IO ()
fromFoldable' Ptr Word8
ptr = IO (Ptr Word8) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Ptr Word8) -> IO ()) -> IO (Ptr Word8) -> IO ()
forall a b. (a -> b) -> a -> b
$ (Word8 -> IO (Ptr Word8) -> IO (Ptr Word8))
-> IO (Ptr Word8) -> f Word8 -> IO (Ptr Word8)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Word8 -> IO (Ptr Word8) -> IO (Ptr Word8)
forall a b. Storable a => a -> IO (Ptr a) -> IO (Ptr b)
pokeNext (Ptr Word8 -> IO (Ptr Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Word8
ptr) f Word8
es
        pokeNext :: a -> IO (Ptr a) -> IO (Ptr b)
pokeNext  a
e   IO (Ptr a)
mp  = do Ptr a
p <- IO (Ptr a)
mp; Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
p a
e; Ptr b -> IO (Ptr b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr b -> IO (Ptr b)) -> Ptr b -> IO (Ptr b)
forall a b. (a -> b) -> a -> b
$ Ptr a
p Ptr a -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1
    
    listR :: ByteString -> [Word8]
listR = \ ByteString
bs -> let n :: Int
n = ByteString -> Int
forall b i. Bordered b i => b -> Int
sizeOf ByteString
bs in [ ByteString
bs ByteString -> Int -> Word8
forall map key e. Map map key e => map -> key -> e
.! Int
i | Int
i <- [Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2 .. Int
0] ]
    listL :: ByteString -> [Word8]
listL = ByteString -> [Word8]
B.unpack
    ++ :: ByteString -> ByteString -> ByteString
(++)  = ByteString -> ByteString -> ByteString
B.append
    !^ :: ByteString -> Int -> Word8
(!^)  = ByteString -> Int -> Word8
B.index
    force :: ByteString -> ByteString
force = ByteString -> ByteString
B.copy
    
    write :: ByteString -> Int -> Word8 -> ByteString
write ByteString
bs = (ByteString
bs ByteString -> [(Int, Word8)] -> ByteString
forall map key e. Map map key e => map -> [(key, e)] -> map
//) ([(Int, Word8)] -> ByteString)
-> ((Int, Word8) -> [(Int, Word8)]) -> (Int, Word8) -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Word8) -> [(Int, Word8)]
forall l e. Linear l e => e -> l
single ((Int, Word8) -> ByteString)
-> (Int -> Word8 -> (Int, Word8)) -> Int -> Word8 -> ByteString
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... (,)
    
    concat :: f ByteString -> ByteString
concat      = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> (f ByteString -> [ByteString]) -> f ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f ByteString -> [ByteString]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
    intersperse :: Word8 -> ByteString -> ByteString
intersperse = Word8 -> ByteString -> ByteString
B.intersperse
    replicate :: Int -> Word8 -> ByteString
replicate   = Int -> Word8 -> ByteString
B.replicate
    filter :: (Word8 -> Bool) -> ByteString -> ByteString
filter      = (Word8 -> Bool) -> ByteString -> ByteString
B.filter
    fromList :: [Word8] -> ByteString
fromList    = [Word8] -> ByteString
B.pack
    
    partitions :: f (Word8 -> Bool) -> ByteString -> [ByteString]
partitions f (Word8 -> Bool)
is ByteString
bs = ([Word8] -> ByteString) -> [[Word8]] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map [Word8] -> ByteString
forall l e. Linear l e => [e] -> l
fromList ([[Word8]] -> [ByteString])
-> ([Word8] -> [[Word8]]) -> [Word8] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Word8 -> Bool) -> [Word8] -> [[Word8]]
forall l e (f :: * -> *).
(Linear l e, Foldable f) =>
f (e -> Bool) -> l -> [l]
partitions f (Word8 -> Bool)
is ([Word8] -> [ByteString]) -> [Word8] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
forall l e. Linear l e => l -> [e]
listL ByteString
bs
    isSubseqOf :: ByteString -> ByteString -> Bool
isSubseqOf ByteString
xs ByteString
ys = (Word8 -> Bool) -> ByteString -> Bool
B.all (Word8 -> ByteString -> Bool
`B.elem` ByteString
ys) ByteString
xs
    
    nub :: ByteString -> ByteString
nub ByteString
bs = (forall s. ST s ByteString) -> ByteString
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ByteString) -> ByteString)
-> (forall s. ST s ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ do
        AnyBorder (STBytes# s) Word8 Bool
hs <- Int -> Bool -> ST s (AnyBorder (STBytes# s) Word8 Bool)
forall (m :: * -> *) l e. LinearM m l e => Int -> e -> m l
filled Int
256 Bool
False
        (Word8 -> ST s () -> ST s ()) -> ST s () -> ByteString -> ST s ()
forall l e b. Linear l e => (e -> b -> b) -> b -> l -> b
o_foldr (\ Word8
b ST s ()
io -> AnyBorder (STBytes# s) Word8 Bool -> Word8 -> Bool -> ST s ()
forall (m :: * -> *) v i e. IndexedM m v i e => v -> i -> e -> m ()
writeM' AnyBorder (STBytes# s) Word8 Bool
hs Word8
b Bool
True ST s () -> ST s () -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ST s ()
io) (() -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ByteString
bs
        AnyBorder (STBytes# s) Word8 Bool -> ST s ByteString
forall s. STBytes s Word8 Bool -> ST s ByteString
done' AnyBorder (STBytes# s) Word8 Bool
hs
      where
        done' :: STBytes s Word8 Bool -> ST s ByteString
        done' :: STBytes s Word8 Bool -> ST s ByteString
done' =  ([Word8] -> ByteString) -> ST s [Word8] -> ST s ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Word8] -> ByteString
forall l e. Linear l e => [e] -> l
fromList (ST s [Word8] -> ST s ByteString)
-> (STBytes s Word8 Bool -> ST s [Word8])
-> STBytes s Word8 Bool
-> ST s ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool -> [Word8] -> ST s [Word8])
-> [Word8] -> STBytes s Word8 Bool -> ST s [Word8]
forall (m :: * -> *) map key e acc.
MapM m map key e =>
(key -> e -> acc -> m acc) -> acc -> map -> m acc
kfoldrM (\ Word8
i Bool
b [Word8]
is -> [Word8] -> ST s [Word8]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Word8] -> ST s [Word8]) -> [Word8] -> ST s [Word8]
forall a b. (a -> b) -> a -> b
$ Bool
b Bool -> [Word8] -> [Word8] -> [Word8]
forall a. Bool -> a -> a -> a
? (Word8
i Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: [Word8]
is) ([Word8] -> [Word8]) -> [Word8] -> [Word8]
forall a b. (a -> b) -> a -> b
$ [Word8]
is) []
    
    nubBy :: Equal Word8 -> ByteString -> ByteString
nubBy Equal Word8
f = [Word8] -> ByteString
forall l e. Linear l e => [e] -> l
fromList ([Word8] -> ByteString)
-> (ByteString -> [Word8]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> [Word8] -> [Word8]) -> [Word8] -> ByteString -> [Word8]
forall l e b. Linear l e => (e -> b -> b) -> b -> l -> b
o_foldr (\ Word8
b [Word8]
es -> (Word8 -> Bool) -> [Word8] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Equal Word8
f Word8
b) [Word8]
es Bool -> [Word8] -> [Word8] -> [Word8]
forall a. Bool -> a -> a -> a
? [Word8]
es ([Word8] -> [Word8]) -> [Word8] -> [Word8]
forall a b. (a -> b) -> a -> b
$ Word8
b Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: [Word8]
es) [] (ByteString -> [Word8])
-> (ByteString -> ByteString) -> ByteString -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall l e. (Linear l e, Eq e) => l -> l
nub
    
    ofoldr :: (Int -> Word8 -> b -> b) -> b -> ByteString -> b
ofoldr Int -> Word8 -> b -> b
f = \ b
base ByteString
bs ->
      let n :: Int
n = ByteString -> Int
forall b i. Bordered b i => b -> Int
sizeOf ByteString
bs; go :: Int -> b
go Int
i = Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i Bool -> b -> b -> b
forall a. Bool -> a -> a -> a
? b
base (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> b -> b
f Int
i (ByteString
bs ByteString -> Int -> Word8
forall l e. Linear l e => l -> Int -> e
!^ Int
i) (Int -> b
go (Int -> b) -> Int -> b
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      in  Int -> b
go Int
0
    
    ofoldl :: (Int -> b -> Word8 -> b) -> b -> ByteString -> b
ofoldl Int -> b -> Word8 -> b
f = \ b
base ByteString
bs ->
      let go :: Int -> b
go Int
i = -Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i Bool -> b -> b -> b
forall a. Bool -> a -> a -> a
? b
base (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ Int -> b -> Word8 -> b
f Int
i (Int -> b
go (Int -> b) -> Int -> b
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (ByteString
bs ByteString -> Int -> Word8
forall l e. Linear l e => l -> Int -> e
!^ Int
i)
      in  Int -> b
go (ByteString -> Int
forall b i. Bordered b i => b -> i
upper ByteString
bs)
    
    o_foldr :: (Word8 -> b -> b) -> b -> ByteString -> b
o_foldr = (Word8 -> b -> b) -> b -> ByteString -> b
forall b. (Word8 -> b -> b) -> b -> ByteString -> b
B.foldr
    o_foldl :: (b -> Word8 -> b) -> b -> ByteString -> b
o_foldl = (b -> Word8 -> b) -> b -> ByteString -> b
forall b. (b -> Word8 -> b) -> b -> ByteString -> b
B.foldl

instance Split ByteString Word8
  where
    take :: Int -> ByteString -> ByteString
take  = Int -> ByteString -> ByteString
B.take
    drop :: Int -> ByteString -> ByteString
drop  = Int -> ByteString -> ByteString
B.drop
    split :: Int -> ByteString -> (ByteString, ByteString)
split = Int -> ByteString -> (ByteString, ByteString)
B.splitAt
    
    isPrefixOf :: ByteString -> ByteString -> Bool
isPrefixOf = ByteString -> ByteString -> Bool
B.isPrefixOf
    isSuffixOf :: ByteString -> ByteString -> Bool
isSuffixOf = ByteString -> ByteString -> Bool
B.isSuffixOf
    isInfixOf :: ByteString -> ByteString -> Bool
isInfixOf  = ByteString -> ByteString -> Bool
B.isInfixOf
    
    takeWhile :: (Word8 -> Bool) -> ByteString -> ByteString
takeWhile = (Word8 -> Bool) -> ByteString -> ByteString
B.takeWhile
    dropWhile :: (Word8 -> Bool) -> ByteString -> ByteString
dropWhile = (Word8 -> Bool) -> ByteString -> ByteString
B.dropWhile
    
    spanl :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
spanl = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.span
    spanr :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
spanr = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.spanEnd
    
    breakl :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
breakl = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.break
    breakr :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
breakr = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.breakEnd
    
    prefix :: (Word8 -> Bool) -> ByteString -> Int
prefix Word8 -> Bool
p = (Word8 -> Int -> Int) -> Int -> ByteString -> Int
forall b. (Word8 -> b -> b) -> b -> ByteString -> b
B.foldr (\ Word8
e Int
c -> Word8 -> Bool
p Word8
e Bool -> Int -> Int -> Int
forall a. Bool -> a -> a -> a
? Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
0) Int
0
    suffix :: (Word8 -> Bool) -> ByteString -> Int
suffix Word8 -> Bool
p = (Int -> Word8 -> Int) -> Int -> ByteString -> Int
forall b. (b -> Word8 -> b) -> b -> ByteString -> b
B.foldl (\ Int
c Word8
e -> Word8 -> Bool
p Word8
e Bool -> Int -> Int -> Int
forall a. Bool -> a -> a -> a
? Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
0) Int
0

--------------------------------------------------------------------------------

{- Map and Indexed instances. -}

instance Map ByteString Int Word8
  where
    toMap :: [(Int, Word8)] -> ByteString
toMap = Word8 -> [(Int, Word8)] -> ByteString
forall map key e. Map map key e => e -> [(key, e)] -> map
toMap' Word8
0
    
    toMap' :: Word8 -> [(Int, Word8)] -> ByteString
toMap' Word8
defvalue [(Int, Word8)]
ascs = [(Int, Word8)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Word8)]
ascs Bool -> ByteString -> ByteString -> ByteString
forall a. Bool -> a -> a -> a
? ByteString
forall e. Nullable e => e
Z (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Word8 -> [(Int, Word8)] -> ByteString
forall v i e. Indexed v i e => (i, i) -> e -> [(i, e)] -> v
assoc' (Int
l, Int
u) Word8
defvalue [(Int, Word8)]
ascs
      where
        l :: Int
l = (Int, Word8) -> Int
forall a b. (a, b) -> a
fst ((Int, Word8) -> Int) -> (Int, Word8) -> Int
forall a b. (a -> b) -> a -> b
$ ((Int, Word8) -> (Int, Word8) -> Ordering)
-> [(Int, Word8)] -> (Int, Word8)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (Int, Word8) -> (Int, Word8) -> Ordering
forall o s. Ord o => Compare (o, s)
cmpfst [(Int, Word8)]
ascs
        u :: Int
u = (Int, Word8) -> Int
forall a b. (a, b) -> a
fst ((Int, Word8) -> Int) -> (Int, Word8) -> Int
forall a b. (a -> b) -> a -> b
$ ((Int, Word8) -> (Int, Word8) -> Ordering)
-> [(Int, Word8)] -> (Int, Word8)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (Int, Word8) -> (Int, Word8) -> Ordering
forall o s. Ord o => Compare (o, s)
cmpfst [(Int, Word8)]
ascs
    
    ByteString
Z  // :: ByteString -> [(Int, Word8)] -> ByteString
// [(Int, Word8)]
ascs = [(Int, Word8)] -> ByteString
forall map key e. Map map key e => [(key, e)] -> map
toMap [(Int, Word8)]
ascs
    ByteString
es // [(Int, Word8)]
ascs = (Int, Int) -> [(Int, Word8)] -> ByteString
forall v i e. Indexed v i e => (i, i) -> [(i, e)] -> v
assoc (ByteString -> (Int, Int)
forall b i. Bordered b i => b -> (i, i)
bounds ByteString
es) (ByteString -> [(Int, Word8)]
forall map key e. Map map key e => map -> [(key, e)]
assocs ByteString
es [(Int, Word8)] -> [(Int, Word8)] -> [(Int, Word8)]
forall l e. Linear l e => l -> l -> l
++ [(Int, Word8)]
ascs)
    
    .! :: ByteString -> Int -> Word8
(.!) = ByteString -> Int -> Word8
B.index
    .$ :: (Word8 -> Bool) -> ByteString -> Maybe Int
(.$) = (Word8 -> Bool) -> ByteString -> Maybe Int
B.findIndex
    *$ :: (Word8 -> Bool) -> ByteString -> [Int]
(*$) = (Word8 -> Bool) -> ByteString -> [Int]
B.findIndices
    
    kfoldr :: (Int -> Word8 -> b -> b) -> b -> ByteString -> b
kfoldr = (Int -> Word8 -> b -> b) -> b -> ByteString -> b
forall l e b. Linear l e => (Int -> e -> b -> b) -> b -> l -> b
ofoldr
    kfoldl :: (Int -> b -> Word8 -> b) -> b -> ByteString -> b
kfoldl = (Int -> b -> Word8 -> b) -> b -> ByteString -> b
forall l e b. Linear l e => (Int -> b -> e -> b) -> b -> l -> b
ofoldl

instance Indexed ByteString Int Word8
  where
    assoc :: (Int, Int) -> [(Int, Word8)] -> ByteString
assoc = ((Int, Int) -> Word8 -> [(Int, Word8)] -> ByteString)
-> Word8 -> (Int, Int) -> [(Int, Word8)] -> ByteString
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int, Int) -> Word8 -> [(Int, Word8)] -> ByteString
forall v i e. Indexed v i e => (i, i) -> e -> [(i, e)] -> v
assoc' Word8
0
    
    assoc' :: (Int, Int) -> Word8 -> [(Int, Word8)] -> ByteString
assoc' (Int, Int)
bnds Word8
defvalue [(Int, Word8)]
ascs = Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate Int
n Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
fromAssocIO
      where
        fromAssocIO :: Ptr a -> IO ()
fromAssocIO Ptr a
ptr = IO ()
fill IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
writeBS
          where
            writeBS :: IO ()
writeBS = [(Int, Word8)] -> ((Int, Word8) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Int, Word8)]
ies (((Int, Word8) -> IO ()) -> IO ())
-> ((Int, Word8) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$  \ (Int
i, Word8
e) -> Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr a
ptr Ptr a -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
i) Word8
e
            fill :: IO ()
fill = [Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Int
i -> Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr a
ptr Ptr a -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
i) Word8
defvalue
        
        ies :: [(Int, Word8)]
ies = [ ((Int, Int) -> Int -> Int
forall i. Index i => (i, i) -> i -> Int
offset (Int, Int)
bnds Int
i, Word8
e) | (Int
i, Word8
e) <- [(Int, Word8)]
ascs, (Int, Int) -> Int -> Bool
forall i. Index i => (i, i) -> i -> Bool
inRange (Int, Int)
bnds Int
i ]
        n :: Int
n   = (Int, Int) -> Int
forall i. Index i => (i, i) -> Int
size (Int, Int)
bnds
    
    fromIndexed :: m -> ByteString
fromIndexed m
es = let n :: Int
n = m -> Int
forall b i. Bordered b i => b -> Int
sizeOf m
es in Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate Int
n ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$
        \ Ptr Word8
ptr -> [Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Int
i -> Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
i) (m
es m -> Int -> Word8
forall l e. Linear l e => l -> Int -> e
!^ Int
i)

--------------------------------------------------------------------------------

{- Sort and Scan instances. -}

-- TODO: write counting sort.
instance Sort ByteString Word8
  where
    sortBy :: Compare Word8 -> ByteString -> ByteString
sortBy Compare Word8
f ByteString
bs = (forall s. ST s ByteString) -> ByteString
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ByteString) -> ByteString)
-> (forall s. ST s ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ do STBytes# s Word8
es' <- ByteString -> ST s (STBytes# s Word8)
forall (m :: * -> *) v v'. Thaw m v v' => v -> m v'
thaw ByteString
bs; Compare Word8 -> STBytes# s Word8 -> ST s ()
forall (m :: * -> *) v e i.
(LinearM m v e, BorderedM m v i) =>
Compare e -> v -> m ()
timSortBy Compare Word8
f STBytes# s Word8
es'; STBytes# s Word8 -> ST s ByteString
forall s. STBytes# s Word8 -> ST s ByteString
done STBytes# s Word8
es'
    
    sortedBy :: Equal Word8 -> ByteString -> Bool
sortedBy Equal Word8
f = Equal Word8 -> [Word8] -> Bool
forall s e. Sort s e => (e -> e -> Bool) -> s -> Bool
sortedBy Equal Word8
f ([Word8] -> Bool) -> (ByteString -> [Word8]) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
forall l e. Linear l e => l -> [e]
listL

instance Scan ByteString Word8

--------------------------------------------------------------------------------

{- Thaw and Freeze instances. -}

instance Thaw (ST s) ByteString (STBytes# s Word8) where thaw :: ByteString -> ST s (STBytes# s Word8)
thaw = ByteString -> ST s (STBytes# s Word8)
forall (m :: * -> *) v i e v' j.
(IndexedM m v i e, Indexed v' j e) =>
v' -> m v
fromIndexed'

instance Freeze (ST s) (STBytes# s Word8) ByteString where freeze :: STBytes# s Word8 -> ST s ByteString
freeze = STBytes# s Word8 -> ST s ByteString
forall s. STBytes# s Word8 -> ST s ByteString
done

instance (MonadIO io) => Thaw io ByteString (MIOBytes# io Word8) where thaw :: ByteString -> io (MIOBytes# io Word8)
thaw = ByteString -> io (MIOBytes# io Word8)
forall (m :: * -> *) v i e v' j.
(IndexedM m v i e, Indexed v' j e) =>
v' -> m v
fromIndexed'

instance (MonadIO io) => Freeze io (MIOBytes# io Word8) ByteString where freeze :: MIOBytes# io Word8 -> io ByteString
freeze = ST RealWorld ByteString -> io ByteString
forall (io :: * -> *) e. MonadIO io => ST RealWorld e -> io e
stToMIO (ST RealWorld ByteString -> io ByteString)
-> (MIOBytes# io Word8 -> ST RealWorld ByteString)
-> MIOBytes# io Word8
-> io ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STBytes# RealWorld Word8 -> ST RealWorld ByteString
forall s. STBytes# s Word8 -> ST s ByteString
done (STBytes# RealWorld Word8 -> ST RealWorld ByteString)
-> (MIOBytes# io Word8 -> STBytes# RealWorld Word8)
-> MIOBytes# io Word8
-> ST RealWorld ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MIOBytes# io Word8 -> STBytes# RealWorld Word8
coerce

--------------------------------------------------------------------------------

{- IsFile and IsTextFile instances. -}

instance IsFile ByteString
  where
    hGetContents :: Handle -> io ByteString
hGetContents = IO ByteString -> io ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO  (IO ByteString -> io ByteString)
-> (Handle -> IO ByteString) -> Handle -> io ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Handle -> IO ByteString
B.hGetContents
    hPutContents :: Handle -> ByteString -> io ()
hPutContents = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ())
-> (Handle -> ByteString -> IO ()) -> Handle -> ByteString -> io ()
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... Handle -> ByteString -> IO ()
B.hPut

instance IsTextFile ByteString
  where
    -- | Print bytestring and CR (0xa) character in Handle encoding.
    hPutStrLn :: Handle -> ByteString -> io ()
hPutStrLn Handle
h = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO  (IO () -> io ()) -> (ByteString -> IO ()) -> ByteString -> io ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  (IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> Char -> IO ()
forall (io :: * -> *). MonadIO io => Handle -> Char -> io ()
hPutChar Handle
h Char
'\n') (IO () -> IO ()) -> (ByteString -> IO ()) -> ByteString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> ByteString -> IO ()
forall text (io :: * -> *).
(IsTextFile text, MonadIO io) =>
Handle -> text -> io ()
hPutStr Handle
h
    hGetLine :: Handle -> io ByteString
hGetLine    = IO ByteString -> io ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO  (IO ByteString -> io ByteString)
-> (Handle -> IO ByteString) -> Handle -> io ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Handle -> IO ByteString
B.hGetLine
    hPutStr :: Handle -> ByteString -> io ()
hPutStr     = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ())
-> (Handle -> ByteString -> IO ()) -> Handle -> ByteString -> io ()
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... Handle -> ByteString -> IO ()
B.hPut

--------------------------------------------------------------------------------

done :: STBytes# s Word8 -> ST s ByteString
done :: STBytes# s Word8 -> ST s ByteString
done =  ([Word8] -> ByteString) -> ST s [Word8] -> ST s ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Word8] -> ByteString
forall l e. Linear l e => [e] -> l
fromList (ST s [Word8] -> ST s ByteString)
-> (STBytes# s Word8 -> ST s [Word8])
-> STBytes# s Word8
-> ST s ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STBytes# s Word8 -> ST s [Word8]
forall (m :: * -> *) l e. LinearM m l e => l -> m [e]
getLeft

pfailEx :: String -> a
pfailEx :: String -> a
pfailEx =  PatternMatchFail -> a
forall a e. Exception e => e -> a
throw (PatternMatchFail -> a)
-> (String -> PatternMatchFail) -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PatternMatchFail
PatternMatchFail (String -> PatternMatchFail)
-> (String -> String) -> String -> PatternMatchFail
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
"in SDP.ByteString.Lazy."