{-# 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)
--
-- Users will get the most mileage by first compressing to a 'BWT'
-- on the initial 'ByteString' or 'Text' input before compressing to
-- a 'RLEB' or 'RLET'.
--
-- To do this, users can use the 'bytestringToBWTToRLEB' and 'bytestringToBWTToRLET' functions,
-- as well as the 'textToBWTToRLEB' and 'textToBWTToRLET' functions.
--
-- The base functions for 'ByteString', 'bytestringToRLEB' and 'bytestringToRLET' can be used to
-- convert a 'Seq' ('Maybe' 'ByteString') to a 'RLEB' and 'RLET', respectively.
--
-- Likewise, the base functions for 'Text', 'textToRLEB' and 'textToRLET' can be used to
-- convert a 'Seq' ('Maybe' 'Text') to a 'RLEB' and 'RLET' respectively.
--
-- There are various other lower-level functions for interacting with the RLE implementation on 'ByteString' and 'Text' as well.
--
-- @"Data.RLE.Internal"@ contains efficient and stateful implementations of the RLE and Inverse RLE algorithms.


module Data.RLE ( -- * To RLE functions
                  bytestringToBWTToRLEB,
                  bytestringToBWTToRLET,
                  textToBWTToRLEB,
                  textToBWTToRLET,
                  textBWTToRLEB,
                  bytestringBWTToRLEB,
                  textBWTToRLET,
                  bytestringBWTToRLET,
                  textToRLEB,
                  bytestringToRLEB,
                  textToRLET,
                  bytestringToRLET,
                  -- * From RLE functions
                  bytestringFromBWTFromRLEB,
                  bytestringFromBWTFromRLET,
                  textFromBWTFromRLEB,
                  textFromBWTFromRLET,
                  textBWTFromRLET,
                  bytestringBWTFromRLET,
                  textBWTFromRLEB,
                  bytestringBWTFromRLEB,
                  textFromRLEB,
                  bytestringFromRLEB,
                  textFromRLET,
                  bytestringFromRLET                   
                ) 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.Sequence as DS (Seq(..))
import Data.STRef()
import Data.Text as DText 
import Data.Text.Encoding as DTE (decodeUtf8,encodeUtf8)
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 =
  Seq (Maybe ByteString) -> RLEB
RLEB (forall a. (forall s. ST s a) -> a
CMST.runST forall a b. (a -> b) -> a -> b
$ forall s. Seq (Maybe ByteString) -> ST s (Seq (Maybe ByteString))
seqToRLEB Seq (Maybe ByteString)
xss)
    where
      xss :: Seq (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 Seq (Maybe Word8)
t) -> Seq (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 Seq (Maybe Word8)
DS.Empty) = Seq (Maybe ByteString) -> RLEB
RLEB forall a. Seq a
DS.Empty
bytestringBWTToRLEB BWT Word8
xs             =
  Seq (Maybe ByteString) -> RLEB
RLEB (forall a. (forall s. ST s a) -> a
CMST.runST forall a b. (a -> b) -> a -> b
$ forall s. Seq (Maybe ByteString) -> ST s (Seq (Maybe ByteString))
seqToRLEB Seq (Maybe ByteString)
xss)
    where
      xss :: Seq (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 Seq (Maybe Word8)
t) -> Seq (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 =
  Seq (Maybe Text) -> RLET
RLET (forall a. (forall s. ST s a) -> a
CMST.runST forall a b. (a -> b) -> a -> b
$ forall s. Seq (Maybe Text) -> ST s (Seq (Maybe Text))
seqToRLET Seq (Maybe Text)
xss)
    where
      xss :: Seq (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 Seq (Maybe Word8)
t) -> Seq (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 Seq (Maybe Word8)
DS.Empty) = Seq (Maybe Text) -> RLET
RLET forall a. Seq a
DS.Empty
bytestringBWTToRLET BWT Word8
xs             =
  Seq (Maybe Text) -> RLET
RLET (forall a. (forall s. ST s a) -> a
CMST.runST forall a b. (a -> b) -> a -> b
$ forall s. Seq (Maybe Text) -> ST s (Seq (Maybe Text))
seqToRLET Seq (Maybe Text)
xss)
    where
      xss :: Seq (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 Seq (Maybe Word8)
t) -> Seq (Maybe Word8)
t) BWT Word8
xs)

