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

{- |
    Module      :  SDP.Text
    Copyright   :  (c) Andrey Mulik 2020
    License     :  BSD-style
    Maintainer  :  work.a.mulik@gmail.com
    Portability :  non-portable (GHC only)
    
    "SDP.Text" provides @sdp@ instances for strict 'Text'.
-}
module SDP.Text
(
  -- * Exports
  module System.IO.Classes,
  module SDP.IndexedM,
  
  -- * Strict text
  SText, Text, T.toCaseFold, T.toLower, T.toUpper, T.toTitle
)
where

import Prelude ()
import SDP.SafePrelude
import SDP.IndexedM

import SDP.Prim.SBytes

import Data.Text.Internal ( Text  (..) )
import Data.Text.Array    ( Array (..) )

import Data.Text.Internal.Fusion ( Stream (..), Step (..), stream )
import qualified Data.Text.IO as IO
import qualified Data.Text as T

import Data.Coerce
import Data.Maybe
import Data.Bits
import Data.Char

import GHC.Base
  (
    Char (..), Int (..),
    
    shrinkMutableByteArray#, unsafeFreezeByteArray#,
    
    uncheckedIShiftL#, word2Int#, chr#, (+#), (-#)
  )

import GHC.Word ( Word16 (..) )
import GHC.ST   ( ST (..) )

import System.IO.Classes

import Control.Exception.SDP

default ()

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

-- | 'Text' alias, may reduce ambiguity.
type SText = Text

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

{- Nullable and Estimate instances. -}

instance Nullable Text
  where
    isNull :: Text -> Bool
isNull = Text -> Bool
T.null
    lzero :: Text
lzero  = Text
T.empty

