{-# LANGUAGE MultiWayIf        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns      #-}
{-# LANGUAGE Strict            #-}


-- |
-- Module      :  Data.RLE
-- Copyright   :  (c) Matthew Mosior 2022
-- License     :  BSD-style
-- Maintainer  :  mattm.github@gmail.com
-- Portability :  portable
--
-- = Run-length encoding (RLE)


module Data.RLE where

import Data.BWT
import Data.BWT.Internal 
import Data.RLE.Internal

import Control.Monad()
import Control.Monad.ST as CMST
import Control.Monad.State.Strict()
import Data.ByteString as BS
import Data.ByteString.Char8()
import Data.Char()
import Data.Foldable()
import Data.Maybe as DMaybe (isNothing,fromJust)
import Data.STRef()
import Data.Text as DText 
import Data.Text.Encoding as DTE (decodeUtf8,encodeUtf8)
import Data.Vector as DVB (Vector,empty,map,uncons)
import Data.Vector.Unboxed()
import Data.Word (Word8)
import Prelude as P


{-toRLE Function(s)-}

-- | Helper function for converting a 'ByteString'
-- to a 'RLEB' via a 'BWT' first.
bytestringToBWTToRLEB :: ByteString ->
                         RLEB
bytestringToBWTToRLEB :: ByteString -> RLEB
bytestringToBWTToRLEB = BWT Word8 -> RLEB
bytestringBWTToRLEB forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BWT Word8
bytestringToBWT

-- | Helper function for converting a 'ByteString'
-- to a 'RLET' via a 'BWT' first.
bytestringToBWTToRLET :: ByteString ->
                         RLET
bytestringToBWTToRLET :: ByteString -> RLET
bytestringToBWTToRLET = BWT Word8 -> RLET
bytestringBWTToRLET forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BWT Word8
bytestringToBWT

-- | Helper function for converting a 'Text'
-- to a 'RLEB' via a 'BWT' first.
textToBWTToRLEB :: Text ->
                   RLEB
textToBWTToRLEB :: Text -> RLEB
textToBWTToRLEB = TextBWT -> RLEB
textBWTToRLEB forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TextBWT
textToBWT

-- | Helper function for converting a 'Text'
-- to a 'RLET' via a 'BWT' first.
textToBWTToRLET :: Text ->
                   RLET
textToBWTToRLET :: Text -> RLET
textToBWTToRLET = TextBWT -> RLET
textBWTToRLET forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TextBWT
textToBWT

-- | Take a 'BWT' of 'Word8's and generate the
-- Run-length encoding ('RLEB').
textBWTToRLEB :: TextBWT
              -> RLEB
textBWTToRLEB :: TextBWT -> RLEB
textBWTToRLEB TextBWT
xs =
  Vector (Maybe ByteString) -> RLEB
RLEB (forall a. (forall s. ST s a) -> a
CMST.runST forall a b. (a -> b) -> a -> b
$ forall s.
Vector (Maybe ByteString) -> ST s (Vector (Maybe ByteString))
vecToRLEB Vector (Maybe ByteString)
xss)
    where
      xss :: Vector (Maybe ByteString)
xss = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe Word8
x -> if | forall a. Maybe a -> Bool
isNothing Maybe Word8
x
                           -> forall a. Maybe a
Nothing
                           | Bool
otherwise
                           -> forall a. a -> Maybe a
Just         forall a b. (a -> b) -> a -> b
$
                              Word8 -> ByteString
BS.singleton forall a b. (a -> b) -> a -> b
$
                              forall a. HasCallStack => Maybe a -> a
fromJust Maybe Word8
x
                 )
            ((\(BWT Vector (Maybe Word8)
t) -> Vector (Maybe Word8)
t) forall a b. (a -> b) -> a -> b
$
            ((\(TextBWT BWT Word8
t) -> BWT Word8
t) TextBWT
xs))

-- | Take a 'BWT' of 'Word8's and generate the
-- Run-length encoding ('RLEB').
bytestringBWTToRLEB :: BWT Word8
                    -> RLEB
bytestringBWTToRLEB :: BWT Word8 -> RLEB
bytestringBWTToRLEB (BWT (forall a. Vector a -> Maybe (a, Vector a)
DVB.uncons -> Maybe (Maybe Word8, Vector (Maybe Word8))
Nothing)) = Vector (Maybe ByteString) -> RLEB
RLEB forall a. Vector a
DVB.empty
bytestringBWTToRLEB BWT Word8
xs                            =
  Vector (Maybe ByteString) -> RLEB
RLEB (forall a. (forall s. ST s a) -> a
CMST.runST forall a b. (a -> b) -> a -> b
$ forall s.
Vector (Maybe ByteString) -> ST s (Vector (Maybe ByteString))
vecToRLEB Vector (Maybe ByteString)
xss)
    where
      xss :: Vector (Maybe ByteString)
xss = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe Word8
x -> if | forall a. Maybe a -> Bool
isNothing Maybe Word8
x
                           -> forall a. Maybe a
Nothing
                           | Bool
otherwise
                           -> forall a. a -> Maybe a
Just         forall a b. (a -> b) -> a -> b
$
                              Word8 -> ByteString
BS.singleton forall a b. (a -> b) -> a -> b
$
                              forall a. HasCallStack => Maybe a -> a
fromJust Maybe Word8
x
                 )
            ((\(BWT Vector (Maybe Word8)
t) -> Vector (Maybe Word8)
t) BWT Word8
xs)

