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

{- |
    Module      :  SDP.Text.Lazy
    Copyright   :  (c) Andrey Mulik 2020
    License     :  BSD-style
    Maintainer  :  work.a.mulik@gmail.com
    Portability :  non-portable (GHC extensions)
    
    "SDP.Text.Lazy" provides @sdp@ instances for lazy 'Text'.
-}
module SDP.Text.Lazy
(
  -- * Exports
  module System.IO.Classes,
  
  module SDP.IndexedM,
  
  -- * Lazy text
  LText, Text, L.toCaseFold, L.toLower, L.toUpper, L.toTitle,
  L.fromChunks, L.toChunks, L.toStrict, L.fromStrict,
  L.foldrChunks, L.foldlChunks
)
where

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

import qualified Data.Text.Lazy.IO as IO
import qualified Data.Text.Lazy as L

import Data.Text.Lazy ( Text )
import Data.Maybe

import SDP.Templates.AnyChunks
import SDP.ByteList.IOUblist
import SDP.ByteList.STUblist

import Control.Exception.SDP

import System.IO.Classes

default ()

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

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

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

{- Nullable and Estimate instances. -}

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

instance Estimate Text
  where
    {-# INLINE (<.=>) #-}
    Text
xs <.=> :: Text -> Int -> Ordering
<.=> Int
n = Text
xs Text -> Int64 -> Ordering
`L.compareLength` Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
    
    {-# INLINE (<==>) #-}
    Text
xs <==> :: Compare Text
<==> Text
ys = Text
xs Text -> Int64 -> Ordering
`L.compareLength` Text -> Int64
L.length 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    = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> (Text -> Int64) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int64
L.length

instance Linear Text Char
  where
    uncons' :: Text -> Maybe (Char, Text)
uncons' = Text -> Maybe (Char, Text)
L.uncons
    unsnoc' :: Text -> Maybe (Text, Char)
unsnoc' = Text -> Maybe (Text, Char)
L.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)
L.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)
L.unsnoc
    single :: Char -> Text
single = Char -> Text
L.singleton
    toHead :: Char -> Text -> Text
toHead = Char -> Text -> Text
L.cons
    toLast :: Text -> Char -> Text
toLast = Text -> Char -> Text
L.snoc
    
    ++ :: Text -> Text -> Text
(++) = Text -> Text -> Text
L.append
    head :: Text -> Char
head = Text -> Char
L.head
    last :: Text -> Char
last = Text -> Char
L.last
    tail :: Text -> Text
tail = Text -> Text
L.tail
    init :: Text -> Text
init = Text -> Text
L.init
    
    !^ :: Text -> Int -> Char
(!^) Text
es = Text -> Int64 -> Char
L.index Text
es (Int64 -> Char) -> (Int -> Int64) -> Int -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    
    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 = Int64 -> Text -> Text
L.replicate (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) (Char -> Text
L.singleton Char
e)
    
    fromList :: [Char] -> Text
fromList = [Char] -> Text
L.pack
    reverse :: Text -> Text
reverse  = Text -> Text
L.reverse
    
    force :: Text -> Text
force = [Text] -> Text
L.fromChunks ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
forall l e. Linear l e => l -> l
force ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
L.toChunks
    listR :: Text -> [Char]
listR = Text -> [Char]
L.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]
L.unpack
    
    concat :: f Text -> Text
concat = [Text] -> Text
L.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
L.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
L.intersperse
    partition :: (Char -> Bool) -> Text -> (Text, Text)
partition   = (Char -> Bool) -> Text -> (Text, Text)
L.partition
    
    ofoldr :: (Int -> Char -> b -> b) -> b -> Text -> b
ofoldr Int -> Char -> b -> b
f =
      let go :: Text -> (Int, b) -> (Int, b)
go = \ Text
ch (Int
i, b
acc) -> (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
forall b i. Bordered b i => b -> Int
sizeOf Text
ch, (Int -> Char -> b -> b) -> b -> Text -> b
forall l e b. Linear l e => (Int -> e -> b -> b) -> b -> l -> b
ofoldr (Int -> Char -> b -> b
f (Int -> Char -> b -> b) -> (Int -> Int) -> Int -> Char -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i)) b
acc Text
ch)
      in  (Int, b) -> b
forall a b. (a, b) -> b
snd ((Int, b) -> b) -> (b -> Text -> (Int, b)) -> b -> Text -> b
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... (Text -> (Int, b) -> (Int, b)) -> (Int, b) -> Text -> (Int, b)
forall a. (Text -> a -> a) -> a -> Text -> a
L.foldrChunks Text -> (Int, b) -> (Int, b)
go ((Int, b) -> Text -> (Int, b))
-> (b -> (Int, b)) -> b -> Text -> (Int, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) Int
0
    
    ofoldl :: (Int -> b -> Char -> b) -> b -> Text -> b