instance Estimate Text
  where
    {-# INLINE (<.=>) #-}
    <.=> :: Text -> Int -> Ordering
(<.=>) = Text -> Int -> Ordering
T.compareLength
    
    {-# INLINE (<==>) #-}
    Text
xs <==> :: Compare Text
<==> Text
ys = Text
xs Text -> Int -> Ordering
`T.compareLength` Text -> Int
forall b i. Bordered b i => b -> Int
sizeOf Text
ys

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

{- Bordered, Linear and Split instances. -}

instance Bordered Text Int
  where
    lower :: Text -> Int
lower   Text
_ = Int
0
    upper :: Text -> Int
upper  Text
ts = Text -> Int
forall b i. Bordered b i => b -> Int
sizeOf Text
ts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    bounds :: Text -> (Int, Int)
bounds Text
ts = (Int
0, Text -> Int
forall b i. Bordered b i => b -> Int
sizeOf Text
ts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    sizeOf :: Text -> Int
sizeOf    = Text -> Int
T.length

instance Linear Text Char
  where
    uncons' :: Text -> Maybe (Char, Text)
uncons' = Text -> Maybe (Char, Text)
T.uncons
    unsnoc' :: Text -> Maybe (Text, Char)
unsnoc' = Text -> Maybe (Text, Char)
T.unsnoc
    
    uncons :: Text -> (Char, Text)
uncons = (Char, Text) -> Maybe (Char, Text) -> (Char, Text)
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> (Char, Text)
forall a. [Char] -> a
pfailEx [Char]
"(:>)") (Maybe (Char, Text) -> (Char, Text))
-> (Text -> Maybe (Char, Text)) -> Text -> (Char, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (Char, Text)
T.uncons
    unsnoc :: Text -> (Text, Char)
unsnoc = (Text, Char) -> Maybe (Text, Char) -> (Text, Char)
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> (Text, Char)
forall a. [Char] -> a
pfailEx [Char]
"(:<)") (Maybe (Text, Char) -> (Text, Char))
-> (Text -> Maybe (Text, Char)) -> Text -> (Text, Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (Text, Char)
T.unsnoc
    single :: Char -> Text
single = Char -> Text
T.singleton
    toHead :: Char -> Text -> Text
toHead = Char -> Text -> Text
T.cons
    toLast :: Text -> Char -> Text
toLast = Text -> Char -> Text
T.snoc
    
    ++ :: Text -> Text -> Text
(++) = Text -> Text -> Text
T.append
    !^ :: Text -> Int -> Char
(!^) = Text -> Int -> Char
T.index
    head :: Text -> Char
head = Text -> Char
T.head
    last :: Text -> Char
last = Text -> Char
T.last
    tail :: Text -> Text
tail = Text -> Text
T.tail
    init :: Text -> Text
init = Text -> Text
T.init
    
    write :: Text -> Int -> Char -> Text
write Text
es = (Text
es Text -> [(Int, Char)] -> Text
forall map key e. Map map key e => map -> [(key, e)] -> map
//) ([(Int, Char)] -> Text)
-> ((Int, Char) -> [(Int, Char)]) -> (Int, Char) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Char) -> [(Int, Char)]
forall l e. Linear l e => e -> l
single ((Int, Char) -> Text)
-> (Int -> Char -> (Int, Char)) -> Int -> Char -> Text
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... (,)
    
    replicate :: Int -> Char -> Text
replicate Int
n Char
e = Int -> Text -> Text
T.replicate Int
n (Char -> Text
T.singleton Char
e)
    
    fromList :: [Char] -> Text
fromList = [Char] -> Text
T.pack
    reverse :: Text -> Text
reverse  = Text -> Text
T.reverse
    
    listR :: Text -> [Char]
listR = Text -> [Char]
T.unpack (Text -> [Char]) -> (Text -> Text) -> Text -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
forall l e. Linear l e => l -> l
reverse
    listL :: Text -> [Char]
listL = Text -> [Char]
T.unpack
    force :: Text -> Text
force = Text -> Text
T.copy
    
    concat :: f Text -> Text
concat = [Text] -> Text
T.concat ([Text] -> Text) -> (f Text -> [Text]) -> f Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f Text -> [Text]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
    filter :: (Char -> Bool) -> Text -> Text
filter = (Char -> Bool) -> Text -> Text
T.filter
    
    concatMap :: (a -> Text) -> f a -> Text
concatMap a -> Text
f = [Text] -> Text
forall l e (f :: * -> *). (Linear l e, Foldable f) => f l -> l
concat ([Text] -> Text) -> (f a -> [Text]) -> f a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [Text] -> [Text]) -> [Text] -> f a -> [Text]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((:) (Text -> [Text] -> [Text]) -> (a -> Text) -> a -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
f) []
    intersperse :: Char -> Text -> Text
intersperse = Char -> Text -> Text
T.intersperse
    partition :: (Char -> Bool) -> Text -> (Text, Text)
partition   = (Char -> Bool) -> Text -> (Text, Text)
T.partition
    
    ofoldr :: (Int -> Char -> b -> b) -> b -> Text -> b
ofoldr Int -> Char -> b -> b
f b
base = Stream Char -> b
fold' (Stream Char -> b) -> (Text -> Stream Char) -> Text -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Stream Char
stream
      where
        fold' :: Stream Char -> b
fold' (Stream s -> Step s Char
nxt s
s0 Size
_) = Int -> s -> b
go Int
0 s
s0
          where
            go :: Int -> s -> b
go !Int
i !s
s = case s -> Step s Char
nxt s
s of
              Yield Char
x s
s' -> Int -> Char -> b -> b
f Int
i Char
x (Int -> s -> b
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) s
s')
              Skip    s
s' -> Int -> s -> b
go Int
i s
s'
              Step s Char
Done       -> b
base
    
    ofoldl :: (Int -> b -> Char -> b) -> b -> Text -> b
ofoldl Int -> b -> Char -> b
f b
base' = Stream Char -> b
fold' (Stream Char -> b) -> (Text -> Stream Char) -> Text -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Stream Char
stream
      where
        fold' :: Stream Char -> b
fold' (Stream s -> Step s Char
nxt s
s0 Size
_) = b -> Int -> s -> b
go b
base' Int
0 s
s0
          where
            go :: b -> Int -> s -> b
go b
base !Int
i !s
s = case s -> Step s Char
nxt s
s of
              Yield Char