-- | Take a 'BWT' of 'Word8's and generate the
-- Run-length encoding ('RLEB').
textBWTToRLET :: TextBWT
              -> RLET
textBWTToRLET :: TextBWT -> RLET
textBWTToRLET TextBWT
xs =
  Vector (Maybe Text) -> RLET
RLET (forall a. (forall s. ST s a) -> a
CMST.runST forall a b. (a -> b) -> a -> b
$ forall s. Vector (Maybe Text) -> ST s (Vector (Maybe Text))
vecToRLET Vector (Maybe Text)
xss)
    where
      xss :: Vector (Maybe Text)
xss = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe Word8
x -> if | forall a. Maybe a -> Bool
isNothing Maybe Word8
x
                           -> forall a. Maybe a
Nothing
                           | Bool
otherwise
                           -> forall a. a -> Maybe a
Just           forall a b. (a -> b) -> a -> b
$
                              ByteString -> Text
DTE.decodeUtf8 forall a b. (a -> b) -> a -> b
$
                              Word8 -> ByteString
BS.singleton   forall a b. (a -> b) -> a -> b
$
                              forall a. HasCallStack => Maybe a -> a
fromJust Maybe Word8
x
                 )
            ((\(BWT Vector (Maybe Word8)
t) -> Vector (Maybe Word8)
t) forall a b. (a -> b) -> a -> b
$
            ((\(TextBWT BWT Word8
t) -> BWT Word8
t) TextBWT
xs))

-- | Take a 'BWT' of 'Word8's and generate the
-- Run-length encoding ('RLET').
bytestringBWTToRLET :: BWT Word8
                    -> RLET
bytestringBWTToRLET :: BWT Word8 -> RLET
bytestringBWTToRLET (BWT (forall a. Vector a -> Maybe (a, Vector a)
DVB.uncons -> Maybe (Maybe Word8, Vector (Maybe Word8))
Nothing)) = Vector (Maybe Text) -> RLET
RLET forall a. Vector a
DVB.empty
bytestringBWTToRLET BWT Word8
xs                            =
  Vector (Maybe Text) -> RLET
RLET (forall a. (forall s. ST s a) -> a
CMST.runST forall a b. (a -> b) -> a -> b
$ forall s. Vector (Maybe Text) -> ST s (Vector (Maybe Text))
vecToRLET Vector (Maybe Text)
xss)
    where
      xss :: Vector (Maybe Text)
xss = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe Word8
x -> if | forall a. Maybe a -> Bool
isNothing Maybe Word8
x
                           -> forall a. Maybe a
Nothing
                           | Bool
otherwise
                           -> forall a. a -> Maybe a
Just           forall a b. (a -> b) -> a -> b
$
                              ByteString -> Text
DTE.decodeUtf8 forall a b. (a -> b) -> a -> b
$
                              Word8 -> ByteString
BS.singleton   forall a b. (a -> b) -> a -> b
$
                              forall a. HasCallStack => Maybe a -> a