-- | Takes a 'Text' and returns the Run-length encoding ('RLEB').
textToRLEB :: Seq (Maybe Text)
           -> RLEB
textToRLEB :: Seq (Maybe Text) -> RLEB
textToRLEB Seq (Maybe Text)
DS.Empty = Seq (Maybe ByteString) -> RLEB
RLEB forall a. Seq a
DS.Empty
textToRLEB Seq (Maybe Text)
xs       = 
  Seq (Maybe ByteString) -> RLEB
RLEB (forall a. (forall s. ST s a) -> a
CMST.runST forall a b. (a -> b) -> a -> b
$ forall s. Seq (Maybe ByteString) -> ST s (Seq (Maybe ByteString))
seqToRLEB Seq (Maybe ByteString)
xss)
    where
      xss :: Seq (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
                 )
            Seq (Maybe Text)
xs

-- | Takes a 'Seq' of 'ByteString's and returns the Run-length encoding ('RLEB').
bytestringToRLEB :: Seq (Maybe ByteString)
                 -> RLEB
bytestringToRLEB :: Seq (Maybe ByteString) -> RLEB
bytestringToRLEB Seq (Maybe ByteString)
DS.Empty = Seq (Maybe ByteString) -> RLEB
RLEB forall a. Seq a
DS.Empty
bytestringToRLEB Seq (Maybe ByteString)
xs       =
 Seq (Maybe ByteString) -> RLEB
RLEB (forall a. (forall s. ST s a) -> a
CMST.runST forall a b. (a -> b) -> a -> b
$ forall s. Seq (Maybe ByteString) -> ST s (Seq (Maybe ByteString))
seqToRLEB Seq (Maybe ByteString)
xs)

-- | Takes a 'Text' and returns the Run-length encoding (RLE).
textToRLET :: Seq (Maybe Text)
           -> RLET
textToRLET :: Seq (Maybe Text) -> RLET
textToRLET Seq (Maybe Text)
DS.Empty = Seq (Maybe Text) -> RLET
RLET forall a. Seq a
DS.Empty
textToRLET Seq (Maybe Text)
xs       =
  Seq (Maybe Text) -> RLET
RLET (forall a. (forall s. ST s a) -> a
CMST.runST forall a b. (a -> b) -> a -> b
$ forall s. Seq (Maybe Text) -> ST s (Seq (Maybe Text))
seqToRLET Seq (Maybe Text)
xs)

-- | Takes a 'ByteString' and returns the Run-length encoding (RLE).
bytestringToRLET :: Seq (Maybe ByteString)
                 -> RLET
bytestringToRLET :: Seq (Maybe ByteString) -> RLET
bytestringToRLET Seq (Maybe ByteString)
DS.Empty = Seq (Maybe Text) -> RLET
RLET forall a. Seq a
DS.Empty
bytestringToRLET Seq (Maybe ByteString)
xs       =
  Seq (Maybe Text) -> RLET
RLET (forall a. (forall s. ST s a) -> a
CMST.runST forall a b. (a -> b) -> a -> b
$ forall s. Seq (Maybe Text) -> ST s (Seq (Maybe Text))
seqToRLET Seq (Maybe Text)
xss)
    where
      xss :: Seq (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
                 )
            Seq (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
xs = BWT ByteString -> ByteString
bytestringFromByteStringBWT forall a b. (a -> b) -> a -> b
$
                               forall a. Seq (Maybe a) -> BWT a
BWT                         forall a b. (a -> b) -> a -> b
$
                               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
                                    )
                                                           forall a b. (a -> b) -> a -> b
$
                            ((\(BWT Seq (Maybe Text)
t) -> Seq (Maybe Text)
t) (RLET -> BWT Text
textBWTFromRLET RLET
xs))

-- | 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 Seq (Maybe Text)
DS.Empty) = forall a. Seq (Maybe a) -> BWT a
BWT forall a. Seq a
DS.Empty
textBWTFromRLET RLET
xs              = 
  forall a. Seq (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 (Seq (Maybe Text))
seqFromRLET RLET
xs)

-- | Takes a 'RLET' and returns
-- the 'BWT' of 'ByteString's.
bytestringBWTFromRLET :: RLET
                      -> BWT ByteString