x s
s' -> b -> Int -> s -> b
go (Int -> b -> Char -> b
f Int
i b
base Char
x) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) s
s'
              Skip    s
s' -> b -> Int -> s -> b
go b
base Int
i s
s'
              Step s Char
Done       -> b
base
    
    o_foldr :: (Char -> b -> b) -> b -> Text -> b
o_foldr = (Char -> b -> b) -> b -> Text -> b
forall b. (Char -> b -> b) -> b -> Text -> b
T.foldr
    o_foldl :: (b -> Char -> b) -> b -> Text -> b
o_foldl = (b -> Char -> b) -> b -> Text -> b
forall b. (b -> Char -> b) -> b -> Text -> b
T.foldl

instance Split Text Char
  where
    take :: Int -> Text -> Text
take  = Int -> Text -> Text
T.take
    drop :: Int -> Text -> Text
drop  = Int -> Text -> Text
T.drop
    keep :: Int -> Text -> Text
keep  = Int -> Text -> Text
T.takeEnd
    sans :: Int -> Text -> Text
sans  = Int -> Text -> Text
T.dropEnd
    split :: Int -> Text -> (Text, Text)
split = Int -> Text -> (Text, Text)
T.splitAt
    
    splitsBy :: (Char -> Bool) -> Text -> [Text]
splitsBy = (Char -> Bool) -> Text -> [Text]
T.split
    splitsOn :: Text -> Text -> [Text]
splitsOn = Text -> Text -> [Text]
T.splitOn
    
    replaceBy :: Text -> Text -> Text -> Text
replaceBy = Text -> Text -> Text -> Text
T.replace
    chunks :: Int -> Text -> [Text]
chunks    = Int -> Text -> [Text]
T.chunksOf
    
    isPrefixOf :: Text -> Text -> Bool
isPrefixOf = Text -> Text -> Bool
T.isPrefixOf
    isSuffixOf :: Text -> Text -> Bool
isSuffixOf = Text -> Text -> Bool
T.isSuffixOf
    isInfixOf :: Text -> Text -> Bool
isInfixOf  = Text -> Text -> Bool
T.isInfixOf
    
    justifyL :: Int -> Char -> Text -> Text
justifyL = Int -> Char -> Text -> Text
T.justifyLeft
    justifyR :: Int -> Char -> Text -> Text
justifyR = Int -> Char -> Text -> Text
T.justifyRight
    
    prefix :: (Char -> Bool) -> Text -> Int