fromJust Maybe Word8
x
                 )
            ((\(BWT Vector (Maybe Word8)
t) -> Vector (Maybe Word8)
t) BWT Word8
xs)

-- | Takes a 'Text' and returns the Run-length encoding ('RLEB').
textToRLEB :: DVB.Vector (Maybe Text)
           -> RLEB
textToRLEB :: Vector (Maybe Text) -> RLEB
textToRLEB (forall a. Vector a -> Maybe (a, Vector a)
DVB.uncons -> Maybe (Maybe Text, Vector (Maybe Text))
Nothing) = Vector (Maybe ByteString) -> RLEB
RLEB forall a. Vector a
DVB.empty
textToRLEB Vector (Maybe Text)
xs                      = 
  Vector (Maybe ByteString) -> RLEB
RLEB (forall a. (forall s. ST s a) -> a
CMST.runST forall a b. (a -> b) -> a -> b
$ forall s.
Vector (Maybe ByteString) -> ST s (Vector (Maybe ByteString))
vecToRLEB Vector (Maybe ByteString)
xss)
    where
      xss :: Vector (Maybe ByteString)
xss = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe Text
x -> if | forall a. Maybe a -> Bool
isNothing Maybe Text
x
                           -> forall a. Maybe a
Nothing
                           | Bool
otherwise
                           -> forall a. a -> Maybe a
Just            forall a b. (a -> b) -> a -> b
$
                               Text -> ByteString
DTE.encodeUtf8 forall a b. (a -> b) -> a -> b
$
                               forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
x
                 )
            Vector (Maybe Text)
xs

-- | Takes a 'DVB.Vector' of 'ByteString's and returns the Run-length encoding ('RLEB').
bytestringToRLEB :: DVB.Vector (Maybe ByteString)
                 -> RLEB
bytestringToRLEB :: Vector (Maybe ByteString) -> RLEB
bytestringToRLEB (forall a. Vector a -> Maybe (a, Vector a)
DVB.uncons -> Maybe (Maybe ByteString, Vector (Maybe ByteString))
Nothing) = Vector (Maybe ByteString) -> RLEB
RLEB forall a. Vector a
DVB.empty
bytestringToRLEB Vector (Maybe ByteString)
xs                      =
 Vector (Maybe ByteString) -> RLEB
RLEB (forall a. (forall s. ST s a) -> a
CMST.runST forall a b. (a -> b) -> a -> b
$ forall s.
Vector (Maybe ByteString) -> ST s (Vector (Maybe ByteString))
vecToRLEB Vector (Maybe ByteString)
xs)

-- | Takes a 'Text' and returns the Run-length encoding (RLE).
textToRLET :: DVB.Vector (Maybe Text)
           -> RLET
textToRLET :: Vector (Maybe Text) -> RLET
textToRLET (forall a. Vector a -> Maybe (a, Vector a)
DVB.uncons -> Maybe (Maybe Text, Vector (Maybe Text))
Nothing) = Vector (Maybe Text) -> RLET
RLET forall a. Vector a
DVB.empty
textToRLET Vector (Maybe Text)
xs                      =
  Vector (Maybe Text) -> RLET
RLET (forall a. (forall s. ST s a) -> a
CMST.runST forall a b. (a -> b) -> a -> b
$ forall s. Vector (Maybe Text) -> ST s (Vector (Maybe Text))
vecToRLET Vector (Maybe Text)
xs)

-- | Takes a 'ByteString' and returns the Run-length encoding (RLE).
bytestringToRLET :: DVB.Vector (Maybe ByteString)
                 -> RLET
bytestringToRLET :: Vector (Maybe ByteString) -> RLET
bytestringToRLET (forall a. Vector a -> Maybe (a, Vector a)
DVB.uncons -> Maybe (Maybe ByteString, Vector (Maybe ByteString))
Nothing) = Vector (Maybe Text) -> RLET
RLET forall a. Vector a
DVB.empty
bytestringToRLET Vector (Maybe ByteString)
xs                      =
  Vector (Maybe Text) -> RLET
RLET (forall a. (forall s. ST s a) -> a
CMST.runST forall a b. (a -> b) -> a -> b
$ forall s. Vector (Maybe Text) -> ST s (Vector (Maybe Text))
vecToRLET Vector (Maybe Text)
xss)
    where
      xss :: Vector (Maybe Text)
