-- |
-- Module      : Basement.String
-- License     : BSD-style
-- Maintainer  : Foundation
--
-- A String type backed by a UTF8 encoded byte array and all the necessary
-- functions to manipulate the string.
--
{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MagicHash                  #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE CPP                        #-}
module Basement.UTF8.Base
    where

import           GHC.ST (ST, runST)
import           GHC.Types
import           GHC.Word
import           GHC.Prim
import           GHC.Exts (build)
import           Basement.Compat.Base
import           Basement.Numerical.Additive
import           Basement.Compat.Bifunctor
import           Basement.NormalForm
import           Basement.Types.OffsetSize
import           Basement.PrimType
import           Basement.Monad
import           Basement.FinalPtr
import           Basement.UTF8.Helper
import           Basement.UTF8.Types
import qualified Basement.Alg.UTF8         as UTF8
import           Basement.UArray           (UArray)
import           Basement.Block            (MutableBlock)
import qualified Basement.Block.Mutable    as BLK
import qualified Basement.UArray           as Vec
import qualified Basement.UArray           as C
import qualified Basement.UArray.Mutable   as MVec
import           Basement.UArray.Base   as Vec (offset, pureST, onBackend, ValidRange(..), offsetsValidRange)
import           GHC.CString                        (unpackCString#, unpackCStringUtf8#)

import           Data.Data
import           Basement.Compat.ExtList as List
import           Basement.Compat.Semigroup (Semigroup)

-- | Opaque packed array of characters in the UTF8 encoding
newtype String = String (UArray Word8)
    deriving (Typeable, NonEmpty String -> String
String -> String -> String
(String -> String -> String)
-> (NonEmpty String -> String)
-> (forall b. Integral b => b -> String -> String)
-> Semigroup String
forall b. Integral b => b -> String -> String
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: String -> String -> String
<> :: String -> String -> String
$csconcat :: NonEmpty String -> String
sconcat :: NonEmpty String -> String
$cstimes :: forall b. Integral b => b -> String -> String
stimes :: forall b. Integral b => b -> String -> String
Semigroup, Semigroup String
String
Semigroup String =>
String
-> (String -> String -> String)
-> ([String] -> String)
-> Monoid String
[String] -> String
String -> String -> String
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: String
mempty :: String
$cmappend :: String -> String -> String
mappend :: String -> String -> String
$cmconcat :: [String] -> String
mconcat :: [String] -> String
Monoid, String -> String -> Bool
(String -> String -> Bool)
-> (String -> String -> Bool) -> Eq String
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: String -> String -> Bool
== :: String -> String -> Bool
$c/= :: String -> String -> Bool
/= :: String -> String -> Bool
Eq, Eq String
Eq String =>
(String -> String -> Ordering)
-> (String -> String -> Bool)
-> (String -> String -> Bool)
-> (String -> String -> Bool)
-> (String -> String -> Bool)
-> (String -> String -> String)
-> (String -> String -> String)
-> Ord String
String -> String -> Bool
String -> String -> Ordering
String -> String -> String
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 :: String -> String -> Ordering
compare :: String -> String -> Ordering
$c< :: String -> String -> Bool
< :: String -> String -> Bool
$c<= :: String -> String -> Bool
<= :: String -> String -> Bool
$c> :: String -> String -> Bool
> :: String -> String -> Bool
$c>= :: String -> String -> Bool
>= :: String -> String -> Bool
$cmax :: String -> String -> String
max :: String -> String -> String
$cmin :: String -> String -> String
min :: String -> String -> String
Ord)

-- | Mutable String Buffer.
--
-- Use as an *append* buffer, as UTF8 variable encoding
-- doesn't really allow to change previously written
-- character without potentially shifting bytes.
newtype MutableString st = MutableString (MVec.MUArray Word8 st)
    deriving (Typeable)

instance Show String where
    show :: String -> String
show = ShowS
forall a. Show a => a -> String
show ShowS -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> String
sToList
instance IsString String where
    fromString :: String -> String
fromString = String -> String
sFromList
instance IsList String where
    type Item String = Char
    fromList :: [Item String] -> String
fromList = String -> String
[Item String] -> String
sFromList
    toList :: String -> [Item String]
toList = String -> String
String -> [Item String]
sToList

instance Data String where
    toConstr :: String -> Constr
toConstr String
s   = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
stringType (String -> String
forall a. Show a => a -> String
show String
s) [] Fixity
Prefix
    dataTypeOf :: String -> DataType
dataTypeOf String
_ = DataType
stringType
    gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c String
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
_  = String -> Constr -> c String
forall a. HasCallStack => String -> a
error String
"gunfold"

instance NormalForm String where
    toNormalForm :: String -> ()
toNormalForm (String UArray Word8
ba) = UArray Word8 -> ()
forall a. NormalForm a => a -> ()
toNormalForm UArray Word8
ba

stringType :: DataType
stringType :: DataType
stringType = String -> DataType
mkNoRepType String
"Foundation.String"

-- | size in bytes.
--
-- this size is available in o(1)
size :: String -> CountOf Word8
size :: String -> CountOf Word8
size (String UArray Word8
ba) = UArray Word8 -> CountOf Word8
forall ty. UArray ty -> CountOf ty
Vec.length UArray Word8
ba

-- | Convert a String to a list of characters
--
-- The list is lazily created as evaluation needed
sToList :: String -> [Char]
sToList :: String -> String
sToList (String UArray Word8
arr) = (Block Word8 -> String)
-> (FinalPtr Word8 -> Ptr Word8 -> ST Any String)
-> UArray Word8
-> String
forall ty a s.
(Block ty -> a)
-> (FinalPtr ty -> Ptr ty -> ST s a) -> UArray ty -> a
Vec.onBackend Block Word8 -> String
onBA FinalPtr Word8 -> Ptr Word8 -> ST Any String
onAddr UArray Word8
arr
  where
    (Vec.ValidRange !Offset Word8
start !Offset Word8
end) = UArray Word8 -> ValidRange Word8
forall ty. UArray ty -> ValidRange ty
Vec.offsetsValidRange UArray Word8
arr
    onBA :: Block Word8 -> String
onBA ba :: Block Word8
ba@(BLK.Block ByteArray#
_) = Offset Word8 -> String
loop Offset Word8
start
      where
        loop :: Offset Word8 -> String
loop !Offset Word8
idx
            | Offset Word8
idx Offset Word8 -> Offset Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Offset Word8
end = []
            | Bool
otherwise  = let !(Step Char
c Offset Word8
idx') = Block Word8 -> Offset Word8 -> Step
forall container.
Indexable container Word8 =>
container -> Offset Word8 -> Step
UTF8.next Block Word8
ba Offset Word8
idx in Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: Offset Word8 -> String
loop Offset Word8
idx'
    onAddr :: FinalPtr Word8 -> Ptr Word8 -> ST Any String
onAddr FinalPtr Word8
fptr ptr :: Ptr Word8
ptr@(Ptr Addr#
_) = String -> ST Any String
forall a s. a -> ST s a
pureST (Offset Word8 -> String
loop Offset Word8
start)
      where
        loop :: Offset Word8 -> String
loop !Offset Word8
idx
            | Offset Word8
idx Offset Word8 -> Offset Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Offset Word8
end = []
            | Bool
otherwise  = let !(Step Char
c Offset Word8
idx') = Ptr Word8 -> Offset Word8 -> Step
forall container.
Indexable container Word8 =>
container -> Offset Word8 -> Step
UTF8.next Ptr Word8
ptr Offset Word8
idx in Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: Offset Word8 -> String
loop Offset Word8
idx'
{-# NOINLINE sToList #-}

sToListStream :: String -> (Char -> a -> a) -> a -> a
sToListStream (String UArray Word8
arr) Char -> a -> a
k a
z = (Block Word8 -> a)
-> (FinalPtr Word8 -> Ptr Word8 -> ST Any a) -> UArray Word8 -> a
forall ty a s.
(Block ty -> a)
-> (FinalPtr ty -> Ptr ty -> ST s a) -> UArray ty -> a
Vec.onBackend Block Word8 -> a
onBA FinalPtr Word8 -> Ptr Word8 -> ST Any a
onAddr UArray Word8
arr
  where
    (Vec.ValidRange !Offset Word8
start !Offset Word8
end) = UArray Word8 -> ValidRange Word8
forall ty. UArray ty -> ValidRange ty
Vec.offsetsValidRange UArray Word8
arr
    onBA :: Block Word8 -> a
onBA ba :: Block Word8
ba@(BLK.Block ByteArray#
_) = Offset Word8 -> a
loop Offset Word8
start
      where
        loop :: Offset Word8 -> a
loop !Offset Word8
idx
            | Offset Word8
idx Offset Word8 -> Offset Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Offset Word8
end = a
z
            | Bool
otherwise  = let !(Step Char
c Offset Word8
idx') = Block Word8 -> Offset Word8 -> Step
forall container.
Indexable container Word8 =>
container -> Offset Word8 -> Step
UTF8.next Block Word8
ba Offset Word8
idx in Char
c Char -> a -> a
`k` Offset Word8 -> a
loop Offset Word8
idx'
    onAddr :: FinalPtr Word8 -> Ptr Word8 -> ST Any a
onAddr FinalPtr Word8
fptr ptr :: Ptr Word8
ptr@(Ptr Addr#
_) = a -> ST Any a
forall a s. a -> ST s a
pureST (Offset Word8 -> a
loop Offset Word8
start)
      where
        loop :: Offset Word8 -> a
loop !Offset Word8
idx
            | Offset Word8
idx Offset Word8 -> Offset Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Offset Word8
end = a
z
            | Bool
otherwise  = let !(Step Char
c Offset Word8
idx') = Ptr Word8 -> Offset Word8 -> Step
forall container.
Indexable container Word8 =>
container -> Offset Word8 -> Step
UTF8.next Ptr Word8
ptr Offset Word8
idx in Char
c Char -> a -> a
`k` Offset Word8 -> a
loop Offset Word8
idx'

{-# RULES "String sToList" [~1] forall s . sToList s = build (\ k z -> sToListStream s k z) #-}
{-# RULES "String toList" [~1] forall s . toList s = build (\ k z -> sToListStream s k z) #-}

{-# RULES "String sFromList" forall s .  sFromList (unpackCString# s) = fromModified s #-}
{-# RULES "String sFromList" forall s .  sFromList (unpackCStringUtf8# s) = fromModified s #-}

-- | assuming the given Addr# is a valid modified UTF-8 sequence of bytes
--
-- We only modify the given Unicode Null-character (0xC080) into a null bytes
--
-- FIXME: need to evaluate the kind of modified UTF8 GHC is actually expecting
-- it is plausible they only handle the Null Bytes, which this function actually
-- does.
fromModified :: Addr# -> String
fromModified :: Addr# -> String
fromModified Addr#
addr = CountOf Word8 -> Offset Word8 -> String
countAndCopy CountOf Word8
0 Offset Word8
0
  where
    countAndCopy :: CountOf Word8 -> Offset Word8 -> String
    countAndCopy :: CountOf Word8 -> Offset Word8 -> String
countAndCopy CountOf Word8
count Offset Word8
ofs =
        case Addr# -> Offset Word8 -> Word8
forall ty. PrimType ty => Addr# -> Offset ty -> ty
primAddrIndex Addr#
addr Offset Word8
ofs of
            Word8
0x00 -> (forall s. ST s String) -> String
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s String) -> String)
-> (forall s. ST s String) -> String
forall a b. (a -> b) -> a -> b
$ do
                        MUArray Word8 s
mb <- CountOf Word8
-> (MutableBlock Word8 (PrimState (ST s)) -> ST s ())
-> ST s (MUArray Word8 (PrimState (ST s)))
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty
-> (MutableBlock ty (PrimState prim) -> prim ())
-> prim (MUArray ty (PrimState prim))
MVec.newNative_ CountOf Word8
count (CountOf Word8 -> MutableBlock Word8 s -> ST s ()
forall st. CountOf Word8 -> MutableBlock Word8 st -> ST st ()
copy CountOf Word8
count)
                        UArray Word8 -> String
String (UArray Word8 -> String) -> ST s (UArray Word8) -> ST s String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MUArray Word8 (PrimState (ST s)) -> ST s (UArray Word8)
forall (prim :: * -> *) ty.
PrimMonad prim =>
MUArray ty (PrimState prim) -> prim (UArray ty)
Vec.unsafeFreeze MUArray Word8 s
MUArray Word8 (PrimState (ST s))
mb
            Word8
0xC0 -> case Addr# -> Offset Word8 -> Word8
forall ty. PrimType ty => Addr# -> Offset ty -> ty
primAddrIndex Addr#
addr (Offset Word8
ofsOffset Word8 -> Offset Word8 -> Offset Word8
forall a. Additive a => a -> a -> a
+Offset Word8
1) of
                        Word8
0x80 -> CountOf Word8 -> Offset Word8 -> String
countAndCopy (CountOf Word8
countCountOf Word8 -> CountOf Word8 -> CountOf Word8
forall a. Additive a => a -> a -> a
+CountOf Word8
1) (Offset Word8
ofsOffset Word8 -> Offset Word8 -> Offset Word8
forall a. Additive a => a -> a -> a
+Offset Word8
2)
                        Word8
_    -> CountOf Word8 -> Offset Word8 -> String
countAndCopy (CountOf Word8
countCountOf Word8 -> CountOf Word8 -> CountOf Word8
forall a. Additive a => a -> a -> a
+CountOf Word8
2) (Offset Word8
ofsOffset Word8 -> Offset Word8 -> Offset Word8
forall a. Additive a => a -> a -> a
+Offset Word8
2)
            Word8
_    -> CountOf Word8 -> Offset Word8 -> String
countAndCopy (CountOf Word8
countCountOf Word8 -> CountOf Word8 -> CountOf Word8
forall a. Additive a => a -> a -> a
+CountOf Word8
1) (Offset Word8
ofsOffset Word8 -> Offset Word8 -> Offset Word8
forall a. Additive a => a -> a -> a
+Offset Word8
1)

    copy :: CountOf Word8 -> MutableBlock Word8 st -> ST st ()
    copy :: forall st. CountOf Word8 -> MutableBlock Word8 st -> ST st ()
copy CountOf Word8
count MutableBlock Word8 st
mba = Offset Word8 -> Offset Word8 -> ST st ()
loop Offset Word8
0 Offset Word8
0
      where loop :: Offset Word8 -> Offset Word8 -> ST st ()
loop Offset Word8
o Offset Word8
i
                | Offset Word8
o Offset Word8 -> CountOf Word8 -> Bool
forall ty. Offset ty -> CountOf ty -> Bool
.==# CountOf Word8
count = () -> ST st ()
forall a. a -> ST st a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                | Bool
otherwise    =
                    case Addr# -> Offset Word8 -> Word8
forall ty. PrimType ty => Addr# -> Offset ty -> ty
primAddrIndex Addr#
addr Offset Word8
i of
                        Word8
0xC0 -> case Addr# -> Offset Word8 -> Word8
forall ty. PrimType ty => Addr# -> Offset ty -> ty
primAddrIndex Addr#
addr (Offset Word8
iOffset Word8 -> Offset Word8 -> Offset Word8
forall a. Additive a => a -> a -> a
+Offset Word8
1) of
                                    Word8
0x80 -> MutableBlock Word8 (PrimState (ST st))
-> Offset Word8 -> Word8 -> ST st ()
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
BLK.unsafeWrite MutableBlock Word8 st
MutableBlock Word8 (PrimState (ST st))
mba Offset Word8
o Word8
0x00 ST st () -> ST st () -> ST st ()
forall a b. ST st a -> ST st b -> ST st b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Offset Word8 -> Offset Word8 -> ST st ()
loop (Offset Word8
oOffset Word8 -> Offset Word8 -> Offset Word8
forall a. Additive a => a -> a -> a
+Offset Word8
1) (Offset Word8
iOffset Word8 -> Offset Word8 -> Offset Word8
forall a. Additive a => a -> a -> a
+Offset Word8
2)
                                    Word8
b2   -> MutableBlock Word8 (PrimState (ST st))
-> Offset Word8 -> Word8 -> ST st ()
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
BLK.unsafeWrite MutableBlock Word8 st
MutableBlock Word8 (PrimState (ST st))
mba Offset Word8
o Word8
0xC0 ST st () -> ST st () -> ST st ()
forall a b. ST st a -> ST st b -> ST st b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MutableBlock Word8 (PrimState (ST st))
-> Offset Word8 -> Word8 -> ST st ()
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
BLK.unsafeWrite MutableBlock Word8 st
MutableBlock Word8 (PrimState (ST st))
mba (Offset Word8
oOffset Word8 -> Offset Word8 -> Offset Word8
forall a. Additive a => a -> a -> a
+Offset Word8
1) Word8
b2 ST st () -> ST st () -> ST st ()
forall a b. ST st a -> ST st b -> ST st b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Offset Word8 -> Offset Word8 -> ST st ()
loop (Offset Word8
oOffset Word8 -> Offset Word8 -> Offset Word8
forall a. Additive a => a -> a -> a
+Offset Word8
2) (Offset Word8
iOffset Word8 -> Offset Word8 -> Offset Word8
forall a. Additive a => a -> a -> a
+Offset Word8
2)
                        Word8
b1   -> MutableBlock Word8 (PrimState (ST st))
-> Offset Word8 -> Word8 -> ST st ()
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
BLK.unsafeWrite MutableBlock Word8 st
MutableBlock Word8 (PrimState (ST st))
mba Offset Word8
o Word8
b1 ST st () -> ST st () -> ST st ()
forall a b. ST st a -> ST st b -> ST st b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Offset Word8 -> Offset Word8 -> ST st ()
loop (Offset Word8
oOffset Word8 -> Offset Word8 -> Offset Word8
forall a. Additive a => a -> a -> a
+Offset Word8
1) (Offset Word8
iOffset Word8 -> Offset Word8 -> Offset Word8
forall a. Additive a => a -> a -> a
+Offset Word8
1)


-- | Create a new String from a list of characters
--
-- The list is strictly and fully evaluated before
-- creating the new String, as the size need to be
-- computed before filling.
sFromList :: [Char] -> String
sFromList :: String -> String
sFromList String
l = (forall s. ST s String) -> String
forall a. (forall s. ST s a) -> a
runST (CountOf Word8 -> ST s (MutableString (PrimState (ST s)))
forall (prim :: * -> *).
PrimMonad prim =>
CountOf Word8 -> prim (MutableString (PrimState prim))
new CountOf Word8
bytes ST s (MutableString s)
-> (MutableString s -> ST s String) -> ST s String
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MutableString s -> ST s String
MutableString (PrimState (ST s)) -> ST s String
forall st. MutableString (PrimState (ST st)) -> ST st String
startCopy)
  where
    -- count how many bytes
    !bytes :: CountOf Word8
bytes = [CountOf Word8] -> CountOf Word8
forall n. Additive n => [n] -> n
List.sum ([CountOf Word8] -> CountOf Word8)
-> [CountOf Word8] -> CountOf Word8
forall a b. (a -> b) -> a -> b
$ (Char -> CountOf Word8) -> String -> [CountOf Word8]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> CountOf Word8
charToBytes (Int -> CountOf Word8) -> (Char -> Int) -> Char -> CountOf Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum) String
l

    startCopy :: MutableString (PrimState (ST st)) -> ST st String
    startCopy :: forall st. MutableString (PrimState (ST st)) -> ST st String
startCopy MutableString (PrimState (ST st))
ms = Offset Word8 -> String -> ST st String
loop Offset Word8
0 String
l
      where
        loop :: Offset Word8 -> String -> ST st String
loop Offset Word8
_   []     = MutableString (PrimState (ST st)) -> ST st String
forall (prim :: * -> *).
PrimMonad prim =>
MutableString (PrimState prim) -> prim String
freeze MutableString (PrimState (ST st))
ms
        loop Offset Word8
idx (Char
c:String
xs) = MutableString (PrimState (ST st))
-> Offset Word8 -> Char -> ST st (Offset Word8)
forall (prim :: * -> *).
PrimMonad prim =>
MutableString (PrimState prim)
-> Offset Word8 -> Char -> prim (Offset Word8)
write MutableString (PrimState (ST st))
ms Offset Word8
idx Char
c ST st (Offset Word8)
-> (Offset Word8 -> ST st String) -> ST st String
forall a b. ST st a -> (a -> ST st b) -> ST st b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Offset Word8
idx' -> Offset Word8 -> String -> ST st String
loop Offset Word8
idx' String
xs
{-# INLINE [0] sFromList #-}

next :: String -> Offset8 -> Step
next :: String -> Offset Word8 -> Step
next (String UArray Word8
array) !Offset Word8
n = (Block Word8 -> Step)
-> (FinalPtr Word8 -> Ptr Word8 -> ST Any Step)
-> UArray Word8
-> Step
forall ty a s.
(Block ty -> a)
-> (FinalPtr ty -> Ptr ty -> ST s a) -> UArray ty -> a
Vec.onBackend Block Word8 -> Step
nextBA FinalPtr Word8 -> Ptr Word8 -> ST Any Step
nextAddr UArray Word8
array
  where
    !start :: Offset Word8
start = UArray Word8 -> Offset Word8
forall ty. UArray ty -> Offset ty
Vec.offset UArray Word8
array
    reoffset :: Step -> Step
reoffset (Step Char
a Offset Word8
ofs) = Char -> Offset Word8 -> Step
Step Char
a (Offset Word8
ofs Offset Word8 -> Offset Word8 -> Offset Word8
forall a. Offset a -> Offset a -> Offset a
`offsetSub` Offset Word8
start)
    nextBA :: Block Word8 -> Step
nextBA ba :: Block Word8
ba@(BLK.Block ByteArray#
_) = Step -> Step
reoffset (Block Word8 -> Offset Word8 -> Step
forall container.
Indexable container Word8 =>
container -> Offset Word8 -> Step
UTF8.next Block Word8
ba (Offset Word8
start Offset Word8 -> Offset Word8 -> Offset Word8
forall a. Additive a => a -> a -> a
+ Offset Word8
n))
    nextAddr :: FinalPtr Word8 -> Ptr Word8 -> ST Any Step
nextAddr FinalPtr Word8
_ ptr :: Ptr Word8
ptr@(Ptr Addr#
_)  = Step -> ST Any Step
forall a s. a -> ST s a
pureST (Step -> ST Any Step) -> Step -> ST Any Step
forall a b. (a -> b) -> a -> b
$ Step -> Step
reoffset (Ptr Word8 -> Offset Word8 -> Step
forall container.
Indexable container Word8 =>
container -> Offset Word8 -> Step
UTF8.next Ptr Word8
ptr (Offset Word8
start Offset Word8 -> Offset Word8 -> Offset Word8
forall a. Additive a => a -> a -> a
+ Offset Word8
n))

prev :: String -> Offset8 -> StepBack
prev :: String -> Offset Word8 -> StepBack
prev (String UArray Word8
array) !Offset Word8
n = (Block Word8 -> StepBack)
-> (FinalPtr Word8 -> Ptr Word8 -> ST Any StepBack)
-> UArray Word8
-> StepBack
forall ty a s.
(Block ty -> a)
-> (FinalPtr ty -> Ptr ty -> ST s a) -> UArray ty -> a
Vec.onBackend Block Word8 -> StepBack
prevBA FinalPtr Word8 -> Ptr Word8 -> ST Any StepBack
prevAddr UArray Word8
array
  where
    !start :: Offset Word8
start = UArray Word8 -> Offset Word8
forall ty. UArray ty -> Offset ty
Vec.offset UArray Word8
array
    reoffset :: StepBack -> StepBack
reoffset (StepBack Char
a Offset Word8
ofs) = Char -> Offset Word8 -> StepBack
StepBack Char
a (Offset Word8
ofs Offset Word8 -> Offset Word8 -> Offset Word8
forall a. Offset a -> Offset a -> Offset a
`offsetSub` Offset Word8
start)
    prevBA :: Block Word8 -> StepBack
prevBA ba :: Block Word8
ba@(BLK.Block ByteArray#
_) = StepBack -> StepBack
reoffset (Block Word8 -> Offset Word8 -> StepBack
forall container.
Indexable container Word8 =>
container -> Offset Word8 -> StepBack
UTF8.prev Block Word8
ba (Offset Word8
start Offset Word8 -> Offset Word8 -> Offset Word8
forall a. Additive a => a -> a -> a
+ Offset Word8
n))
    prevAddr :: FinalPtr Word8 -> Ptr Word8 -> ST Any StepBack
prevAddr FinalPtr Word8
_ ptr :: Ptr Word8
ptr@(Ptr Addr#
_)  = StepBack -> ST Any StepBack
forall a s. a -> ST s a
pureST (StepBack -> ST Any StepBack) -> StepBack -> ST Any StepBack
forall a b. (a -> b) -> a -> b
$ StepBack -> StepBack
reoffset (Ptr Word8 -> Offset Word8 -> StepBack
forall container.
Indexable container Word8 =>
container -> Offset Word8 -> StepBack
UTF8.prev Ptr Word8
ptr (Offset Word8
start Offset Word8 -> Offset Word8 -> Offset Word8
forall a. Additive a => a -> a -> a
+ Offset Word8
n))

-- A variant of 'next' when you want the next character
-- to be ASCII only.
nextAscii :: String -> Offset8 -> StepASCII
nextAscii :: String -> Offset Word8 -> StepASCII
nextAscii (String UArray Word8
ba) Offset Word8
n = Word8 -> StepASCII
StepASCII Word8
w
  where
    !w :: Word8
w = UArray Word8 -> Offset Word8 -> Word8
forall ty. PrimType ty => UArray ty -> Offset ty -> ty
Vec.unsafeIndex UArray Word8
ba Offset Word8
n

expectAscii :: String -> Offset8 -> Word8 -> Bool
expectAscii :: String -> Offset Word8 -> Word8 -> Bool
expectAscii (String UArray Word8
ba) Offset Word8
n Word8
v = UArray Word8 -> Offset Word8 -> Word8
forall ty. PrimType ty => UArray ty -> Offset ty -> ty
Vec.unsafeIndex UArray Word8
ba Offset Word8
n Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
v
{-# INLINE expectAscii #-}

write :: PrimMonad prim => MutableString (PrimState prim) -> Offset8 -> Char -> prim Offset8
write :: forall (prim :: * -> *).
PrimMonad prim =>
MutableString (PrimState prim)
-> Offset Word8 -> Char -> prim (Offset Word8)
write (MutableString MUArray Word8 (PrimState prim)
marray) Offset Word8
ofs Char
c =
    (MutableBlock Word8 (PrimState prim) -> prim (Offset Word8))
-> (FinalPtr Word8 -> prim (Offset Word8))
-> MUArray Word8 (PrimState prim)
-> prim (Offset Word8)
forall (prim :: * -> *) ty a.
PrimMonad prim =>
(MutableBlock ty (PrimState prim) -> prim a)
-> (FinalPtr ty -> prim a) -> MUArray ty (PrimState prim) -> prim a
MVec.onMutableBackend (\mba :: MutableBlock Word8 (PrimState prim)
mba@(BLK.MutableBlock MutableByteArray# (PrimState prim)
_) -> MutableBlock Word8 (PrimState prim)
-> Offset Word8 -> Char -> prim (Offset Word8)
forall (prim :: * -> *) container.
(PrimMonad prim, RandomAccess container prim Word8) =>
container -> Offset Word8 -> Char -> prim (Offset Word8)
UTF8.writeUTF8 MutableBlock Word8 (PrimState prim)
mba (Offset Word8
start Offset Word8 -> Offset Word8 -> Offset Word8
forall a. Additive a => a -> a -> a
+ Offset Word8
ofs) Char
c)
                          (\FinalPtr Word8
fptr -> FinalPtr Word8
-> (Ptr Word8 -> prim (Offset Word8)) -> prim (Offset Word8)
forall (prim :: * -> *) p a.
PrimMonad prim =>
FinalPtr p -> (Ptr p -> prim a) -> prim a
withFinalPtr FinalPtr Word8
fptr ((Ptr Word8 -> prim (Offset Word8)) -> prim (Offset Word8))
-> (Ptr Word8 -> prim (Offset Word8)) -> prim (Offset Word8)
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Word8
ptr@(Ptr Addr#
_) -> Ptr Word8 -> Offset Word8 -> Char -> prim (Offset Word8)
forall (prim :: * -> *) container.
(PrimMonad prim, RandomAccess container prim Word8) =>
container -> Offset Word8 -> Char -> prim (Offset Word8)
UTF8.writeUTF8 Ptr Word8
ptr (Offset Word8
start Offset Word8 -> Offset Word8 -> Offset Word8
forall a. Additive a => a -> a -> a
+ Offset Word8
ofs) Char
c)
                          MUArray Word8 (PrimState prim)
marray
  where start :: Offset Word8
start = MUArray Word8 (PrimState prim) -> Offset Word8
forall ty st. MUArray ty st -> Offset ty
MVec.mutableOffset MUArray Word8 (PrimState prim)
marray

-- | Allocate a MutableString of a specific size in bytes.
new :: PrimMonad prim
    => CountOf Word8 -- ^ in number of bytes, not of elements.
    -> prim (MutableString (PrimState prim))
new :: forall (prim :: * -> *).
PrimMonad prim =>
CountOf Word8 -> prim (MutableString (PrimState prim))
new CountOf Word8
n = MUArray Word8 (PrimState prim) -> MutableString (PrimState prim)
forall st. MUArray Word8 st -> MutableString st
MutableString (MUArray Word8 (PrimState prim) -> MutableString (PrimState prim))
-> prim (MUArray Word8 (PrimState prim))
-> prim (MutableString (PrimState prim))
forall a b. (a -> b) -> prim a -> prim b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` CountOf Word8 -> prim (MUArray Word8 (PrimState prim))
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MUArray ty (PrimState prim))
MVec.new CountOf Word8
n

newNative :: PrimMonad prim
          => CountOf Word8 -- ^ in number of bytes, not of elements.
          -> (MutableBlock Word8 (PrimState prim) -> prim a)
          -> prim (a, MutableString (PrimState prim))
newNative :: forall (prim :: * -> *) a.
PrimMonad prim =>
CountOf Word8
-> (MutableBlock Word8 (PrimState prim) -> prim a)
-> prim (a, MutableString (PrimState prim))
newNative CountOf Word8
n MutableBlock Word8 (PrimState prim) -> prim a
f = (MUArray Word8 (PrimState prim) -> MutableString (PrimState prim))
-> (a, MUArray Word8 (PrimState prim))
-> (a, MutableString (PrimState prim))
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second MUArray Word8 (PrimState prim) -> MutableString (PrimState prim)
forall st. MUArray Word8 st -> MutableString st
MutableString ((a, MUArray Word8 (PrimState prim))
 -> (a, MutableString (PrimState prim)))
-> prim (a, MUArray Word8 (PrimState prim))
-> prim (a, MutableString (PrimState prim))
forall a b. (a -> b) -> prim a -> prim b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` CountOf Word8
-> (MutableBlock Word8 (PrimState prim) -> prim a)
-> prim (a, MUArray Word8 (PrimState prim))
forall (prim :: * -> *) ty a.
(PrimMonad prim, PrimType ty) =>
CountOf ty
-> (MutableBlock ty (PrimState prim) -> prim a)
-> prim (a, MUArray ty (PrimState prim))
MVec.newNative CountOf Word8
n MutableBlock Word8 (PrimState prim) -> prim a
f

newNative_ :: PrimMonad prim
           => CountOf Word8 -- ^ in number of bytes, not of elements.
           -> (MutableBlock Word8 (PrimState prim) -> prim ())
           -> prim (MutableString (PrimState prim))
newNative_ :: forall (prim :: * -> *).
PrimMonad prim =>
CountOf Word8
-> (MutableBlock Word8 (PrimState prim) -> prim ())
-> prim (MutableString (PrimState prim))
newNative_ CountOf Word8
n MutableBlock Word8 (PrimState prim) -> prim ()
f = MUArray Word8 (PrimState prim) -> MutableString (PrimState prim)
forall st. MUArray Word8 st -> MutableString st
MutableString (MUArray Word8 (PrimState prim) -> MutableString (PrimState prim))
-> prim (MUArray Word8 (PrimState prim))
-> prim (MutableString (PrimState prim))
forall a b. (a -> b) -> prim a -> prim b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` CountOf Word8
-> (MutableBlock Word8 (PrimState prim) -> prim ())
-> prim (MUArray Word8 (PrimState prim))
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty
-> (MutableBlock ty (PrimState prim) -> prim ())
-> prim (MUArray ty (PrimState prim))
MVec.newNative_ CountOf Word8
n MutableBlock Word8 (PrimState prim) -> prim ()
f

freeze :: PrimMonad prim => MutableString (PrimState prim) -> prim String
freeze :: forall (prim :: * -> *).
PrimMonad prim =>
MutableString (PrimState prim) -> prim String
freeze (MutableString MUArray Word8 (PrimState prim)
mba) = UArray Word8 -> String
String (UArray Word8 -> String) -> prim (UArray Word8) -> prim String
forall a b. (a -> b) -> prim a -> prim b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` MUArray Word8 (PrimState prim) -> prim (UArray Word8)
forall (prim :: * -> *) ty.
PrimMonad prim =>
MUArray ty (PrimState prim) -> prim (UArray ty)
C.unsafeFreeze MUArray Word8 (PrimState prim)
mba
{-# INLINE freeze #-}

freezeShrink :: PrimMonad prim
             => CountOf Word8
             -> MutableString (PrimState prim)
             -> prim String
freezeShrink :: forall (prim :: * -> *).
PrimMonad prim =>
CountOf Word8 -> MutableString (PrimState prim) -> prim String
freezeShrink CountOf Word8
n (MutableString MUArray Word8 (PrimState prim)
mba) = UArray Word8 -> String
String (UArray Word8 -> String) -> prim (UArray Word8) -> prim String
forall a b. (a -> b) -> prim a -> prim b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` MUArray Word8 (PrimState prim)
-> CountOf Word8 -> prim (UArray Word8)
forall ty (prim :: * -> *).
(PrimType ty, PrimMonad prim) =>
MUArray ty (PrimState prim) -> CountOf ty -> prim (UArray ty)
C.unsafeFreezeShrink MUArray Word8 (PrimState prim)
mba CountOf Word8
n