{-# LANGUAGE TypeFamilies #-}

module Data.ByteString.Tiny where

import Control.Monad
import Data.Bits
import qualified Data.ByteString as B
import Data.Char
import qualified Data.Foldable as F
import qualified Data.Vector.Generic as G
import qualified Data.Vector.Generic.Mutable as GM
import qualified Data.Vector.Unboxed as U
import qualified Data.Vector.Unboxed.Mutable as UM
import Data.Word
import GHC.Exts

{- | at most 16 bytes

>>> compare (packTBS "a") (packTBS "b")
LT
>>> compare (packTBS "a") (packTBS "ab")
LT
-}
data TinyByteString = TBS !Word64 !Word64
  deriving (TinyByteString -> TinyByteString -> Bool
(TinyByteString -> TinyByteString -> Bool)
-> (TinyByteString -> TinyByteString -> Bool) -> Eq TinyByteString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TinyByteString -> TinyByteString -> Bool
== :: TinyByteString -> TinyByteString -> Bool
$c/= :: TinyByteString -> TinyByteString -> Bool
/= :: TinyByteString -> TinyByteString -> Bool
Eq, Eq TinyByteString
Eq TinyByteString =>
(TinyByteString -> TinyByteString -> Ordering)
-> (TinyByteString -> TinyByteString -> Bool)
-> (TinyByteString -> TinyByteString -> Bool)
-> (TinyByteString -> TinyByteString -> Bool)
-> (TinyByteString -> TinyByteString -> Bool)
-> (TinyByteString -> TinyByteString -> TinyByteString)
-> (TinyByteString -> TinyByteString -> TinyByteString)
-> Ord TinyByteString
TinyByteString -> TinyByteString -> Bool
TinyByteString -> TinyByteString -> Ordering
TinyByteString -> TinyByteString -> TinyByteString
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TinyByteString -> TinyByteString -> Ordering
compare :: TinyByteString -> TinyByteString -> Ordering
$c< :: TinyByteString -> TinyByteString -> Bool
< :: TinyByteString -> TinyByteString -> Bool
$c<= :: TinyByteString -> TinyByteString -> Bool
<= :: TinyByteString -> TinyByteString -> Bool
$c> :: TinyByteString -> TinyByteString -> Bool
> :: TinyByteString -> TinyByteString -> Bool
$c>= :: TinyByteString -> TinyByteString -> Bool
>= :: TinyByteString -> TinyByteString -> Bool
$cmax :: TinyByteString -> TinyByteString -> TinyByteString
max :: TinyByteString -> TinyByteString -> TinyByteString
$cmin :: TinyByteString -> TinyByteString -> TinyByteString
min :: TinyByteString -> TinyByteString -> TinyByteString
Ord)

instance Show TinyByteString where
  show :: TinyByteString -> [Char]
show = TinyByteString -> [Char]
unpackTBS
  {-# INLINE show #-}

instance IsString TinyByteString where
  fromString :: [Char] -> TinyByteString
fromString = [Char] -> TinyByteString
packTBS
  {-# INLINE fromString #-}

toTiny :: B.ByteString -> TinyByteString
toTiny :: ByteString -> TinyByteString
toTiny ByteString
bs = Word64 -> Word64 -> TinyByteString
TBS (ByteString -> Word64
forall {a}. (Bits a, Num a) => ByteString -> a
pack ByteString
bs) (ByteString -> Word64
forall {a}. (Bits a, Num a) => ByteString -> a
pack (ByteString -> Word64) -> ByteString -> Word64
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.drop Int
8 ByteString
bs)
  where
    pack :: ByteString -> a
pack ByteString
s =
      (a -> a -> a) -> a -> [a] -> a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' a -> a -> a
forall a. Bits a => a -> a -> a
(.|.) a
0 ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$
        (Word8 -> Int -> a) -> [Word8] -> [Int] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
          (a -> Int -> a
forall a. Bits a => a -> Int -> a
unsafeShiftL (a -> Int -> a) -> (Word8 -> a) -> Word8 -> Int -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
          (ByteString -> [Word8]
B.unpack ByteString
s)
          [Int
56, Int
48, Int
40, Int
32, Int
24, Int
16, Int
8, Int
0]

{- |
>>> lengthTBS (packTBS "")
0
>>> lengthTBS (packTBS $ take 16 ['a'..])
16
-}
lengthTBS :: TinyByteString -> Int
lengthTBS :: TinyByteString -> Int
lengthTBS (TBS Word64
bs0 Word64
bs1) = Word64 -> Int
forall {b}. FiniteBits b => b -> Int
len Word64
bs0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word64 -> Int
forall {b}. FiniteBits b => b -> Int
len Word64
bs1
  where
    len :: b -> Int
len b
bs = Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftR (b -> Int
forall {b}. FiniteBits b => b -> Int
countTrailingZeros b
bs) Int
3

packTBS :: String -> TinyByteString
packTBS :: [Char] -> TinyByteString
packTBS [Char]
cs = Word64 -> Word64 -> TinyByteString
TBS ([Char] -> Word64
forall {a}. (Bits a, Num a) => [Char] -> a
pack [Char]
cs) ([Char] -> Word64
forall {a}. (Bits a, Num a) => [Char] -> a
pack ([Char] -> Word64) -> [Char] -> Word64
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
8 [Char]
cs)
  where
    pack :: [Char] -> a
pack [Char]
s =
      (a -> a -> a) -> a -> [a] -> a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' a -> a -> a
forall a. Bits a => a -> a -> a
(.|.) a
0 ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$
        (Char -> Int -> a) -> [Char] -> [Int] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
          (a -> Int -> a
forall a. Bits a => a -> Int -> a
unsafeShiftL (a -> Int -> a) -> (Char -> a) -> Char -> Int -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> a) -> (Char -> Int) -> Char -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord)
          [Char]
s
          [Int
56, Int
48, Int
40, Int
32, Int
24, Int
16, Int
8, Int
0]

unpackTBS :: TinyByteString -> String
unpackTBS :: TinyByteString -> [Char]
unpackTBS (TBS Word64
bs0 Word64
bs1) =
  (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\0') ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    Word64 -> [Char]
forall {b}. (Integral b, Bits b) => b -> [Char]
unpack Word64
bs0 [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word64 -> [Char]
forall {b}. (Integral b, Bits b) => b -> [Char]
unpack Word64
bs1
  where
    unpack :: b -> [Char]
unpack b
bs =
      (Int -> Char) -> [Int] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map
        (Int -> Char
chr (Int -> Char) -> (Int -> Int) -> Int -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (b -> Int) -> (Int -> b) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> b -> b
forall a. Bits a => a -> a -> a
.&. b
0x7f) (b -> b) -> (Int -> b) -> Int -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Int -> b
forall a. Bits a => a -> Int -> a
unsafeShiftR b
bs)
        [Int
56, Int
48, Int
40, Int
32, Int
24, Int
16, Int
8, Int
0]

newtype instance UM.MVector s TinyByteString = MV_TinyByteString (UM.MVector s Word64)
newtype instance U.Vector TinyByteString = V_TinyByteString (U.Vector Word64)

instance U.Unbox TinyByteString

instance GM.MVector UM.MVector TinyByteString where
  basicLength :: forall s. MVector s TinyByteString -> Int
basicLength (MV_TinyByteString MVector s Word64
v) = Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftR (MVector s Word64 -> Int
forall s. MVector s Word64 -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
GM.basicLength MVector s Word64
v) Int
1
  {-# INLINE basicLength #-}
  basicUnsafeSlice :: forall s.
Int -> Int -> MVector s TinyByteString -> MVector s TinyByteString
basicUnsafeSlice Int
i Int
n (MV_TinyByteString MVector s Word64
v) = MVector s Word64 -> MVector s TinyByteString
forall s. MVector s Word64 -> MVector s TinyByteString
MV_TinyByteString (MVector s Word64 -> MVector s TinyByteString)
-> MVector s Word64 -> MVector s TinyByteString
forall a b. (a -> b) -> a -> b
$ Int -> Int -> MVector s Word64 -> MVector s Word64
forall s. Int -> Int -> MVector s Word64 -> MVector s Word64
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
GM.basicUnsafeSlice (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i) (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n) MVector s Word64
v
  {-# INLINE basicUnsafeSlice #-}
  basicOverlaps :: forall s.
MVector s TinyByteString -> MVector s TinyByteString -> Bool
basicOverlaps (MV_TinyByteString MVector s Word64
v1) (MV_TinyByteString MVector s Word64
v2) = MVector s Word64 -> MVector s Word64 -> Bool
forall s. MVector s Word64 -> MVector s Word64 -> Bool
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> Bool
GM.basicOverlaps MVector s Word64
v1 MVector s Word64
v2
  {-# INLINE basicOverlaps #-}
  basicUnsafeNew :: forall s. Int -> ST s (MVector s TinyByteString)
basicUnsafeNew Int
n = MVector s Word64 -> MVector s TinyByteString
forall s. MVector s Word64 -> MVector s TinyByteString
MV_TinyByteString (MVector s Word64 -> MVector s TinyByteString)
-> ST s (MVector s Word64) -> ST s (MVector s TinyByteString)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Int -> ST s (MVector s Word64)
forall s. Int -> ST s (MVector s Word64)
forall (v :: * -> * -> *) a s. MVector v a => Int -> ST s (v s a)
GM.basicUnsafeNew (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n)
  {-# INLINE basicUnsafeNew #-}
  basicInitialize :: forall s. MVector s TinyByteString -> ST s ()
basicInitialize (MV_TinyByteString MVector s Word64
v) = MVector s Word64 -> ST s ()
forall s. MVector s Word64 -> ST s ()
forall (v :: * -> * -> *) a s. MVector v a => v s a -> ST s ()
GM.basicInitialize MVector s Word64
v
  {-# INLINE basicInitialize #-}
  basicUnsafeRead :: forall s. MVector s TinyByteString -> Int -> ST s TinyByteString
basicUnsafeRead (MV_TinyByteString MVector s Word64
v) Int
i = (Word64 -> Word64 -> TinyByteString)
-> ST s Word64 -> ST s Word64 -> ST s TinyByteString
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Word64 -> Word64 -> TinyByteString
TBS (MVector s Word64 -> Int -> ST s Word64
forall s. MVector s Word64 -> Int -> ST s Word64
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> ST s a
GM.basicUnsafeRead MVector s Word64
v (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i)) (MVector s Word64 -> Int -> ST s Word64
forall s. MVector s Word64 -> Int -> ST s Word64
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> ST s a
GM.basicUnsafeRead MVector s Word64
v (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
  {-# INLINE basicUnsafeRead #-}
  basicUnsafeWrite :: forall s.
MVector s TinyByteString -> Int -> TinyByteString -> ST s ()
basicUnsafeWrite (MV_TinyByteString MVector s Word64
v) Int
i (TBS Word64
x Word64
y) = MVector s Word64 -> Int -> Word64 -> ST s ()
forall s. MVector s Word64 -> Int -> Word64 -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> a -> ST s ()
GM.basicUnsafeWrite MVector s Word64
v (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i) Word64
x ST s () -> ST s () -> ST s ()
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector s Word64 -> Int -> Word64 -> ST s ()
forall s. MVector s Word64 -> Int -> Word64 -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> a -> ST s ()
GM.basicUnsafeWrite MVector s Word64
v (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word64
y
  {-# INLINE basicUnsafeWrite #-}
  basicClear :: forall s. MVector s TinyByteString -> ST s ()
basicClear (MV_TinyByteString MVector s Word64
v) = MVector s Word64 -> ST s ()
forall s. MVector s Word64 -> ST s ()
forall (v :: * -> * -> *) a s. MVector v a => v s a -> ST s ()
GM.basicClear MVector s Word64
v
  {-# INLINE basicClear #-}
  basicUnsafeCopy :: forall s.
MVector s TinyByteString -> MVector s TinyByteString -> ST s ()
basicUnsafeCopy (MV_TinyByteString MVector s Word64
v1) (MV_TinyByteString MVector s Word64
v2) = MVector s Word64 -> MVector s Word64 -> ST s ()
forall s. MVector s Word64 -> MVector s Word64 -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> ST s ()
GM.basicUnsafeCopy MVector s Word64
v1 MVector s Word64
v2
  {-# INLINE basicUnsafeCopy #-}
  basicUnsafeMove :: forall s.
MVector s TinyByteString -> MVector s TinyByteString -> ST s ()
basicUnsafeMove (MV_TinyByteString MVector s Word64
v1) (MV_TinyByteString MVector s Word64
v2) = MVector s Word64 -> MVector s Word64 -> ST s ()
forall s. MVector s Word64 -> MVector s Word64 -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> ST s ()
GM.basicUnsafeMove MVector s Word64
v1 MVector s Word64
v2
  {-# INLINE basicUnsafeMove #-}
  basicUnsafeGrow :: forall s.
MVector s TinyByteString -> Int -> ST s (MVector s TinyByteString)
basicUnsafeGrow (MV_TinyByteString MVector s Word64
v) Int
n = MVector s Word64 -> MVector s TinyByteString
forall s. MVector s Word64 -> MVector s TinyByteString
MV_TinyByteString (MVector s Word64 -> MVector s TinyByteString)
-> ST s (MVector s Word64) -> ST s (MVector s TinyByteString)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` MVector s Word64 -> Int -> ST s (MVector s Word64)
forall s. MVector s Word64 -> Int -> ST s (MVector s Word64)
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> ST s (v s a)
GM.basicUnsafeGrow MVector s Word64
v (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n)
  {-# INLINE basicUnsafeGrow #-}

instance G.Vector U.Vector TinyByteString where
  basicUnsafeFreeze :: forall s.
Mutable Vector s TinyByteString -> ST s (Vector TinyByteString)
basicUnsafeFreeze (MV_TinyByteString MVector s Word64
v) = Vector Word64 -> Vector TinyByteString
V_TinyByteString (Vector Word64 -> Vector TinyByteString)
-> ST s (Vector Word64) -> ST s (Vector TinyByteString)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Mutable Vector s Word64 -> ST s (Vector Word64)
forall s. Mutable Vector s Word64 -> ST s (Vector Word64)
forall (v :: * -> *) a s. Vector v a => Mutable v s a -> ST s (v a)
G.basicUnsafeFreeze MVector s Word64
Mutable Vector s Word64
v
  {-# INLINE basicUnsafeFreeze #-}
  basicUnsafeThaw :: forall s.
Vector TinyByteString -> ST s (Mutable Vector s TinyByteString)
basicUnsafeThaw (V_TinyByteString Vector Word64
v) = MVector s Word64 -> MVector s TinyByteString
forall s. MVector s Word64 -> MVector s TinyByteString
MV_TinyByteString (MVector s Word64 -> MVector s TinyByteString)
-> ST s (MVector s Word64) -> ST s (MVector s TinyByteString)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Vector Word64 -> ST s (Mutable Vector s Word64)
forall s. Vector Word64 -> ST s (Mutable Vector s Word64)
forall (v :: * -> *) a s. Vector v a => v a -> ST s (Mutable v s a)
G.basicUnsafeThaw Vector Word64
v
  {-# INLINE basicUnsafeThaw #-}
  basicLength :: Vector TinyByteString -> Int
basicLength (V_TinyByteString Vector Word64
v) = Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftR (Vector Word64 -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
G.basicLength Vector Word64
v) Int
1
  {-# INLINE basicLength #-}
  basicUnsafeSlice :: Int -> Int -> Vector TinyByteString -> Vector TinyByteString
basicUnsafeSlice Int
i Int
n (V_TinyByteString Vector Word64
v) = Vector Word64 -> Vector TinyByteString
V_TinyByteString (Vector Word64 -> Vector TinyByteString)
-> Vector Word64 -> Vector TinyByteString
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Vector Word64 -> Vector Word64
forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
G.basicUnsafeSlice (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i) (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n) Vector Word64
v
  {-# INLINE basicUnsafeSlice #-}
  basicUnsafeIndexM :: Vector TinyByteString -> Int -> Box TinyByteString
basicUnsafeIndexM (V_TinyByteString Vector Word64
v) Int
i = (Word64 -> Word64 -> TinyByteString)
-> Box Word64 -> Box Word64 -> Box TinyByteString
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Word64 -> Word64 -> TinyByteString
TBS (Vector Word64 -> Int -> Box Word64
forall (v :: * -> *) a. Vector v a => v a -> Int -> Box a
G.basicUnsafeIndexM Vector Word64
v (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i)) (Vector Word64 -> Int -> Box Word64
forall (v :: * -> *) a. Vector v a => v a -> Int -> Box a
G.basicUnsafeIndexM Vector Word64
v (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
  {-# INLINE basicUnsafeIndexM #-}
  basicUnsafeCopy :: forall s.
Mutable Vector s TinyByteString -> Vector TinyByteString -> ST s ()
basicUnsafeCopy (MV_TinyByteString MVector s Word64
mv) (V_TinyByteString Vector Word64
v) = Mutable Vector s Word64 -> Vector Word64 -> ST s ()
forall s. Mutable Vector s Word64 -> Vector Word64 -> ST s ()
forall (v :: * -> *) a s.
Vector v a =>
Mutable v s a -> v a -> ST s ()
G.basicUnsafeCopy MVector s Word64
Mutable Vector s Word64
mv Vector Word64
v
  elemseq :: forall b. Vector TinyByteString -> TinyByteString -> b -> b
elemseq Vector TinyByteString
_ = TinyByteString -> b -> b
forall a b. a -> b -> b
seq
  {-# INLINE elemseq #-}