xss = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe ByteString
x -> if | forall a. Maybe a -> Bool
isNothing Maybe ByteString
x
                           -> forall a. Maybe a
Nothing
                           | Bool
otherwise
                           -> forall a. a -> Maybe a
Just           forall a b. (a -> b) -> a -> b
$
                              ByteString -> Text
DTE.decodeUtf8 forall a b. (a -> b) -> a -> b
$
                              forall a. HasCallStack => Maybe a -> a
fromJust Maybe ByteString
x
                 )
            Vector (Maybe ByteString)
xs 

{-------------------}


{-fromRLE function(s)-}

-- | Helper function for converting a 'BWT'ed 'RLEB'
-- back to the original 'ByteString'.
bytestringFromBWTFromRLEB :: RLEB 
                          -> ByteString
bytestringFromBWTFromRLEB :: RLEB -> ByteString
bytestringFromBWTFromRLEB = BWT ByteString -> ByteString
bytestringFromByteStringBWT forall b c a. (b -> c) -> (a -> b) -> a -> c
. RLEB -> BWT ByteString
bytestringBWTFromRLEB

-- | Helper function for converting a 'BWT'ed 'RLET'
-- back to the original 'ByteString'.
bytestringFromBWTFromRLET :: RLET
                          -> ByteString
bytestringFromBWTFromRLET :: RLET -> ByteString
bytestringFromBWTFromRLET RLET
vs = BWT ByteString -> ByteString
bytestringFromByteStringBWT forall a b. (a -> b) -> a -> b
$
                               forall a. Vector (Maybe a) -> BWT a
BWT                         forall a b. (a -> b) -> a -> b
$
                               forall a b. (a -> b) -> Vector a -> Vector b
DVB.map (\Maybe Text
x -> if | forall a. Maybe a -> Bool
isNothing Maybe Text
x
                                                 -> forall a. Maybe a
Nothing
                                                 | Bool
otherwise
                                                 -> forall a. a -> Maybe a
Just           forall a b. (a -> b) -> a -> b
$
                                                    Text -> ByteString
DTE.encodeUtf8 forall a b. (a -> b) -> a -> b
$
                                                    forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
x
                                       )
                                                           forall a b. (a -> b) -> a -> b
$ 
                               ((\(BWT Vector (Maybe Text)
t) -> Vector (Maybe Text)
t) (RLET -> BWT Text
textBWTFromRLET RLET
vs))

-- | Helper function for converting a 'BWT'ed 'RLEB'
-- back to the original 'Text'.
textFromBWTFromRLEB :: RLEB
                    -> Text
textFromBWTFromRLEB :: RLEB -> Text
textFromBWTFromRLEB = ByteString -> Text
DTE.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. BWT ByteString -> ByteString
bytestringFromByteStringBWT forall b c a. (b -> c) -> (a -> b) -> a -> c
. RLEB -> BWT ByteString
bytestringBWTFromRLEB 

-- | Helper function for converting a 'BWT'ed 'RLET'
-- back to the original 'Text'.
textFromBWTFromRLET :: RLET
                    -> Text
textFromBWTFromRLET :: RLET -> Text
textFromBWTFromRLET = ByteString -> Text
DTE.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. BWT ByteString -> ByteString
bytestringFromByteStringBWT forall b c a. (b -> c) -> (a -> b) -> a -> c
. RLET -> BWT ByteString
bytestringBWTFromRLET

-- | Takes a 'RLET' and returns
-- the 'BWT' of 'Text's.
textBWTFromRLET :: RLET
                -> BWT Text
textBWTFromRLET :: RLET -> BWT Text
textBWTFromRLET (RLET (forall a. Vector a -> Maybe (a, Vector a)
DVB.uncons -> Maybe (Maybe Text, Vector (Maybe Text))
Nothing)) = forall a. Vector (Maybe a) -> BWT a
BWT forall a. Vector a
DVB.empty
textBWTFromRLET RLET
vs              = 
  forall a. Vector (Maybe a) -> BWT a