ofoldl Int -> b -> Char -> b
f b
base Text
text =
      let go :: (Int, b) -> Text -> (Int, b)
go = \ (Int
i, b
acc) Text
ch -> (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
forall b i. Bordered b i => b -> Int
sizeOf Text
ch, (Int -> b -> Char -> b) -> b -> Text -> b
forall l e b. Linear l e => (Int -> b -> e -> b) -> b -> l -> b
ofoldl (Int -> b -> Char -> b
f (Int -> b -> Char -> b) -> (Int -> Int) -> Int -> b -> Char -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i)) b
acc Text
ch)
      in  (Int, b) -> b
forall a b. (a, b) -> b
snd ((Int, b) -> b) -> (Int, b) -> b
forall a b. (a -> b) -> a -> b
$ ((Int, b) -> Text -> (Int, b)) -> (Int, b) -> Text -> (Int, b)
forall a. (a -> Text -> a) -> a -> Text -> a
L.foldlChunks (Int, b) -> Text -> (Int, b)
go (Text -> Int
forall b i. Bordered b i => b -> i
upper Text
text, b
base) Text
text
    
    o_foldl' :: (b -> Char -> b) -> b -> Text -> b
o_foldl' = (b -> Char -> b) -> b -> Text -> b
forall b. (b -> Char -> b) -> b -> Text -> b
L.foldl'
    o_foldr :: (Char -> b -> b) -> b -> Text -> b
o_foldr  = (Char -> b -> b) -> b -> Text -> b
forall b. (Char -> b -> b) -> b -> Text -> b
L.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
L.foldl

instance Split Text Char
  where
    take :: Int -> Text -> Text
take   = Int64 -> Text -> Text
L.take     (Int64 -> Text -> Text) -> (Int -> Int64) -> Int -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    drop :: Int -> Text -> Text
drop   = Int64 -> Text -> Text
L.drop     (Int64 -> Text -> Text) -> (Int -> Int64) -> Int -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    keep :: Int -> Text -> Text
keep   = Int64 -> Text -> Text
L.takeEnd  (Int64 -> Text -> Text) -> (Int -> Int64) -> Int -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    sans :: Int -> Text -> Text
sans   = Int64 -> Text -> Text
L.dropEnd  (Int64 -> Text -> Text) -> (Int -> Int64) -> Int -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    split :: Int -> Text -> (Text, Text)
split  = Int64 -> Text -> (Text, Text)
L.splitAt  (Int64 -> Text -> (Text, Text))
-> (Int -> Int64) -> Int -> Text -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    chunks :: Int -> Text -> [Text]
chunks = Int64 -> Text -> [Text]
L.chunksOf (Int64 -> Text -> [Text])
-> (Int -> Int64) -> Int -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    
    replaceBy :: Text -> Text -> Text -> Text
replaceBy = Text -> Text -> Text -> Text
L.replace
    splitsOn :: Text -> Text -> [Text]
splitsOn  = Text -> Text -> [Text]
L.splitOn
    splitsBy :: (Char -> Bool) -> Text -> [Text]
splitsBy  = (Char -> Bool) -> Text -> [Text]
L.split
    
    justifyL :: Int -> Char -> Text -> Text
justifyL = Int64 -> Char -> Text -> Text
L.justifyLeft  (Int64 -> Char -> Text -> Text)
-> (Int -> Int64) -> Int -> Char -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    justifyR :: Int -> Char -> Text -> Text
justifyR = Int64 -> Char -> Text -> Text
L.justifyRight (Int64 -> Char -> Text -> Text)
-> (Int -> Int64) -> Int -> Char -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    
    isPrefixOf :: Text -> Text -> Bool
isPrefixOf = Text -> Text -> Bool
L.isPrefixOf
    isSuffixOf :: Text -> Text -> Bool
isSuffixOf = Text -> Text -> Bool
L.isSuffixOf
    isInfixOf :: Text -> Text -> Bool
isInfixOf  = Text -> Text -> Bool
L.isInfixOf
    
    prefix :: (Char -> Bool) -> Text -> Int
prefix Char -> Bool
p = (Char -> Int -> Int) -> Int -> Text -> Int
forall b. (Char -> b -> b) -> b -> Text -> b
L.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
L.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
L.takeWhile
    dropWhile :: (Char -> Bool) -> Text -> Text