bytestringBWTFromRLET :: RLET -> BWT ByteString
bytestringBWTFromRLET (RLET Seq (Maybe Text)
DS.Empty) = forall a. Seq (Maybe a) -> BWT a
BWT forall a. Seq a
DS.Empty
bytestringBWTFromRLET RLET
xs              = do
  let originalbwtb :: Seq (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 (Seq (Maybe Text))
seqFromRLET RLET
xs
  forall a. Seq (Maybe a) -> BWT a
BWT (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 
            ) Seq (Maybe Text)
originalbwtb)

-- | Takes a 'RLEB' and returns
-- the 'BWT' of 'Text's.
textBWTFromRLEB :: RLEB
                -> BWT Text
textBWTFromRLEB :: RLEB -> BWT Text
textBWTFromRLEB (RLEB Seq (Maybe ByteString)
DS.Empty) = forall a. Seq (Maybe a) -> BWT a
BWT forall a. Seq a
DS.Empty
textBWTFromRLEB RLEB
xs              = do
  let originalbwtt :: Seq (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 (Seq (Maybe ByteString))
seqFromRLEB RLEB
xs
  forall a. Seq (Maybe a) -> BWT a
BWT (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
            ) Seq (Maybe ByteString)
originalbwtt)

-- | Take a 'RLEB' and returns
-- the 'BWT' of 'ByteString's.
bytestringBWTFromRLEB :: RLEB 
                      -> BWT ByteString
bytestringBWTFromRLEB :: RLEB -> BWT ByteString
bytestringBWTFromRLEB (RLEB Seq (Maybe ByteString)
DS.Empty) = forall a. Seq (Maybe a) -> BWT a
BWT forall a. Seq a
DS.Empty
bytestringBWTFromRLEB RLEB
xs              =
  forall a. Seq (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 (Seq (Maybe ByteString))
seqFromRLEB RLEB
xs)

-- | Takes a 'RLEB' and returns
-- the original 'Seq' of 'Text's.
textFromRLEB :: RLEB
             -> Seq (Maybe Text)
textFromRLEB :: RLEB -> Seq (Maybe Text)
textFromRLEB (RLEB Seq (Maybe ByteString)
DS.Empty) = forall a. Seq a
DS.Empty
textFromRLEB RLEB
xs              = do
  let originalt :: Seq (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 (Seq (Maybe ByteString))
seqFromRLEB RLEB
xs
  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
       ) Seq (Maybe ByteString)
originalt

-- | Takes a 'RLEB' and returns
-- the original 'Seq' of 'ByteString's.
bytestringFromRLEB :: RLEB
                   -> Seq (Maybe ByteString)
bytestringFromRLEB :: RLEB -> Seq (Maybe ByteString)
bytestringFromRLEB (RLEB Seq (Maybe ByteString)
DS.Empty) = forall a. Seq a
DS.Empty
bytestringFromRLEB RLEB
xs              =
  forall a. (forall s. ST s a) -> a
CMST.runST forall a b. (a -> b) -> a -> b
$ forall s. RLEB -> ST s (Seq (Maybe ByteString))
seqFromRLEB RLEB
xs

-- | Takes a 'RLET' and returns
-- the original 'Seq' of 'Text's.
textFromRLET :: RLET
             -> Seq (Maybe Text)
textFromRLET :: RLET -> Seq (Maybe Text)
textFromRLET (RLET Seq (Maybe Text)
DS.Empty) = forall a. Seq a
DS.Empty
textFromRLET RLET
xs              =
  forall a. (forall s. ST s a) -> a
CMST.runST forall a b. (a -> b) -> a -> b
$ forall s. RLET -> ST s (Seq (Maybe Text))
seqFromRLET RLET
xs

-- | Takes a 'RLET' and returns
-- the original 'Seq' of 'ByteString's.
bytestringFromRLET :: RLET
                   -> Seq (Maybe ByteString)
bytestringFromRLET :: RLET -> Seq (Maybe ByteString)
bytestringFromRLET (RLET Seq (Maybe Text)
DS.Empty) = forall a. Seq a
DS.Empty
bytestringFromRLET RLET
xs              = do
  let originalb :: Seq (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 (Seq (Maybe Text))
seqFromRLET RLET
xs
  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
       ) Seq (Maybe Text)
originalb

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