BWT (forall a. (forall s. ST s a) -> a
CMST.runST forall a b. (a -> b) -> a -> b
$ forall s. RLET -> ST s (Vector (Maybe Text))
vecFromRLET RLET
vs)

-- | Takes a 'RLET' and returns
-- the 'BWT' of 'ByteString's.
bytestringBWTFromRLET :: RLET
                      -> BWT ByteString
bytestringBWTFromRLET :: RLET -> BWT ByteString
bytestringBWTFromRLET (RLET (forall a. Vector a -> Maybe (a, Vector a)
DVB.uncons -> Maybe (Maybe Text, Vector (Maybe Text))
Nothing)) = forall a. Vector (Maybe a) -> BWT a
BWT forall a. Vector a
DVB.empty
bytestringBWTFromRLET RLET
vs                             = do
  let originalbwtb :: Vector (Maybe Text)
originalbwtb = forall a. (forall s. ST s a) -> a
CMST.runST forall a b. (a -> b) -> a -> b
$ forall s. RLET -> ST s (Vector (Maybe Text))
vecFromRLET RLET
vs
  forall a. Vector (Maybe a) -> BWT a
BWT (forall a b. (a -> b) -> Vector a -> Vector b
DVB.map (\Maybe Text
x -> if | forall a. Maybe a -> Bool
isNothing Maybe Text
x
                         -> forall a. Maybe a
Nothing
                         | Bool
otherwise
                         -> forall a. a -> Maybe a
Just           forall a b. (a -> b) -> a -> b
$
                            Text -> ByteString
DTE.encodeUtf8 forall a b. (a -> b) -> a -> b
$
                            forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
x 
               ) Vector (Maybe Text)
originalbwtb)

-- | Takes a 'RLEB' and returns
-- the 'BWT' of 'Text's.
textBWTFromRLEB :: RLEB
                -> BWT Text
textBWTFromRLEB :: RLEB -> BWT Text
textBWTFromRLEB (RLEB (forall a. Vector a -> Maybe (a, Vector a)
DVB.uncons -> Maybe (Maybe ByteString, Vector (Maybe ByteString))
Nothing)) = forall a. Vector (Maybe a) -> BWT a
BWT forall a. Vector a
DVB.empty
textBWTFromRLEB RLEB
vs                             = do
  let originalbwtt :: Vector (Maybe ByteString)
originalbwtt = forall a. (forall s. ST s a) -> a
CMST.runST forall a b. (a -> b) -> a -> b
$ forall s. RLEB -> ST s (Vector (Maybe ByteString))
vecFromRLEB RLEB
vs
  forall a. Vector (Maybe a) -> BWT a
BWT (forall a b. (a -> b) -> Vector a -> Vector b
DVB.map (\Maybe ByteString
x -> if | forall a. Maybe a -> Bool
isNothing Maybe ByteString
x
                         -> forall a. Maybe a
Nothing
                         | Bool
otherwise
                         -> forall a. a -> Maybe a
Just           forall a b. (a -> b) -> a -> b
$
                            ByteString -> Text
DTE.decodeUtf8 forall a b. (a -> b) -> a -> b
$
                            forall a. HasCallStack => Maybe a -> a
fromJust Maybe ByteString
x
               ) Vector (Maybe ByteString)
originalbwtt)

-- | Take a 'RLEB' and returns
-- the 'BWT' of 'ByteString's.
bytestringBWTFromRLEB :: RLEB 
                      -> BWT ByteString
bytestringBWTFromRLEB :: RLEB -> BWT ByteString
bytestringBWTFromRLEB (RLEB (forall a. Vector a -> Maybe (a, Vector a)
DVB.uncons -> Maybe (Maybe ByteString, Vector (Maybe ByteString))
Nothing)) = forall a. Vector (Maybe a) -> BWT a
BWT forall a. Vector a
DVB.empty
bytestringBWTFromRLEB RLEB
vs                             =
  forall a. Vector (Maybe a) -> BWT a
BWT (forall a. (forall s. ST s a) -> a
CMST.runST forall a b. (a -> b) -> a -> b
$ forall s. RLEB -> ST s (Vector (Maybe ByteString))
vecFromRLEB RLEB
vs)

-- | Takes a 'RLEB' and returns
-- the original 'DVB.Vector' of 'Text's.
textFromRLEB :: RLEB
             -> DVB.Vector (Maybe Text)
