{-# language BangPatterns #-}
{-# language DataKinds #-}
{-# language MagicHash #-}
{-# language UnboxedTuples #-}

module Basics.ShortTexts
  ( -- Types
    T
  , T#
  , R
    -- Lifting
  , lift
  , unlift
    -- Array
  , read#
  , write#
  , index#
  , uninitialized#
  , initialized#
  , copy#
  , copyMutable#
  , set#
  , shrink#
  , eq#
  , neq#
    -- Encode
  , shows
  ) where

import Prelude hiding (shows)

import GHC.Exts hiding (setByteArray#)
import Data.Primitive.Unlifted.Array (UnliftedArray(..))
import Data.Text.Short (ShortText)

import qualified GHC.Exts as Exts

type T = UnliftedArray ShortText
type T# = ArrayArray#
type R = 'BoxedRep 'Unlifted

lift :: T# -> T
{-# inline lift #-}
lift :: T# -> T
lift = forall a. T# -> UnliftedArray a
UnliftedArray

unlift :: T -> T#
{-# inline unlift #-}
unlift :: T -> T#
unlift (UnliftedArray T#
x) = T#
x

index# :: ArrayArray# -> Int# -> T#
{-# inline index# #-}
index# :: T# -> Int# -> T#
index# = T# -> Int# -> T#
Exts.indexArrayArrayArray#

read# :: MutableArrayArray# s -> Int# -> State# s -> (# State# s, T# #)
{-# inline read# #-}
read# :: forall s.
MutableArrayArray# s -> Int# -> State# s -> (# State# s, T# #)
read# = forall s.
MutableArrayArray# s -> Int# -> State# s -> (# State# s, T# #)
Exts.readArrayArrayArray#

write# :: MutableArrayArray# s -> Int# -> T# -> State# s -> State# s
{-# inline write# #-}
write# :: forall s.
MutableArrayArray# s -> Int# -> T# -> State# s -> State# s
write# = forall s.
MutableArrayArray# s -> Int# -> T# -> State# s -> State# s
Exts.writeArrayArrayArray#

set# :: MutableArrayArray# s -> Int# -> Int# -> T# -> State# s -> State# s
{-# inline set# #-}
set# :: forall s.
MutableArrayArray# s -> Int# -> Int# -> T# -> State# s -> State# s
set# MutableArrayArray# s
marr Int#
off Int#
len T#
x State# s
s = case Int#
len of
  Int#
0# -> State# s
s
  Int#
_ -> forall s.
MutableArrayArray# s -> Int# -> Int# -> T# -> State# s -> State# s
set# MutableArrayArray# s
marr (Int#
off Int# -> Int# -> Int#
+# Int#
1# ) (Int#
len Int# -> Int# -> Int#
-# Int#
1# ) T#
x (forall s.
MutableArrayArray# s -> Int# -> T# -> State# s -> State# s
write# MutableArrayArray# s
marr Int#
off T#
x State# s
s)

-- | This is very unsafe.
uninitialized# :: Int# -> State# s -> (# State# s, MutableArrayArray# s #)
{-# inline uninitialized# #-}
uninitialized# :: forall s. Int# -> State# s -> (# State# s, MutableArrayArray# s #)
uninitialized# = forall s. Int# -> State# s -> (# State# s, MutableArrayArray# s #)
Exts.newArrayArray#

initialized# ::
     Int# -> T# -> State# s
  -> (# State# s, MutableArrayArray# s #)
{-# inline initialized# #-}
initialized# :: forall s.
Int# -> T# -> State# s -> (# State# s, MutableArrayArray# s #)
initialized# Int#
n T#
e State# s
s0 = case forall s. Int# -> State# s -> (# State# s, MutableArrayArray# s #)
uninitialized# Int#
n State# s
s0 of
  (# State# s
s1, MutableArrayArray# s
a #) -> case forall s.
MutableArrayArray# s -> Int# -> Int# -> T# -> State# s -> State# s
set# MutableArrayArray# s
a Int#
0# Int#
n T#
e State# s
s1 of
    State# s
s2 -> (# State# s
s2, MutableArrayArray# s
a #)

copy# :: MutableArrayArray# s -> Int# -> ArrayArray# -> Int# -> Int# -> State# s -> State# s
{-# inline copy# #-}
copy# :: forall s.
MutableArrayArray# s
-> Int# -> T# -> Int# -> Int# -> State# s -> State# s
copy# MutableArrayArray# s
dst Int#
doff T#
src Int#
soff Int#
len =
  forall d.
T#
-> Int#
-> MutableArrayArray# d
-> Int#
-> Int#
-> State# d
-> State# d
Exts.copyArrayArray# T#
src Int#
soff MutableArrayArray# s
dst Int#
doff Int#
len

copyMutable# :: MutableArrayArray# s -> Int# -> MutableArrayArray# s -> Int# -> Int# -> State# s -> State# s
{-# inline copyMutable# #-}
copyMutable# :: forall s.
MutableArrayArray# s
-> Int#
-> MutableArrayArray# s
-> Int#
-> Int#
-> State# s
-> State# s
copyMutable# MutableArrayArray# s
dst Int#
doff MutableArrayArray# s
src Int#
soff Int#
len =
  forall s.
MutableArrayArray# s
-> Int#
-> MutableArrayArray# s
-> Int#
-> Int#
-> State# s
-> State# s
Exts.copyMutableArrayArray# MutableArrayArray# s
src Int#
soff MutableArrayArray# s
dst Int#
doff Int#
len

shrink# :: MutableArrayArray# s -> Int# -> State# s -> (# State# s, MutableArrayArray# s #)
{-# inline shrink# #-}
shrink# :: forall s.
MutableArrayArray# s
-> Int# -> State# s -> (# State# s, MutableArrayArray# s #)
shrink# MutableArrayArray# s
m Int#
sz State# s
s0 = case forall s. Int# -> State# s -> (# State# s, MutableArrayArray# s #)
uninitialized# Int#
sz State# s
s0 of
  (# State# s
s1, MutableArrayArray# s
dst #) -> case forall s.
MutableArrayArray# s
-> Int#
-> MutableArrayArray# s
-> Int#
-> Int#
-> State# s
-> State# s
copyMutable# MutableArrayArray# s
dst Int#
0# MutableArrayArray# s
m Int#
0# Int#
sz State# s
s1 of
    State# s
s2 -> (# State# s
s2, MutableArrayArray# s
dst #)

-- We do not forcibly inline this because it might be useful to see this
-- in profiling runs.
eq# :: ArrayArray# -> ArrayArray# -> Int#
eq# :: T# -> T# -> Int#
eq# T#
a T#
b = case Int#
lenA Int# -> Int# -> Int#
==# Int#
lenB of
  Int#
1# ->
    let go :: Int# -> Int#
go (Int#
-1#) = Int#
1#
        go Int#
ix =
          let x :: ByteArray#
x = T# -> Int# -> ByteArray#
Exts.indexByteArrayArray# T#
a Int#
ix
              y :: ByteArray#
y = T# -> Int# -> ByteArray#
Exts.indexByteArrayArray# T#
b Int#
ix
              lenX :: Int#
lenX = ByteArray# -> Int#
Exts.sizeofByteArray# ByteArray#
x
              lenY :: Int#
lenY = ByteArray# -> Int#
Exts.sizeofByteArray# ByteArray#
y
           in case Int#
lenX Int# -> Int# -> Int#
==# Int#
lenY of
                Int#
1# -> case ByteArray# -> Int# -> ByteArray# -> Int# -> Int# -> Int#
Exts.compareByteArrays# ByteArray#
x Int#
0# ByteArray#
y Int#
0# Int#
lenX of
                  Int#
0# -> Int# -> Int#
go (Int#
ix Int# -> Int# -> Int#
-# Int#
1#)
                  Int#
_ -> Int#
0#
                Int#
_ -> Int#
0#
     in Int# -> Int#
go (Int#
lenA Int# -> Int# -> Int#
-# Int#
1#)
  Int#
_ -> Int#
0#
  where
  !lenA :: Int#
lenA = T# -> Int#
Exts.sizeofArrayArray# T#
a
  !lenB :: Int#
lenB = T# -> Int#
Exts.sizeofArrayArray# T#
b

neq# :: ArrayArray# -> ArrayArray# -> Int#
{-# inline neq# #-}
neq# :: T# -> T# -> Int#
neq# T#
a T#
b = case T# -> T# -> Int#
eq# T#
a T#
b of
  Int#
1# -> Int#
0#
  Int#
_ -> Int#
1#

-- TODO: fix this
shows :: T -> String -> String
{-# inline shows #-}
shows :: T -> String -> String
shows T
_ String
s = String
"[...]" forall a. [a] -> [a] -> [a]
++ String
s