dropWhile = (Char -> Bool) -> Text -> Text
L.dropWhile
    takeEnd :: (Char -> Bool) -> Text -> Text
takeEnd   = (Char -> Bool) -> Text -> Text
L.takeWhileEnd
    dropEnd :: (Char -> Bool) -> Text -> Text
dropEnd   = (Char -> Bool) -> Text -> Text
L.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 (STUblist s Char)
forall (m :: * -> *) v v'. Thaw m v v' => v -> m v'
thaw Text
es ST s (STUblist s Char)
-> (STUblist s Char -> ST s (STUblist s Char))
-> ST s (STUblist s Char)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (STUblist s Char -> [(Int, Char)] -> ST s (STUblist s Char)
forall (m :: * -> *) map key e.
MapM m map key e =>
map -> [(key, e)] -> m map
`overwrite` [(Int, Char)]
ascs) ST s (STUblist s Char)
-> (STUblist s Char -> ST s Text) -> ST s Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STUblist s Char -> ST s Text
forall s. STUblist s Char -> ST s Text
done
    
    .! :: Text -> Int -> Char
(.!) Text
es = Text -> Int64 -> Char
L.index Text
es (Int64 -> Char) -> (Int -> Int64) -> Int -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    
    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'
    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 (STUblist 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 (STUblist s Char)
-> (STUblist s Char -> ST s Text) -> ST s Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STUblist s Char -> ST s Text
forall s. STUblist 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 (STUblist 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 (STUblist s Char)
-> (STUblist s Char -> ST s Text) -> ST s Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STUblist s Char -> ST s Text
forall s. STUblist 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 (STUblist 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 (STUblist s Char)
-> (STUblist s Char -> ST s Text) -> ST s Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STUblist s Char -> ST s Text
forall s. STUblist s Char -> ST s Text
done

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

{- Thaw and Freeze instances. -}

instance Thaw (ST s) Text (STUblist s Char)
  where
    unsafeThaw :: Text -> ST s (STUblist s Char)
unsafeThaw = [STBytes# s Char] -> ST s (STUblist s Char)
forall (m :: * -> *) (rep :: * -> *) e.
BorderedM1 m rep Int e =>
[rep e] -> m (AnyChunks rep e)
fromChunksM ([STBytes# s Char] -> ST s (STUblist s Char))
-> (Text -> ST s [STBytes# s Char])
-> Text
-> ST s (STUblist s Char)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (Text -> ST s (STBytes# s Char))
-> [Text] -> ST s [STBytes# s Char]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> ST s (STBytes# s Char)
forall (m :: * -> *) v v'. Thaw m v v' => v -> m v'
unsafeThaw ([Text] -> ST s [STBytes# s Char])
-> (Text -> [Text]) -> Text -> ST s [STBytes# s Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
L.toChunks
    thaw :: Text -> ST s (STUblist s Char)
thaw       = [STBytes# s Char] -> ST s (STUblist s Char)
forall (m :: * -> *) (rep :: * -> *) e.
BorderedM1 m rep Int e =>
[rep e] -> m (AnyChunks rep e)
fromChunksM ([STBytes# s Char] -> ST s (STUblist s Char))
-> (Text -> ST s [STBytes# s Char])
-> Text
-> ST s (STUblist s Char)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (Text -> ST s (STBytes# s Char))
-> [Text] -> ST s [STBytes# s Char]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> ST s (STBytes# s Char)
forall (m :: * -> *) v v'. Thaw m v v' => v -> m v'
thaw       ([Text] -> ST s [STBytes# s Char])
-> (Text -> [Text]) -> Text -> ST s [STBytes# s Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
L.toChunks

instance Freeze (ST s) (STUblist s Char) Text
  where
    unsafeFreeze :: STUblist s Char -> ST s Text
unsafeFreeze = ([Text] -> Text) -> ST s [Text] -> ST s Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Text
L.fromChunks (ST s [Text] -> ST s Text)
-> (STUblist s Char -> ST s [Text]) -> STUblist s Char -> ST s Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (STBytes# s Char -> ST s Text) -> [STBytes# s Char] -> ST s [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM STBytes# s Char -> ST s Text
forall (m :: * -> *) v' v. Freeze m v' v => v' -> m v
unsafeFreeze ([STBytes# s Char] -> ST s [Text])
-> (STUblist s Char -> [STBytes# s Char])
-> STUblist s Char
-> ST s [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STUblist s Char -> [STBytes# s Char]
forall (rep :: * -> *) e. AnyChunks rep e -> [rep e]
toChunks
    freeze :: STUblist s Char -> ST s Text
freeze       = ([Text] -> Text) -> ST s [Text] -> ST s Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Text
L.fromChunks (ST s [Text] -> ST s Text)
-> (STUblist s Char -> ST s [Text]) -> STUblist s Char -> ST s Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (STBytes# s Char -> ST s Text) -> [STBytes# s Char] -> ST s [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM STBytes# s Char -> ST s Text
forall (m :: * -> *) v' v. Freeze m v' v => v' -> m v
freeze       ([STBytes# s Char] -> ST s [Text])
-> (STUblist s Char -> [STBytes# s Char])
-> STUblist s Char
-> ST s [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STUblist s Char -> [STBytes# s Char]
forall (rep :: * -> *) e. AnyChunks rep e -> [rep e]
toChunks

instance (MonadIO io) => Thaw io Text (MIOUblist io Char)
  where
    unsafeThaw :: Text -> io (MIOUblist io Char)
unsafeThaw = [MIOBytes# io Char] -> io (MIOUblist io Char)
forall (m :: * -> *) (rep :: * -> *) e.
BorderedM1 m rep Int e =>
[rep e] -> m (AnyChunks rep e)
fromChunksM ([MIOBytes# io Char] -> io (MIOUblist io Char))
-> (Text -> io [MIOBytes# io Char])
-> Text
-> io (MIOUblist io Char)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (Text -> io (MIOBytes# io Char))
-> [Text] -> io [MIOBytes# io Char]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> io (MIOBytes# io Char)
forall (m :: * -> *) v v'. Thaw m v v' => v -> m v'
unsafeThaw ([Text] -> io [MIOBytes# io Char])
-> (Text -> [Text]) -> Text -> io [MIOBytes# io Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
L.toChunks
    thaw :: Text -> io (MIOUblist io Char)
thaw       = [MIOBytes# io Char] -> io (MIOUblist io Char)
forall (m :: * -> *) (rep :: * -> *) e.
BorderedM1 m rep Int e =>
[rep e] -> m (AnyChunks rep e)
fromChunksM ([MIOBytes# io Char] -> io (MIOUblist io Char))
-> (Text -> io [MIOBytes# io Char])
-> Text
-> io (MIOUblist io Char)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (Text -> io (MIOBytes# io Char))
-> [Text] -> io [MIOBytes# io Char]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> io (MIOBytes# io Char)
forall (m :: * -> *) v v'. Thaw m v v' => v -> m v'
thaw       ([Text] -> io [MIOBytes# io Char])
-> (Text -> [Text]) -> Text -> io [MIOBytes# io Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
L.toChunks

instance (MonadIO io) => Freeze io (MIOUblist io Char) Text
  where
    unsafeFreeze :: MIOUblist io Char -> io Text
unsafeFreeze = ([Text] -> Text) -> io [Text] -> io Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Text
L.fromChunks (io [Text] -> io Text)
-> (MIOUblist io Char -> io [Text]) -> MIOUblist io Char -> io Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MIOBytes# io Char -> io Text) -> [MIOBytes# io Char] -> io [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM MIOBytes# io Char -> io Text
forall (m :: * -> *) v' v. Freeze m v' v => v' -> m v
unsafeFreeze ([MIOBytes# io Char] -> io [Text])
-> (MIOUblist io Char -> [MIOBytes# io Char])
-> MIOUblist io Char
-> io [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MIOUblist io Char -> [MIOBytes# io Char]
forall (rep :: * -> *) e. AnyChunks rep e -> [rep e]
toChunks
    freeze :: MIOUblist io Char -> io Text
freeze       = ([Text] -> Text) -> io [Text] -> io Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Text
L.fromChunks (io [Text] -> io Text)
-> (MIOUblist io Char -> io [Text]) -> MIOUblist io Char -> io Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MIOBytes# io Char -> io Text) -> [MIOBytes# io Char] -> io [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM MIOBytes# io Char -> io Text
forall (m :: * -> *) v' v. Freeze m v' v => v' -> m v
freeze       ([MIOBytes# io Char] -> io [Text])
-> (MIOUblist io Char -> [MIOBytes# io Char])
-> MIOUblist io Char
-> io [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MIOUblist io Char -> [MIOBytes# io Char]
forall (rep :: * -> *) e. AnyChunks rep e -> [rep e]
toChunks

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

{- 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

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

done :: STUblist s Char -> ST s Text
done :: STUblist s Char -> ST s Text
done =  STUblist s Char -> ST s Text
forall (m :: * -> *) v' v. Freeze m v' v => v' -> m v
freeze

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.Lazy."