textFromRLEB :: RLEB -> Vector (Maybe Text)
textFromRLEB (RLEB (forall a. Vector a -> Maybe (a, Vector a)
DVB.uncons -> Maybe (Maybe ByteString, Vector (Maybe ByteString))
Nothing)) = forall a. Vector a
DVB.empty
textFromRLEB RLEB
vs                             = do
  let originalt :: Vector (Maybe ByteString)
originalt = forall a. (forall s. ST s a) -> a
CMST.runST forall a b. (a -> b) -> a -> b
$ forall s. RLEB -> ST s (Vector (Maybe ByteString))
vecFromRLEB RLEB
vs
  forall a b. (a -> b) -> Vector a -> Vector b
DVB.map (\Maybe ByteString
x -> if | forall a. Maybe a -> Bool
isNothing Maybe ByteString
x
                    -> forall a. Maybe a
Nothing
                    | Bool
otherwise
                    -> forall a. a -> Maybe a
Just           forall a b. (a -> b) -> a -> b
$
                       ByteString -> Text
DTE.decodeUtf8 forall a b. (a -> b) -> a -> b
$
                       forall a. HasCallStack => Maybe a -> a
fromJust Maybe ByteString
x
          ) Vector (Maybe ByteString)
originalt

-- | Takes a 'RLEB' and returns
-- the original 'DVB.Vector' of 'ByteString's.
bytestringFromRLEB :: RLEB
                   -> DVB.Vector (Maybe ByteString)
bytestringFromRLEB :: RLEB -> Vector (Maybe ByteString)
bytestringFromRLEB (RLEB (forall a. Vector a -> Maybe (a, Vector a)
DVB.uncons -> Maybe (Maybe ByteString, Vector (Maybe ByteString))
Nothing)) = forall a. Vector a
DVB.empty
bytestringFromRLEB RLEB
vs                             =
  forall a. (forall s. ST s a) -> a
CMST.runST forall a b. (a -> b) -> a -> b
$ forall s. RLEB -> ST s (Vector (Maybe ByteString))
vecFromRLEB RLEB
vs

-- | Takes a 'RLET' and returns
-- the original 'DVB.Vector' of 'Text's.
textFromRLET :: RLET
             -> DVB.Vector (Maybe Text)
textFromRLET :: RLET -> Vector (Maybe Text)
textFromRLET (RLET (forall a. Vector a -> Maybe (a, Vector a)
DVB.uncons -> Maybe (Maybe Text, Vector (Maybe Text))
Nothing)) = forall a. Vector a
DVB.empty
textFromRLET RLET
vs                             =
  forall a. (forall s. ST s a) -> a
CMST.runST forall a b. (a -> b) -> a -> b
$ forall s. RLET -> ST s (Vector (Maybe Text))
vecFromRLET RLET
vs

-- | Takes a 'RLET' and returns
-- the original 'DVB.Vector' of 'ByteString's.
bytestringFromRLET :: RLET
                   -> DVB.Vector (Maybe ByteString)
bytestringFromRLET :: RLET -> Vector (Maybe ByteString)
bytestringFromRLET (RLET (forall a. Vector a -> Maybe (a, Vector a)
DVB.uncons -> Maybe (Maybe Text, Vector (Maybe Text))
Nothing)) = forall a. Vector a
DVB.empty
bytestringFromRLET RLET
vs                             = do
  let originalb :: Vector (Maybe Text)
originalb = forall a. (forall s. ST s a) -> a
CMST.runST forall a b. (a -> b) -> a -> b
$ forall s. RLET -> ST s (Vector (Maybe Text))
vecFromRLET RLET
vs
  forall a b. (a -> b) -> Vector a -> Vector b
DVB.map (\Maybe Text
x -> if | forall a. Maybe a -> Bool
isNothing Maybe Text
x
                    -> forall a. Maybe a
Nothing
                    | Bool
otherwise
                    -> forall a. a -> Maybe a
Just           forall a b. (a -> b) -> a -> b
$
                       Text -> ByteString
DTE.encodeUtf8 forall a b. (a -> b) -> a -> b
$
                       forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
x
          ) Vector (Maybe Text)
originalb

{---------------------}