prefix Char -> Bool
p = (Char -> Int -> Int) -> Int -> Text -> Int
forall b. (Char -> b -> b) -> b -> Text -> b
T.foldr (\ Char
e Int
c -> Char -> Bool
p Char
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 :: (Char -> Bool) -> Text -> Int
suffix Char -> Bool
p = (Int -> Char -> Int) -> Int -> Text -> Int
forall b. (b -> Char -> b) -> b -> Text -> b
T.foldl (\ Int
c Char
e -> Char -> Bool
p Char
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
    
    takeWhile :: (Char -> Bool) -> Text -> Text
takeWhile = (Char -> Bool) -> Text -> Text
T.takeWhile
    dropWhile :: (Char -> Bool) -> Text -> Text
dropWhile = (Char -> Bool) -> Text -> Text
T.dropWhile
    
    takeEnd :: (Char -> Bool) -> Text -> Text
takeEnd = (Char -> Bool) -> Text -> Text
T.takeWhileEnd
    dropEnd :: (Char -> Bool) -> Text -> Text
dropEnd = (Char -> Bool) -> Text -> Text
T.dropWhileEnd

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

{- Map and Indexed instances. -}

instance Map Text Int Char
  where
    toMap :: [(Int, Char)] -> Text
toMap [(Int, Char)]
ascs = [(Int, Char)] -> Bool
forall e. Nullable e => e -> Bool
isNull [(Int, Char)]
ascs Bool -> Text -> Text -> Text
forall a. Bool -> a -> a -> a
? Text
forall e. Nullable e => e
Z (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> [(Int, Char)] -> Text
forall v i e. Indexed v i e => (i, i) -> [(i, e)] -> v
assoc (Int
l, Int
u) [(Int, Char)]
ascs
      where
        l :: Int
l = (Int, Char) -> Int
forall a b. (a, b) -> a
fst ((Int, Char) -> Int) -> (Int, Char) -> Int
forall a b. (a -> b) -> a -> b
$ ((Int, Char) -> (Int, Char) -> Ordering)
-> [(Int, Char)] -> (Int, Char)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (Int, Char) -> (Int, Char) -> Ordering
forall o s. Ord o => Compare (o, s)
cmpfst [(Int, Char)]
ascs
        u :: Int
u = (Int, Char) -> Int
forall a b. (a, b) -> a
fst ((Int, Char) -> Int) -> (Int, Char) -> Int
forall a b. (a -> b) -> a -> b
$ ((Int, Char) -> (Int, Char) -> Ordering)
-> [(Int, Char)] -> (Int, Char)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (Int, Char) -> (Int, Char) -> Ordering
forall o s. Ord o => Compare (o, s)
cmpfst [(Int, Char)]
ascs
    
    toMap' :: Char -> [(Int, Char)] -> Text
toMap' Char
defvalue [(Int, Char)]
ascs = [(Int, Char)] -> Bool
forall e. Nullable e => e -> Bool
isNull [(Int, Char)]
ascs Bool -> Text -> Text -> Text
forall a. Bool -> a -> a -> a
? Text
forall e. Nullable e => e
Z (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Char -> [(Int, Char)] -> Text
forall v i e. Indexed v i e => (i, i) -> e -> [(i, e)] -> v
assoc' (Int
l, Int
u) Char
defvalue [(Int, Char)]
ascs
      where
        l :: Int
l = (Int, Char) -> Int
forall a b. (a, b) -> a
fst ((Int, Char) -> Int) -> (Int, Char) -> Int
forall a b. (a -> b) -> a -> b
$ ((Int, Char) -> (Int, Char) -> Ordering)
-> [(Int, Char)] -> (Int, Char)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (Int, Char) -> (Int, Char) -> Ordering
forall o s. Ord o => Compare (o, s)
cmpfst [(Int, Char)]
ascs
        u :: Int
u = (Int, Char) -> Int
forall a b. (a, b) -> a
fst ((Int, Char) -> Int) -> (Int, Char) -> Int
forall a b. (a -> b) -> a -> b
$ ((Int, Char) -> (Int, Char) -> Ordering)
-> [(Int, Char)] -> (Int, Char)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (Int, Char) -> (Int, Char) -> Ordering
forall o s. Ord o => Compare (o, s)
cmpfst [(Int, Char)]
ascs
    
    Text
Z  // :: Text -> [(Int, Char)] -> Text
// [(Int, Char)]
ascs = [(Int, Char)] -> Text
forall map key e. Map map key e => [(key, e)] -> map
toMap [(Int, Char)]
ascs
    Text
es // [(Int, Char)]
ascs = (forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Text) -> Text) -> (forall s. ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ Text -> ST s (STBytes# s Char)
forall (m :: * -> *) v v'. Thaw m v v' => v -> m v'
thaw Text
es ST s (STBytes# s Char)
-> (STBytes# s Char -> ST s (STBytes# s Char))
-> ST s (STBytes# s Char)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (STBytes# s Char -> [(Int, Char)] -> ST s (STBytes# s Char)
forall (m :: * -> *) map key e.
MapM m map key e =>
map -> [(key, e)] -> m map
`overwrite` [(Int, Char)]
ascs) ST s (STBytes# s Char)
-> (STBytes# s Char -> ST s Text) -> ST s Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STBytes# s Char -> ST s Text
forall s. STBytes# s Char -> ST s Text
done
    
    .! :: Text -> Int -> Char
(.!) = Text -> Int -> Char
T.index
    
    kfoldr :: (Int -> Char -> b -> b) -> b -> Text -> b
kfoldr = (Int -> Char -> b -> b) -> b -> Text -> b
forall l e b. Linear l e => (Int -> e -> b -> b) -> b -> l -> b
ofoldr
    kfoldl :: (Int -> b -> Char -> b) -> b -> Text -> b
kfoldl = (Int -> b -> Char -> b) -> b -> Text -> b
forall l e b. Linear l e => (Int -> b -> e -> b) -> b -> l -> b
ofoldl

instance Indexed Text Int Char
  where
    assoc :: (Int, Int) -> [(Int, Char)] -> Text
assoc (Int, Int)
bnds [(Int, Char)]
ascs = (forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Text) -> Text) -> (forall s. ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> [(Int, Char)] -> ST s (STBytes# s Char)
forall (m :: * -> *) v i e.
IndexedM m v i e =>
(i, i) -> [(i, e)] -> m v
fromAssocs (Int, Int)
bnds [(Int, Char)]
ascs ST s (STBytes# s Char)
-> (STBytes# s Char -> ST s Text) -> ST s Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STBytes# s Char -> ST s Text
forall s. STBytes# s Char -> ST s Text
done
    
    assoc' :: (Int, Int) -> Char -> [(Int, Char)] -> Text
assoc' (Int, Int)
bnds Char
defvalue [(Int, Char)]
ascs = (forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Text) -> Text) -> (forall s. ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Char -> [(Int, Char)] -> ST s (STBytes# s Char)
forall (m :: * -> *) v i e.
IndexedM m v i e =>
(i, i) -> e -> [(i, e)] -> m v
fromAssocs' (Int, Int)
bnds Char
defvalue [(Int, Char)]
ascs ST s (STBytes# s Char)
-> (STBytes# s Char -> ST s Text) -> ST s Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STBytes# s Char -> ST s Text
forall s. STBytes# s Char -> ST s Text
done
    
    fromIndexed :: m -> Text
fromIndexed m
es = (forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Text) -> Text) -> (forall s. ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ m -> ST s (STBytes# s Char)
forall (m :: * -> *) v i e v' j.
(IndexedM m v i e, Indexed v' j e) =>
v' -> m v
fromIndexed' m
es ST s (STBytes# s Char)
-> (STBytes# s Char -> ST s Text) -> ST s Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STBytes# s Char -> ST s Text
forall s. STBytes# s Char -> ST s Text
done

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

instance Thaw (ST s) Text (STBytes# s Char)
  where
    thaw :: Text -> ST s (STBytes# s Char)
thaw Text
es = Int -> Char -> ST s (STBytes# s Char)
forall (m :: * -> *) l e. LinearM m l e => Int -> e -> m l
filled (Text -> Int
forall b i. Bordered b i => b -> Int
sizeOf Text
es) Char
'\0' ST s (STBytes# s Char)
-> (STBytes# s Char -> ST s (STBytes# s Char))
-> ST s (STBytes# s Char)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SBytes# Word16 -> STBytes# s Char -> ST s (STBytes# s Char)
forall s.
SBytes# Word16 -> STBytes# s Char -> ST s (STBytes# s Char)
unzip# (Text -> SBytes# Word16
textRepack Text
es)

instance Freeze (ST s) (STBytes# s Char) Text
  where
    unsafeFreeze :: STBytes# s Char -> ST s Text
unsafeFreeze = STBytes# s Char -> ST s Text
forall s. STBytes# s Char -> ST s Text
zip#
    freeze :: STBytes# s Char -> ST s Text
freeze       = STBytes# s Char -> ST s (STBytes# s Char)
forall (m :: * -> *) l e. LinearM m l e => l -> m l
copied (STBytes# s Char -> ST s (STBytes# s Char))
-> (STBytes# s Char -> ST s Text) -> STBytes# s Char -> ST s Text
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> STBytes# s Char -> ST s Text
forall (m :: * -> *) v' v. Freeze m v' v => v' -> m v
unsafeFreeze

instance (MonadIO io) => Thaw io Text (MIOBytes# io Char)
  where
    unsafeThaw :: Text -> io (MIOBytes# io Char)
unsafeThaw = ST RealWorld (STBytes# RealWorld Char) -> io (MIOBytes# io Char)
forall (io :: * -> *) e.
MonadIO io =>
ST RealWorld (STBytes# RealWorld e) -> io (MIOBytes# io e)
pack' (ST RealWorld (STBytes# RealWorld Char) -> io (MIOBytes# io Char))
-> (Text -> ST RealWorld (STBytes# RealWorld Char))
-> Text
-> io (MIOBytes# io Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ST RealWorld (STBytes# RealWorld Char)
forall (m :: * -> *) v v'. Thaw m v v' => v -> m v'
unsafeThaw
    thaw :: Text -> io (MIOBytes# io Char)
thaw       = ST RealWorld (STBytes# RealWorld Char) -> io (MIOBytes# io Char)
forall (io :: * -> *) e.
MonadIO io =>
ST RealWorld (STBytes# RealWorld e) -> io (MIOBytes# io e)
pack' (ST RealWorld (STBytes# RealWorld Char) -> io (MIOBytes# io Char))
-> (Text -> ST RealWorld (STBytes# RealWorld Char))
-> Text
-> io (MIOBytes# io Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ST RealWorld (STBytes# RealWorld Char)
forall (m :: * -> *) v v'. Thaw m v v' => v -> m v'
thaw

instance (MonadIO io) => Freeze io (MIOBytes# io Char) Text
  where
    unsafeFreeze :: MIOBytes# io Char -> io Text
unsafeFreeze (MIOBytes# STBytes# RealWorld Char
es) = ST RealWorld Text -> io Text
forall (io :: * -> *) e. MonadIO io => ST RealWorld e -> io e
stToMIO (STBytes# RealWorld Char -> ST RealWorld Text
forall (m :: * -> *) v' v. Freeze m v' v => v' -> m v
unsafeFreeze STBytes# RealWorld Char
es)
    freeze :: MIOBytes# io Char -> io Text
freeze       (MIOBytes# STBytes# RealWorld Char
es) = ST RealWorld Text -> io Text
forall (io :: * -> *) e. MonadIO io => ST RealWorld e -> io e
stToMIO (STBytes# RealWorld Char -> ST RealWorld Text
forall (m :: * -> *) v' v. Freeze m v' v => v' -> m v
freeze STBytes# RealWorld Char
es)

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

{- IsFile and IsTextFile instances. -}

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

instance IsTextFile Text
  where
    hPutStrLn :: Handle -> Text -> io ()
hPutStrLn = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ())
-> (Handle -> Text -> IO ()) -> Handle -> Text -> io ()
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... Handle -> Text -> IO ()
IO.hPutStrLn
    hGetLine :: Handle -> io Text
hGetLine  = IO Text -> io Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO  (IO Text -> io Text) -> (Handle -> IO Text) -> Handle -> io Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Handle -> IO Text
IO.hGetLine
    hPutStr :: Handle -> Text -> io ()
hPutStr   = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ())
-> (Handle -> Text -> IO ()) -> Handle -> Text -> io ()
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... Handle -> Text -> IO ()
IO.hPutStr

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

{-
  Note:
  @SDP@ structures (Bytes#, Bytes, Ublist, ByteList) stores characters
  pessimistically (by 32 bit), and provides random access. @Text@ stores data
  more tightly and prefer stream access.
-}
zip# :: STBytes# s Char -> ST s Text
zip# :: STBytes# s Char -> ST s Text
zip# STBytes# s Char
es = Int -> Int -> ST s Text
go Int
o Int
o
  where
    go :: Int -> Int -> ST s Text
go Int
i j :: Int
j@(I# Int#
j#) = if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n
      then do Char
c <- STBytes# s Char
es STBytes# s Char -> Int -> ST s Char
forall (m :: * -> *) l e. LinearM m l e => l -> Int -> m e
!#> Int
i; Int
o' <- STBytes# s Word16 -> Char -> Int -> ST s Int
forall s. STBytes# s Word16 -> Char -> Int -> ST s Int
write# STBytes# s Word16
es' Char
c Int
j; Int -> Int -> ST s Text
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
o')
      
      else STRep s Text -> ST s Text
forall s a. STRep s a -> ST s a
ST (STRep s Text -> ST s Text) -> STRep s Text -> ST s Text
forall a b. (a -> b) -> a -> b
$ \ State# s
s1# -> case MutableByteArray# s -> Int# -> State# s -> State# s
forall d. MutableByteArray# d -> Int# -> State# d -> State# d
shrinkMutableByteArray# MutableByteArray# s
marr# Int#
j# State# s
s1# of
        State# s
s2# -> case MutableByteArray# s -> State# s -> (# State# s, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# s
marr# State# s
s2# of
          (# State# s
s3#, ByteArray#
text# #) -> (# State# s
s3#, Array -> Int -> Int -> Text
Text (ByteArray# -> Array
Array ByteArray#
text#) Int
0 Int
j #)
    
    marr# :: MutableByteArray# s
marr# = STBytes# s Char -> MutableByteArray# s
forall e s. Unboxed e => STBytes# s e -> MutableByteArray# s
unpackSTBytes# STBytes# s Char
es
    es' :: STBytes# s Word16
es'   = STBytes# s Char -> STBytes# s Word16
forall a b s.
(Unboxed a, Unboxed b) =>
STBytes# s a -> STBytes# s b
unsafeCoerceSTBytes# STBytes# s Char
es -- [safe]: Char => Word16
    
    o :: Int
o = Int# -> Int
I# (STBytes# s Char -> Int#
forall e s. Unboxed e => STBytes# s e -> Int#
offsetSTBytes# STBytes# s Char
es)
    n :: Int
n = STBytes# s Char -> Int
forall b i. Bordered b i => b -> Int
sizeOf STBytes# s Char
es

unzip# :: SBytes# Word16 -> STBytes# s Char -> ST s (STBytes# s Char)
unzip# :: SBytes# Word16 -> STBytes# s Char -> ST s (STBytes# s Char)
unzip# SBytes# Word16
src STBytes# s Char
marr = do Int -> Int -> ST s ()
go Int
0 Int
0; STBytes# s Char -> ST s (STBytes# s Char)
forall (m :: * -> *) a. Monad m => a -> m a
return STBytes# s Char
marr
  where
    go :: Int -> Int -> ST s ()
go Int
i Int
j = Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< SBytes# Word16 -> Int
forall b i. Bordered b i => b -> Int
sizeOf SBytes# Word16
src) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ if Word16
lo Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word16
0xD800 Bool -> Bool -> Bool
&& Word16
lo Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word16
0xDBFF
       then do STBytes# s Char -> Int -> Char -> ST s ()
forall (m :: * -> *) l e. LinearM m l e => l -> Int -> e -> m ()
writeM STBytes# s Char
marr Int
j (Word16 -> Word16 -> Char
u16c Word16
lo Word16
hi); Int -> Int -> ST s ()
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
       else do STBytes# s Char -> Int -> Char -> ST s ()
forall (m :: * -> *) l e. LinearM m l e => l -> Int -> e -> m ()
writeM STBytes# s Char
marr Int
j   (Word16 -> Char
w2c Word16
lo);   Int -> Int -> ST s ()
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      where
        lo :: Word16
lo = SBytes# Word16
src SBytes# Word16 -> Int -> Word16
forall l e. Linear l e => l -> Int -> e
!^ Int
i
        hi :: Word16
hi = SBytes# Word16
src SBytes# Word16 -> Int -> Word16
forall l e. Linear l e => l -> Int -> e
!^ (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

write# :: STBytes# s Word16 -> Char -> Int -> ST s Int
write# :: STBytes# s Word16 -> Char -> Int -> ST s Int
write# STBytes# s Word16
es Char
c Int
i = if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x10000
    then do STBytes# s Word16 -> Int -> Word16 -> ST s ()
forall (m :: * -> *) l e. LinearM m l e => l -> Int -> e -> m ()
writeM STBytes# s Word16
es Int
i Word16
c'; Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
1
    else do STBytes# s Word16 -> Int -> Word16 -> ST s ()
forall (m :: * -> *) l e. LinearM m l e => l -> Int -> e -> m ()
writeM STBytes# s Word16
es Int
i Word16
lo; STBytes# s Word16 -> Int -> Word16 -> ST s ()
forall (m :: * -> *) l e. LinearM m l e => l -> Int -> e -> m ()
writeM STBytes# s Word16
es (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word16
hi; Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
2
  where
    n :: Int
n  = Char -> Int
ord Char
c
    m :: Int
m  = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0x10000
    c' :: Word16
c' = Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
    lo :: Word16
lo = Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ (Int
m Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
10) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xD800
    hi :: Word16
hi = Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ (Int
m  Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&.  Int
0x3FF) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xDC00

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

pack' :: (MonadIO io) => ST RealWorld (STBytes# RealWorld e) -> io (MIOBytes# io e)
pack' :: ST RealWorld (STBytes# RealWorld e) -> io (MIOBytes# io e)
pack' =  ST RealWorld (MIOBytes# io e) -> io (MIOBytes# io e)
forall (io :: * -> *) e. MonadIO io => ST RealWorld e -> io e
stToMIO (ST RealWorld (MIOBytes# io e) -> io (MIOBytes# io e))
-> (ST RealWorld (STBytes# RealWorld e)
    -> ST RealWorld (MIOBytes# io e))
-> ST RealWorld (STBytes# RealWorld e)
-> io (MIOBytes# io e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ST RealWorld (STBytes# RealWorld e)
-> ST RealWorld (MIOBytes# io e)
coerce

-- Pack 'Text' as SBytes# without representation changes.
{-# INLINE textRepack #-}
textRepack :: Text -> SBytes# Word16
textRepack :: Text -> SBytes# Word16
textRepack (Text (Array ByteArray#
text#) Int
o Int
n) = Int -> SBytes# Word16 -> SBytes# Word16
forall s e. Split s e => Int -> s -> s
drop Int
o (Int -> ByteArray# -> SBytes# Word16
forall e. Unboxed e => Int -> ByteArray# -> SBytes# e
packSBytes# Int
n ByteArray#
text#)

{-# INLINE done #-}
done :: STBytes# s Char -> ST s Text
done :: STBytes# s Char -> ST s Text
done =  STBytes# s Char -> ST s Text
forall (m :: * -> *) v' v. Freeze m v' v => v' -> m v
unsafeFreeze

{-# INLINE u16c #-}
u16c :: Word16 -> Word16 -> Char
u16c :: Word16 -> Word16 -> Char
u16c (W16# Word#
a#) (W16# Word#
b#) = Char# -> Char
C# (Int# -> Char#
chr# (Int#
upper# Int# -> Int# -> Int#
+# Int#
lower# Int# -> Int# -> Int#
+# Int#
0x10000#))
  where
    !upper# :: Int#
upper# = Int# -> Int# -> Int#
uncheckedIShiftL# (Word# -> Int#
word2Int# Word#
a# Int# -> Int# -> Int#
-# Int#
0xD800#) Int#
10#
    !lower# :: Int#
lower# = Word# -> Int#
word2Int# Word#
b# Int# -> Int# -> Int#
-# Int#
0xDC00#

{-# INLINE w2c #-}
w2c :: Word16 -> Char
w2c :: Word16 -> Char
w2c (W16# Word#
w#) = Char# -> Char
C# (Int# -> Char#
chr# (Word# -> Int#
word2Int# Word#
w#))

pfailEx :: String -> a
pfailEx :: [Char] -> a
pfailEx =  PatternMatchFail -> a
forall a e. Exception e => e -> a
throw (PatternMatchFail -> a)
-> ([Char] -> PatternMatchFail) -> [Char] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> PatternMatchFail
PatternMatchFail ([Char] -> PatternMatchFail)
-> ([Char] -> [Char]) -> [Char] -> PatternMatchFail
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [Char]
showString [Char]
"in SDP.Text."