{-# LANGUAGE MultiWayIf       #-}
{-# LANGUAGE ViewPatterns     #-}
{-# LANGUAGE Strict           #-}
{-# LANGUAGE DeriveGeneric    #-}
{-# LANGUAGE TypeApplications #-}


-- |
-- Module      :  Data.MTF.Internal
-- Copyright   :  (c) Matthew Mosior 2022
-- License     :  BSD-style
-- Maintainer  :  mattm.github@gmail.com
-- Portability :  portable
--
-- = WARNING
--
-- This module is considered __internal__.
--
-- The Package Versioning Policy __does not apply__.
--
-- The contents of this module may change __in any way whatsoever__
-- and __without any warning__ between minor versions of this package.
--
-- Authors importing this library are expected to track development
-- closely.
--
-- All credit goes to the author(s)/maintainer(s) of the
-- [containers](https://hackage.haskell.org/package/containers) library
-- for the above warning text.
--
-- = Description
--
-- Various data structures and custom data types to describe the Move-to-front transform (MTF)
-- and the Inverse MTF implementations, namely 'seqToMTFB', 'seqToMTFT', 'seqFromMTFB', and 'seqFromMTFT'.
--
-- The MTF implementations rely heavily upon 'Seq' provided by the [containers](https://hackage.haskell.org/package/containers),
-- 'STRef' and associated functions in the [stref](https://hackage.haskell.org/package/base-4.17.0.0/docs/Data-STRef.html) library,
-- and 'runST' in the [Control.Monad.ST](https://hackage.haskell.org/package/base-4.17.0.0/docs/Control-Monad-ST.html) library.


module Data.MTF.Internal where

import Control.Monad as CM
import Control.Monad.ST as CMST
import Control.Monad.State.Strict()
import Data.ByteString as BS
import Data.ByteString.Char8()
import Data.ByteString.Internal()
import Data.Foldable as DFold (foldr')
import Data.List()
import Data.Maybe()
import Data.Set as DSet
import Data.Sequence as DS (Seq(..),deleteAt,findIndexL,empty,index,unstableSort,(|>),(<|))
import Data.Sequence.Internal as DSI
import Data.STRef as DSTR
import Data.Text as DText
import GHC.Generics (Generic)
import Prelude as P


{-Base level types.-}

-- | Basic MTF ('ByteString') data type.
newtype MTFB = MTFB ((Seq Int,Seq (Maybe ByteString)))
  deriving (MTFB -> MTFB -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MTFB -> MTFB -> Bool
$c/= :: MTFB -> MTFB -> Bool
== :: MTFB -> MTFB -> Bool
$c== :: MTFB -> MTFB -> Bool
Eq,Eq MTFB
MTFB -> MTFB -> Bool
MTFB -> MTFB -> Ordering
MTFB -> MTFB -> MTFB
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MTFB -> MTFB -> MTFB
$cmin :: MTFB -> MTFB -> MTFB
max :: MTFB -> MTFB -> MTFB
$cmax :: MTFB -> MTFB -> MTFB
>= :: MTFB -> MTFB -> Bool
$c>= :: MTFB -> MTFB -> Bool
> :: MTFB -> MTFB -> Bool
$c> :: MTFB -> MTFB -> Bool
<= :: MTFB -> MTFB -> Bool
$c<= :: MTFB -> MTFB -> Bool
< :: MTFB -> MTFB -> Bool
$c< :: MTFB -> MTFB -> Bool
compare :: MTFB -> MTFB -> Ordering
$ccompare :: MTFB -> MTFB -> Ordering
Ord,Int -> MTFB -> ShowS
[MTFB] -> ShowS
MTFB -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MTFB] -> ShowS
$cshowList :: [MTFB] -> ShowS
show :: MTFB -> String
$cshow :: MTFB -> String
showsPrec :: Int -> MTFB -> ShowS
$cshowsPrec :: Int -> MTFB -> ShowS
Show,ReadPrec [MTFB]
ReadPrec MTFB
Int -> ReadS MTFB
ReadS [MTFB]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MTFB]
$creadListPrec :: ReadPrec [MTFB]
readPrec :: ReadPrec MTFB
$creadPrec :: ReadPrec MTFB
readList :: ReadS [MTFB]
$creadList :: ReadS [MTFB]
readsPrec :: Int -> ReadS MTFB
$creadsPrec :: Int -> ReadS MTFB
Read,forall x. Rep MTFB x -> MTFB
forall x. MTFB -> Rep MTFB x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MTFB x -> MTFB
$cfrom :: forall x. MTFB -> Rep MTFB x
Generic)

-- | Basic MTF ('Text') data type.
newtype MTFT = MTFT ((Seq Int,Seq (Maybe Text)))
  deriving (MTFT -> MTFT -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MTFT -> MTFT -> Bool
$c/= :: MTFT -> MTFT -> Bool
== :: MTFT -> MTFT -> Bool
$c== :: MTFT -> MTFT -> Bool
Eq,Eq MTFT
MTFT -> MTFT -> Bool
MTFT -> MTFT -> Ordering
MTFT -> MTFT -> MTFT
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MTFT -> MTFT -> MTFT
$cmin :: MTFT -> MTFT -> MTFT
max :: MTFT -> MTFT -> MTFT
$cmax :: MTFT -> MTFT -> MTFT
>= :: MTFT -> MTFT -> Bool
$c>= :: MTFT -> MTFT -> Bool
> :: MTFT -> MTFT -> Bool
$c> :: MTFT -> MTFT -> Bool
<= :: MTFT -> MTFT -> Bool
$c<= :: MTFT -> MTFT -> Bool
< :: MTFT -> MTFT -> Bool
$c< :: MTFT -> MTFT -> Bool
compare :: MTFT -> MTFT -> Ordering
$ccompare :: MTFT -> MTFT -> Ordering
Ord,Int -> MTFT -> ShowS
[MTFT] -> ShowS
MTFT -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MTFT] -> ShowS
$cshowList :: [MTFT] -> ShowS
show :: MTFT -> String
$cshow :: MTFT -> String
showsPrec :: Int -> MTFT -> ShowS
$cshowsPrec :: Int -> MTFT -> ShowS
Show,ReadPrec [MTFT]
ReadPrec MTFT
Int -> ReadS MTFT
ReadS [MTFT]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MTFT]
$creadListPrec :: ReadPrec [MTFT]
readPrec :: ReadPrec MTFT
$creadPrec :: ReadPrec MTFT
readList :: ReadS [MTFT]
$creadList :: ReadS [MTFT]
readsPrec :: Int -> ReadS MTFT
$creadsPrec :: Int -> ReadS MTFT
Read,forall x. Rep MTFT x -> MTFT
forall x. MTFT -> Rep MTFT x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MTFT x -> MTFT
$cfrom :: forall x. MTFT -> Rep MTFT x
Generic)

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


{-Auxilary function(s).-}

-- | Useful to acquire the unique elements
-- that make up a 'Seq'.
-- Credit to @DavidFletcher.
-- See [this stackoverflow post](https://stackoverflow.com/questions/45757839/removing-duplicate-elements-in-a-seq).
nubSeq' :: Ord a
        => Seq (Maybe a)
        -> Seq (Maybe a)
nubSeq' :: forall a. Ord a => Seq (Maybe a) -> Seq (Maybe a)
nubSeq' Seq (Maybe a)
xs =
  forall a. Ord a => Seq a -> Seq a
unstableSort forall a b. (a -> b) -> a -> b
$
  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
DFold.foldr' forall a.
Ord a =>
Maybe a
-> (Set (Maybe a) -> Seq (Maybe a))
-> Set (Maybe a)
-> Seq (Maybe a)
cons'
               forall a. Set (Maybe a) -> Seq (Maybe a)
nil
               Seq (Maybe a)
xs
               forall a. Set a
DSet.empty
    where
      cons' :: Ord a
           => Maybe a
           -> (Set (Maybe a) -> Seq (Maybe a))
           -> (Set (Maybe a) -> Seq (Maybe a))
      cons' :: forall a.
Ord a =>
Maybe a
-> (Set (Maybe a) -> Seq (Maybe a))
-> Set (Maybe a)
-> Seq (Maybe a)
cons' Maybe a
y Set (Maybe a) -> Seq (Maybe a)
ys Set (Maybe a)
seen = if | Maybe a
y forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`P.elem` Set (Maybe a)
seen
                           -> Set (Maybe a) -> Seq (Maybe a)
ys Set (Maybe a)
seen
                           | Bool
otherwise
                           -> Maybe a
y forall a. a -> Seq a -> Seq a
DS.<| Set (Maybe a) -> Seq (Maybe a)
ys (forall a. Ord a => a -> Set a -> Set a
DSet.insert Maybe a
y Set (Maybe a)
seen)
      nil :: Set (Maybe a)
          -> Seq (Maybe a)
      nil :: forall a. Set (Maybe a) -> Seq (Maybe a)
nil Set (Maybe a)
_ = forall a. Seq a
DS.empty

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


{-toMTF (ByteString) functions.-}

-- | Abstract 'PBMTFSeqB' type utilizing a 'Seq'
type PBMTFSeqB = Seq (Maybe ByteString)

-- | Abstract 'MTFLSSeqB' type utilizing a 'Seq'.
type MTFLSSeqB = (Seq Int,Seq (Maybe ByteString))

-- | Abstract data type representing a 'MTFLSSeqB' in the (strict) ST monad.
type STMTFLSSeqB s a = STRef s MTFLSSeqB

-- | Abstract data type to initialize a 'STMTFLSSeqB'
-- using the initial list.
initializeSTMTFLSSeqB :: STMTFLSSeqB s (Seq Int,Seq (Maybe ByteString))
                     -> Seq (Maybe ByteString)
                     -> ST s ()
initializeSTMTFLSSeqB :: forall s.
STMTFLSSeqB s (Seq Int, Seq (Maybe ByteString))
-> Seq (Maybe ByteString) -> ST s ()
initializeSTMTFLSSeqB STMTFLSSeqB s (Seq Int, Seq (Maybe ByteString))
s Seq (Maybe ByteString)
DS.Empty = do
  (Seq Int
s2i,Seq (Maybe ByteString)
_) <- forall s a. STRef s a -> ST s a
readSTRef STMTFLSSeqB s (Seq Int, Seq (Maybe ByteString))
s
  forall s a. STRef s a -> a -> ST s ()
writeSTRef STMTFLSSeqB s (Seq Int, Seq (Maybe ByteString))
s (Seq Int
s2i,forall a. Seq a
DS.empty)
initializeSTMTFLSSeqB STMTFLSSeqB s (Seq Int, Seq (Maybe ByteString))
s Seq (Maybe ByteString)
e        = do
  (Seq Int
s2i,Seq (Maybe ByteString)
_) <- forall s a. STRef s a -> ST s a
readSTRef STMTFLSSeqB s (Seq Int, Seq (Maybe ByteString))
s
  forall s a. STRef s a -> a -> ST s ()
writeSTRef STMTFLSSeqB s (Seq Int, Seq (Maybe ByteString))
s (Seq Int
s2i,Seq (Maybe ByteString)
e)

-- | State function to update 'MTFLSSeqB'
-- with each step of the MTF.
updateSTMTFLSSeqB :: STMTFLSSeqB s (Seq Int,Seq (Maybe ByteString))
                  -> Int
                  -> ST s () 
updateSTMTFLSSeqB :: forall s.
STMTFLSSeqB s (Seq Int, Seq (Maybe ByteString)) -> Int -> ST s ()
updateSTMTFLSSeqB STMTFLSSeqB s (Seq Int, Seq (Maybe ByteString))
s Int
i = do
  (Seq Int
s2i,Seq (Maybe ByteString)
s2b) <- forall s a. STRef s a -> ST s a
readSTRef STMTFLSSeqB s (Seq Int, Seq (Maybe ByteString))
s
  let newheade :: Maybe ByteString
newheade = forall a. Seq a -> Int -> a
DS.index Seq (Maybe ByteString)
s2b Int
i
  forall s a. STRef s a -> a -> ST s ()
writeSTRef STMTFLSSeqB s (Seq Int, Seq (Maybe ByteString))
s (Seq Int
s2i,forall a. Int -> Seq a -> Seq a
DS.deleteAt Int
i Seq (Maybe ByteString)
s2b)
  (Seq Int
ns2i,Seq (Maybe ByteString)
ns2b) <- forall s a. STRef s a -> ST s a
readSTRef STMTFLSSeqB s (Seq Int, Seq (Maybe ByteString))
s
  forall s a. STRef s a -> a -> ST s ()
writeSTRef STMTFLSSeqB s (Seq Int, Seq (Maybe ByteString))
s (Seq Int
ns2i forall a. Seq a -> a -> Seq a
DS.|> Int
i,Maybe ByteString
newheade forall a. a -> Seq a -> Seq a
DS.<| Seq (Maybe ByteString)
ns2b)

-- | State function to create empty 'STMTFLSSeqB' type.
emptySTMTFLSSeqB :: ST s (STMTFLSSeqB s a)
emptySTMTFLSSeqB :: forall s a. ST s (STMTFLSSeqB s a)
emptySTMTFLSSeqB = forall a s. a -> ST s (STRef s a)
newSTRef (forall a. Seq a
DS.empty,forall a. Seq a
DS.empty) 

-- | Abstract 'STMTFILB' and associated state type.
type STMTFILB s a = STRef s (Seq (Maybe ByteString))

-- | State function to load list into 'STMTFILB'.
loadSTMTFILB :: STMTFILB s (Maybe ByteString)
             -> Seq (Maybe ByteString)
             -> ST s ()
loadSTMTFILB :: forall s.
STMTFILB s (Maybe ByteString) -> Seq (Maybe ByteString) -> ST s ()
loadSTMTFILB STMTFILB s (Maybe ByteString)
s Seq (Maybe ByteString)
e = forall s a. STRef s a -> a -> ST s ()
writeSTRef STMTFILB s (Maybe ByteString)
s Seq (Maybe ByteString)
e

-- | State function to create empty 'STMTFILB' type.
emptySTMTFILB :: ST s (STMTFILB s a)
emptySTMTFILB :: forall s a. ST s (STMTFILB s a)
emptySTMTFILB = forall a s. a -> ST s (STRef s a)
newSTRef forall a. Seq a
DS.empty

-- | Abstract 'STMTFCounterB' and associated state type.
type STMTFCounterB s a = STRef s Int

-- | State function to update 'STMTFCounterB'.
updateSTMTFCounterB :: STMTFCounterB s Int
                    -> Int
                    -> ST s ()
updateSTMTFCounterB :: forall s. STMTFCounterB s Int -> Int -> ST s ()
updateSTMTFCounterB STMTFCounterB s Int
s Int
e = forall s a. STRef s a -> a -> ST s ()
writeSTRef STMTFCounterB s Int
s Int
e

-- | State function to create empty 'STMTFCounterB' type.
emptySTMTFCounterB :: ST s (STMTFCounterB s Int)
emptySTMTFCounterB :: forall s. ST s (STMTFCounterB s Int)
emptySTMTFCounterB = forall a s. a -> ST s (STRef s a)
newSTRef (-Int
1)

-- | Strict state monad function.
seqToMTFB :: PBMTFSeqB
          -> ST s MTFLSSeqB
seqToMTFB :: forall s.
Seq (Maybe ByteString) -> ST s (Seq Int, Seq (Maybe ByteString))
seqToMTFB Seq (Maybe ByteString)
DS.Empty      = do
  STMTFLSSeqB s Any
bmtfseqstackempty  <- forall s a. ST s (STMTFLSSeqB s a)
emptySTMTFLSSeqB
  (Seq Int, Seq (Maybe ByteString))
bmtfseqstackemptyr <- forall s a. STRef s a -> ST s a
readSTRef STMTFLSSeqB s Any
bmtfseqstackempty
  forall (m :: * -> *) a. Monad m => a -> m a
return (Seq Int, Seq (Maybe ByteString))
bmtfseqstackemptyr
seqToMTFB Seq (Maybe ByteString)
xs            = do
  STMTFLSSeqB s Any
bmtfseqstack     <- forall s a. ST s (STMTFLSSeqB s a)
emptySTMTFLSSeqB
  STMTFILB s Any
bmtfinitiallist  <- forall s a. ST s (STMTFILB s a)
emptySTMTFILB
  STMTFCounterB s Int
bmtfcounterstack <- forall s. ST s (STMTFCounterB s Int)
emptySTMTFCounterB
  let il :: Seq (Maybe ByteString)
il = forall a. Ord a => Seq (Maybe a) -> Seq (Maybe a)
nubSeq' Seq (Maybe ByteString)
xs
  forall s.
STMTFILB s (Maybe ByteString) -> Seq (Maybe ByteString) -> ST s ()
loadSTMTFILB STMTFILB s Any
bmtfinitiallist
               Seq (Maybe ByteString)
il 
  forall {s}.
Seq (Maybe ByteString)
-> STRef s (Seq (Maybe ByteString))
-> STMTFLSSeqB s (Seq Int, Seq (Maybe ByteString))
-> STRef s Int
-> ST s ()
iMTFB Seq (Maybe ByteString)
xs
        STMTFILB s Any
bmtfinitiallist
        STMTFLSSeqB s Any
bmtfseqstack
        STMTFCounterB s Int
bmtfcounterstack 
  (Seq Int, Seq (Maybe ByteString))
bmtfseqstackr <- forall s a. STRef s a -> ST s a
readSTRef STMTFLSSeqB s Any
bmtfseqstack
  forall (m :: * -> *) a. Monad m => a -> m a
return (Seq Int, Seq (Maybe ByteString))
bmtfseqstackr
    where
      iMTFB :: Seq (Maybe ByteString)
-> STRef s (Seq (Maybe ByteString))
-> STMTFLSSeqB s (Seq Int, Seq (Maybe ByteString))
-> STRef s Int
-> ST s ()
iMTFB Seq (Maybe ByteString)
DS.Empty      STRef s (Seq (Maybe ByteString))
_      STMTFLSSeqB s (Seq Int, Seq (Maybe ByteString))
_      STRef s Int
_      = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      iMTFB (Maybe ByteString
y DS.:<| Seq (Maybe ByteString)
ys) STRef s (Seq (Maybe ByteString))
bmtfil STMTFLSSeqB s (Seq Int, Seq (Maybe ByteString))
bmtfss STRef s Int
bmtfcs = do
        Int
cbmtfcs <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
bmtfcs
        if | Int
cbmtfcs forall a. Eq a => a -> a -> Bool
== (-Int
1)
           -> do forall s. STMTFCounterB s Int -> Int -> ST s ()
updateSTMTFCounterB STRef s Int
bmtfcs
                                     Int
1
                 Seq (Maybe ByteString)
cbmtfil <- forall s a. STRef s a -> ST s a
readSTRef STRef s (Seq (Maybe ByteString))
bmtfil
                 forall s.
STMTFLSSeqB s (Seq Int, Seq (Maybe ByteString))
-> Seq (Maybe ByteString) -> ST s ()
initializeSTMTFLSSeqB STMTFLSSeqB s (Seq Int, Seq (Maybe ByteString))
bmtfss
                                       Seq (Maybe ByteString)
cbmtfil
                 (Seq Int
_,Seq (Maybe ByteString)
cbmtfss) <- forall s a. STRef s a -> ST s a
readSTRef STMTFLSSeqB s (Seq Int, Seq (Maybe ByteString))
bmtfss
                 case (forall a. (a -> Bool) -> Seq a -> Maybe Int
DS.findIndexL (\Maybe ByteString
z -> Maybe ByteString
z forall a. Eq a => a -> a -> Bool
== Maybe ByteString
y) Seq (Maybe ByteString)
cbmtfss) of
                   Maybe Int
Nothing     -> Seq (Maybe ByteString)
-> STRef s (Seq (Maybe ByteString))
-> STMTFLSSeqB s (Seq Int, Seq (Maybe ByteString))
-> STRef s Int
-> ST s ()
iMTFB Seq (Maybe ByteString)
ys
                                        STRef s (Seq (Maybe ByteString))
bmtfil
                                        STMTFLSSeqB s (Seq Int, Seq (Maybe ByteString))
bmtfss
                                        STRef s Int
bmtfcs
                   Just Int
bindex -> do forall s.
STMTFLSSeqB s (Seq Int, Seq (Maybe ByteString)) -> Int -> ST s ()
updateSTMTFLSSeqB STMTFLSSeqB s (Seq Int, Seq (Maybe ByteString))
bmtfss
                                                       Int
bindex
                                     Seq (Maybe ByteString)
-> STRef s (Seq (Maybe ByteString))
-> STMTFLSSeqB s (Seq Int, Seq (Maybe ByteString))
-> STRef s Int
-> ST s ()
iMTFB Seq (Maybe ByteString)
ys
                                           STRef s (Seq (Maybe ByteString))
bmtfil
                                           STMTFLSSeqB s (Seq Int, Seq (Maybe ByteString))
bmtfss
                                           STRef s Int
bmtfcs
           | Bool
otherwise
           -> do (Seq Int
_,Seq (Maybe ByteString)
cbmtfss) <- forall s a. STRef s a -> ST s a
readSTRef STMTFLSSeqB s (Seq Int, Seq (Maybe ByteString))
bmtfss
                 case (forall a. (a -> Bool) -> Seq a -> Maybe Int
DS.findIndexL (\Maybe ByteString
z -> Maybe ByteString
z forall a. Eq a => a -> a -> Bool
== Maybe ByteString
y) Seq (Maybe ByteString)
cbmtfss) of
                   Maybe Int
Nothing     -> Seq (Maybe ByteString)
-> STRef s (Seq (Maybe ByteString))
-> STMTFLSSeqB s (Seq Int, Seq (Maybe ByteString))
-> STRef s Int
-> ST s ()
iMTFB Seq (Maybe ByteString)
ys
                                        STRef s (Seq (Maybe ByteString))
bmtfil
                                        STMTFLSSeqB s (Seq Int, Seq (Maybe ByteString))
bmtfss
                                        STRef s Int
bmtfcs
                   Just Int
bindex -> do forall s.
STMTFLSSeqB s (Seq Int, Seq (Maybe ByteString)) -> Int -> ST s ()
updateSTMTFLSSeqB STMTFLSSeqB s (Seq Int, Seq (Maybe ByteString))
bmtfss
                                                       Int
bindex
                                     Seq (Maybe ByteString)
-> STRef s (Seq (Maybe ByteString))
-> STMTFLSSeqB s (Seq Int, Seq (Maybe ByteString))
-> STRef s Int
-> ST s ()
iMTFB Seq (Maybe ByteString)
ys
                                           STRef s (Seq (Maybe ByteString))
bmtfil
                                           STMTFLSSeqB s (Seq Int, Seq (Maybe ByteString))
bmtfss
                                           STRef s Int
bmtfcs

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


{-toMTF (Text) functions.-}

-- | Abstract 'PTMTFSeqT' type utilizing a 'Seq'
type PTMTFSeqT = Seq (Maybe Text)

-- | Abstract 'MTFLSSeqT' type utilizing a 'Seq'.
type MTFLSSeqT = (Seq Int,Seq (Maybe Text))

-- | Abstract data type representing a 'MTFLSSeqT' in the (strict) ST monad.
type STMTFLSSeqT s a = STRef s MTFLSSeqT

-- | Abstract data type to initialize a 'STMTFLSSeqT'
-- using the initial list.
initializeSTMTFLSSeqT :: STMTFLSSeqT s (Seq Int,Seq (Maybe Text))
                      -> Seq (Maybe Text)
                      -> ST s ()
initializeSTMTFLSSeqT :: forall s.
STMTFLSSeqT s (Seq Int, Seq (Maybe Text))
-> Seq (Maybe Text) -> ST s ()
initializeSTMTFLSSeqT STMTFLSSeqT s (Seq Int, Seq (Maybe Text))
s Seq (Maybe Text)
DS.Empty  = do
  (Seq Int
s2i,Seq (Maybe Text)
_) <- forall s a. STRef s a -> ST s a
readSTRef STMTFLSSeqT s (Seq Int, Seq (Maybe Text))
s
  forall s a. STRef s a -> a -> ST s ()
writeSTRef STMTFLSSeqT s (Seq Int, Seq (Maybe Text))
s (Seq Int
s2i,forall a. Seq a
DS.empty)
initializeSTMTFLSSeqT STMTFLSSeqT s (Seq Int, Seq (Maybe Text))
s Seq (Maybe Text)
e         = do
  (Seq Int
s2i,Seq (Maybe Text)
_) <- forall s a. STRef s a -> ST s a
readSTRef STMTFLSSeqT s (Seq Int, Seq (Maybe Text))
s
  forall s a. STRef s a -> a -> ST s ()
writeSTRef STMTFLSSeqT s (Seq Int, Seq (Maybe Text))
s (Seq Int
s2i,Seq (Maybe Text)
e)

-- | State function to update 'STMTFLSSeqT'
-- with each step of the MTF.
updateSTMTFLSSeqT :: STMTFLSSeqT s (Seq Int,Seq (Maybe Text))
                  -> Int
                  -> ST s ()
updateSTMTFLSSeqT :: forall s.
STMTFLSSeqT s (Seq Int, Seq (Maybe Text)) -> Int -> ST s ()
updateSTMTFLSSeqT STMTFLSSeqT s (Seq Int, Seq (Maybe Text))
s Int
i = do
  (Seq Int
s2i,Seq (Maybe Text)
s2b) <- forall s a. STRef s a -> ST s a
readSTRef STMTFLSSeqT s (Seq Int, Seq (Maybe Text))
s
  let newheade :: Maybe Text
newheade = forall a. Seq a -> Int -> a
DS.index Seq (Maybe Text)
s2b Int
i
  forall s a. STRef s a -> a -> ST s ()
writeSTRef STMTFLSSeqT s (Seq Int, Seq (Maybe Text))
s (Seq Int
s2i,forall a. Int -> Seq a -> Seq a
DS.deleteAt Int
i Seq (Maybe Text)
s2b)
  (Seq Int
ns2i,Seq (Maybe Text)
ns2b) <- forall s a. STRef s a -> ST s a
readSTRef STMTFLSSeqT s (Seq Int, Seq (Maybe Text))
s
  forall s a. STRef s a -> a -> ST s ()
writeSTRef STMTFLSSeqT s (Seq Int, Seq (Maybe Text))
s (Seq Int
ns2i forall a. Seq a -> a -> Seq a
DS.|> Int
i,Maybe Text
newheade forall a. a -> Seq a -> Seq a
DS.<| Seq (Maybe Text)
ns2b)

-- | State function to create empty 'STMTFLSSeqT' type.
emptySTMTFLSSeqT :: ST s (STMTFLSSeqT s a)
emptySTMTFLSSeqT :: forall s a. ST s (STMTFLSSeqT s a)
emptySTMTFLSSeqT = forall a s. a -> ST s (STRef s a)
newSTRef (forall a. Seq a
DS.empty,forall a. Seq a
DS.empty)

-- | Abstract 'STMTFILT' and associated state type.
type STMTFILT s a = STRef s (Seq (Maybe Text))

-- | State function to load list into 'STMTFILT'.
loadSTMTFILT :: STMTFILT s (Maybe Text)
             -> Seq (Maybe Text)
             -> ST s ()
loadSTMTFILT :: forall s. STMTFILT s (Maybe Text) -> Seq (Maybe Text) -> ST s ()
loadSTMTFILT STMTFILT s (Maybe Text)
s Seq (Maybe Text)
e = forall s a. STRef s a -> a -> ST s ()
writeSTRef STMTFILT s (Maybe Text)
s Seq (Maybe Text)
e

-- | State function to create empty 'STMTFILT' type.
emptySTMTFILT :: ST s (STMTFILT s a)
emptySTMTFILT :: forall s a. ST s (STMTFILT s a)
emptySTMTFILT = forall a s. a -> ST s (STRef s a)
newSTRef forall a. Seq a
DS.empty

-- | Abstract 'STMTFCounterT' and associated state type.
type STMTFCounterT s a = STRef s Int

-- | State function to update 'STMTFCounterT'.
updateSTMTFCounterT :: STMTFCounterT s Int
                    -> Int
                    -> ST s ()
updateSTMTFCounterT :: forall s. STMTFCounterB s Int -> Int -> ST s ()
updateSTMTFCounterT STMTFCounterT s Int
s Int
e = forall s a. STRef s a -> a -> ST s ()
writeSTRef STMTFCounterT s Int
s Int
e

-- | State function to create empty 'STMTFCounterT' type.
emptySTMTFCounterT :: ST s (STMTFCounterT s Int)
emptySTMTFCounterT :: forall s. ST s (STMTFCounterB s Int)
emptySTMTFCounterT = forall a s. a -> ST s (STRef s a)
newSTRef (-Int
1)

-- | Strict state monad function.
seqToMTFT :: PTMTFSeqT
          -> ST s MTFLSSeqT
seqToMTFT :: forall s. Seq (Maybe Text) -> ST s (Seq Int, Seq (Maybe Text))
seqToMTFT Seq (Maybe Text)
DS.Empty      = do
  STMTFLSSeqT s Any
tmtfseqstackempty  <- forall s a. ST s (STMTFLSSeqT s a)
emptySTMTFLSSeqT
  (Seq Int, Seq (Maybe Text))
tmtfseqstackemptyr <- forall s a. STRef s a -> ST s a
readSTRef STMTFLSSeqT s Any
tmtfseqstackempty
  forall (m :: * -> *) a. Monad m => a -> m a
return (Seq Int, Seq (Maybe Text))
tmtfseqstackemptyr
seqToMTFT Seq (Maybe Text)
xs            = do
  STMTFLSSeqT s Any
tmtfseqstack     <- forall s a. ST s (STMTFLSSeqT s a)
emptySTMTFLSSeqT
  STMTFILT s Any
tmtfinitiallist  <- forall s a. ST s (STMTFILT s a)
emptySTMTFILT
  STMTFCounterT s Int
tmtfcounterstack <- forall s. ST s (STMTFCounterB s Int)
emptySTMTFCounterT
  let il :: Seq (Maybe Text)
il = forall a. Ord a => Seq (Maybe a) -> Seq (Maybe a)
nubSeq' Seq (Maybe Text)
xs
  forall s. STMTFILT s (Maybe Text) -> Seq (Maybe Text) -> ST s ()
loadSTMTFILT STMTFILT s Any
tmtfinitiallist
               Seq (Maybe Text)
il
  forall {s}.
Seq (Maybe Text)
-> STRef s (Seq (Maybe Text))
-> STMTFLSSeqT s (Seq Int, Seq (Maybe Text))
-> STRef s Int
-> ST s ()
iMTFT Seq (Maybe Text)
xs
        STMTFILT s Any
tmtfinitiallist
        STMTFLSSeqT s Any
tmtfseqstack
        STMTFCounterT s Int
tmtfcounterstack
  (Seq Int, Seq (Maybe Text))
tmtfseqstackr <- forall s a. STRef s a -> ST s a
readSTRef STMTFLSSeqT s Any
tmtfseqstack
  forall (m :: * -> *) a. Monad m => a -> m a
return (Seq Int, Seq (Maybe Text))
tmtfseqstackr
    where
      iMTFT :: Seq (Maybe Text)
-> STRef s (Seq (Maybe Text))
-> STMTFLSSeqT s (Seq Int, Seq (Maybe Text))
-> STRef s Int
-> ST s ()
iMTFT Seq (Maybe Text)
DS.Empty      STRef s (Seq (Maybe Text))
_      STMTFLSSeqT s (Seq Int, Seq (Maybe Text))
_      STRef s Int
_      = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      iMTFT (Maybe Text
y DS.:<| Seq (Maybe Text)
ys) STRef s (Seq (Maybe Text))
tmtfil STMTFLSSeqT s (Seq Int, Seq (Maybe Text))
tmtfss STRef s Int
tmtfcs = do
        Int
ctmtfcs <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
tmtfcs
        if | Int
ctmtfcs forall a. Eq a => a -> a -> Bool
== (-Int
1)
           -> do forall s. STMTFCounterB s Int -> Int -> ST s ()
updateSTMTFCounterT STRef s Int
tmtfcs
                                     Int
1
                 Seq (Maybe Text)
ctmtfil <- forall s a. STRef s a -> ST s a
readSTRef STRef s (Seq (Maybe Text))
tmtfil
                 forall s.
STMTFLSSeqT s (Seq Int, Seq (Maybe Text))
-> Seq (Maybe Text) -> ST s ()
initializeSTMTFLSSeqT STMTFLSSeqT s (Seq Int, Seq (Maybe Text))
tmtfss
                                       Seq (Maybe Text)
ctmtfil
                 (Seq Int
_,Seq (Maybe Text)
ctmtfss) <- forall s a. STRef s a -> ST s a
readSTRef STMTFLSSeqT s (Seq Int, Seq (Maybe Text))
tmtfss
                 case (forall a. (a -> Bool) -> Seq a -> Maybe Int
DS.findIndexL (\Maybe Text
z -> Maybe Text
z forall a. Eq a => a -> a -> Bool
== Maybe Text
y) Seq (Maybe Text)
ctmtfss) of
                   Maybe Int
Nothing     -> Seq (Maybe Text)
-> STRef s (Seq (Maybe Text))
-> STMTFLSSeqT s (Seq Int, Seq (Maybe Text))
-> STRef s Int
-> ST s ()
iMTFT Seq (Maybe Text)
ys
                                        STRef s (Seq (Maybe Text))
tmtfil
                                        STMTFLSSeqT s (Seq Int, Seq (Maybe Text))
tmtfss
                                        STRef s Int
tmtfcs
                   Just Int
tindex -> do forall s.
STMTFLSSeqT s (Seq Int, Seq (Maybe Text)) -> Int -> ST s ()
updateSTMTFLSSeqT STMTFLSSeqT s (Seq Int, Seq (Maybe Text))
tmtfss
                                                       Int
tindex
                                     Seq (Maybe Text)
-> STRef s (Seq (Maybe Text))
-> STMTFLSSeqT s (Seq Int, Seq (Maybe Text))
-> STRef s Int
-> ST s ()
iMTFT Seq (Maybe Text)
ys
                                           STRef s (Seq (Maybe Text))
tmtfil
                                           STMTFLSSeqT s (Seq Int, Seq (Maybe Text))
tmtfss
                                           STRef s Int
tmtfcs
           | Bool
otherwise
           -> do (Seq Int
_,Seq (Maybe Text)
ctmtfss) <- forall s a. STRef s a -> ST s a
readSTRef STMTFLSSeqT s (Seq Int, Seq (Maybe Text))
tmtfss
                 case (forall a. (a -> Bool) -> Seq a -> Maybe Int
DS.findIndexL (\Maybe Text
z -> Maybe Text
z forall a. Eq a => a -> a -> Bool
== Maybe Text
y) Seq (Maybe Text)
ctmtfss) of
                   Maybe Int
Nothing     -> Seq (Maybe Text)
-> STRef s (Seq (Maybe Text))
-> STMTFLSSeqT s (Seq Int, Seq (Maybe Text))
-> STRef s Int
-> ST s ()
iMTFT Seq (Maybe Text)
ys
                                        STRef s (Seq (Maybe Text))
tmtfil
                                        STMTFLSSeqT s (Seq Int, Seq (Maybe Text))
tmtfss
                                        STRef s Int
tmtfcs
                   Just Int
tindex -> do forall s.
STMTFLSSeqT s (Seq Int, Seq (Maybe Text)) -> Int -> ST s ()
updateSTMTFLSSeqT STMTFLSSeqT s (Seq Int, Seq (Maybe Text))
tmtfss
                                                       Int
tindex
                                     Seq (Maybe Text)
-> STRef s (Seq (Maybe Text))
-> STMTFLSSeqT s (Seq Int, Seq (Maybe Text))
-> STRef s Int
-> ST s ()
iMTFT Seq (Maybe Text)
ys
                                           STRef s (Seq (Maybe Text))
tmtfil
                                           STMTFLSSeqT s (Seq Int, Seq (Maybe Text))
tmtfss
                                           STRef s Int
tmtfcs

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


{-fromMTF (ByteString) functions.-}

-- | Abstract 'FMTFSeqB' type utilizing a 'Seq'.
type FMTFSeqB = Seq (Maybe ByteString)

-- | Abstract data type representing a 'FMTFSeqB' in the (strict) ST monad.
type FSTMTFSeqB s a = STRef s FMTFSeqB

-- | State function to update 'FSTMTFSeqB' with each step of the inverse MTF.
updateFSTMTFSeqB :: FSTMTFSeqB s (Maybe ByteString)
                 -> (Maybe ByteString)
                 -> ST s ()
updateFSTMTFSeqB :: forall s.
FSTMTFSeqB s (Maybe ByteString) -> Maybe ByteString -> ST s ()
updateFSTMTFSeqB FSTMTFSeqB s (Maybe ByteString)
s Maybe ByteString
Nothing  = do
  Seq (Maybe ByteString)
s2 <- forall s a. STRef s a -> ST s a
readSTRef FSTMTFSeqB s (Maybe ByteString)
s
  forall s a. STRef s a -> a -> ST s ()
writeSTRef FSTMTFSeqB s (Maybe ByteString)
s (Seq (Maybe ByteString)
s2 forall a. Seq a -> a -> Seq a
DS.|> forall a. Maybe a
Nothing)
updateFSTMTFSeqB FSTMTFSeqB s (Maybe ByteString)
s (Just ByteString
e) = do
  Seq (Maybe ByteString)
s2 <- forall s a. STRef s a -> ST s a
readSTRef FSTMTFSeqB s (Maybe ByteString)
s
  forall s a. STRef s a -> a -> ST s ()
writeSTRef FSTMTFSeqB s (Maybe ByteString)
s (Seq (Maybe ByteString)
s2 forall a. Seq a -> a -> Seq a
DS.|> (forall a. a -> Maybe a
Just ByteString
e))

-- | State function to create empty 'FSTMTFSeqB' type.
emptyFSTMTFSeqB :: ST s (FSTMTFSeqB s a)
emptyFSTMTFSeqB :: forall s a. ST s (STMTFILB s a)
emptyFSTMTFSeqB = forall a s. a -> ST s (STRef s a)
newSTRef forall a. Seq a
DS.empty

-- | Abstract 'FSTMTFILB' and associated state type.
type FSTMTFILB s a = STRef s (Seq (Maybe ByteString))

-- | State function to load list into 'FSTMTFILB'.
loadFSTMTFILB :: FSTMTFILB s (Maybe ByteString) -> Seq (Maybe ByteString) -> ST s ()
loadFSTMTFILB :: forall s.
STMTFILB s (Maybe ByteString) -> Seq (Maybe ByteString) -> ST s ()
loadFSTMTFILB FSTMTFILB s (Maybe ByteString)
s Seq (Maybe ByteString)
e = forall s a. STRef s a -> a -> ST s ()
writeSTRef FSTMTFILB s (Maybe ByteString)
s Seq (Maybe ByteString)
e

-- | State function to update 'FSTMTFILB'.
updateFSTMTFILB :: FSTMTFILB s (Maybe ByteString)
                -> Int
                -> ST s ()
updateFSTMTFILB :: forall s. FSTMTFILB s (Maybe ByteString) -> Int -> ST s ()
updateFSTMTFILB FSTMTFILB s (Maybe ByteString)
s Int
i = do
  Seq (Maybe ByteString)
s2 <- forall s a. STRef s a -> ST s a
readSTRef FSTMTFILB s (Maybe ByteString)
s
  let newheade :: Maybe ByteString
newheade = forall a. Seq a -> Int -> a
DS.index Seq (Maybe ByteString)
s2 Int
i
  forall s a. STRef s a -> a -> ST s ()
writeSTRef FSTMTFILB s (Maybe ByteString)
s (forall a. Int -> Seq a -> Seq a
DS.deleteAt Int
i Seq (Maybe ByteString)
s2)
  Seq (Maybe ByteString)
ns2 <- forall s a. STRef s a -> ST s a
readSTRef FSTMTFILB s (Maybe ByteString)
s 
  forall s a. STRef s a -> a -> ST s ()
writeSTRef FSTMTFILB s (Maybe ByteString)
s (Maybe ByteString
newheade forall a. a -> Seq a -> Seq a
DS.<| Seq (Maybe ByteString)
ns2)

-- | State function to create empty 'FSTMTFILB' type.
emptyFSTMTFILB :: ST s (FSTMTFILB s a)
emptyFSTMTFILB :: forall s a. ST s (STMTFILB s a)
emptyFSTMTFILB = forall a s. a -> ST s (STRef s a)
newSTRef forall a. Seq a
DS.empty

-- | Strict state monad function.
seqFromMTFB :: MTFB
            -> ST s FMTFSeqB
seqFromMTFB :: forall s. MTFB -> ST s (Seq (Maybe ByteString))
seqFromMTFB (MTFB (Seq Int
DS.Empty,Seq (Maybe ByteString)
_)) = do
  FSTMTFSeqB s Any
fbmtfseqstackempty  <- forall s a. ST s (STMTFILB s a)
emptyFSTMTFSeqB
  Seq (Maybe ByteString)
fbmtfseqstackemptyr <- forall s a. STRef s a -> ST s a
readSTRef FSTMTFSeqB s Any
fbmtfseqstackempty
  forall (m :: * -> *) a. Monad m => a -> m a
return Seq (Maybe ByteString)
fbmtfseqstackemptyr
seqFromMTFB (MTFB (Seq Int
_,Seq (Maybe ByteString)
DS.Empty)) = do
  FSTMTFSeqB s Any
fbmtfseqstackempty  <- forall s a. ST s (STMTFILB s a)
emptyFSTMTFSeqB
  Seq (Maybe ByteString)
fbmtfseqstackemptyr <- forall s a. STRef s a -> ST s a
readSTRef FSTMTFSeqB s Any
fbmtfseqstackempty
  forall (m :: * -> *) a. Monad m => a -> m a
return Seq (Maybe ByteString)
fbmtfseqstackemptyr
seqFromMTFB MTFB
xs                  = do
  let xss :: (Seq Int, Seq (Maybe ByteString))
xss = (\(MTFB (Seq Int, Seq (Maybe ByteString))
b) -> (Seq Int, Seq (Maybe ByteString))
b) MTFB
xs
  FSTMTFSeqB s Any
fbmtfseqstack     <- forall s a. ST s (STMTFILB s a)
emptyFSTMTFSeqB 
  FSTMTFSeqB s Any
fbmtfinitiallist  <- forall s a. ST s (STMTFILB s a)
emptyFSTMTFILB
  let il :: Seq (Maybe ByteString)
il = forall a. Ord a => Seq (Maybe a) -> Seq (Maybe a)
nubSeq' (forall a b. (a, b) -> b
snd (Seq Int, Seq (Maybe ByteString))
xss)
  forall s.
STMTFILB s (Maybe ByteString) -> Seq (Maybe ByteString) -> ST s ()
loadFSTMTFILB FSTMTFSeqB s Any
fbmtfinitiallist
                Seq (Maybe ByteString)
il
  forall {s}.
Seq Int
-> STRef s (Seq (Maybe ByteString))
-> STRef s (Seq (Maybe ByteString))
-> ST s ()
iFMTFB (forall a b. (a, b) -> a
fst (Seq Int, Seq (Maybe ByteString))
xss)
         FSTMTFSeqB s Any
fbmtfinitiallist
         FSTMTFSeqB s Any
fbmtfseqstack
  Seq (Maybe ByteString)
fbmtfseqstackr <- forall s a. STRef s a -> ST s a
readSTRef FSTMTFSeqB s Any
fbmtfseqstack
  forall (m :: * -> *) a. Monad m => a -> m a
return Seq (Maybe ByteString)
fbmtfseqstackr
    where
      iFMTFB :: Seq Int
-> STRef s (Seq (Maybe ByteString))
-> STRef s (Seq (Maybe ByteString))
-> ST s ()
iFMTFB Seq Int
DS.Empty      STRef s (Seq (Maybe ByteString))
_       STRef s (Seq (Maybe ByteString))
_       = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      iFMTFB (Int
y DS.:<| Seq Int
ys) STRef s (Seq (Maybe ByteString))
fbmtfil STRef s (Seq (Maybe ByteString))
fbmtfss = do
        Seq (Maybe ByteString)
cfbmtfil <- forall s a. STRef s a -> ST s a
readSTRef STRef s (Seq (Maybe ByteString))
fbmtfil
        forall s.
FSTMTFSeqB s (Maybe ByteString) -> Maybe ByteString -> ST s ()
updateFSTMTFSeqB STRef s (Seq (Maybe ByteString))
fbmtfss
                         (forall a. Seq a -> Int -> a
DS.index Seq (Maybe ByteString)
cfbmtfil Int
y)
        forall s. FSTMTFILB s (Maybe ByteString) -> Int -> ST s ()
updateFSTMTFILB STRef s (Seq (Maybe ByteString))
fbmtfil
                        Int
y 
        Seq Int
-> STRef s (Seq (Maybe ByteString))
-> STRef s (Seq (Maybe ByteString))
-> ST s ()
iFMTFB Seq Int
ys
               STRef s (Seq (Maybe ByteString))
fbmtfil
               STRef s (Seq (Maybe ByteString))
fbmtfss

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


{-fromRLE (Text) functions.-}

-- | Abstract 'FMTFSeqT' type utilizing a 'Seq'.
type FMTFSeqT = Seq (Maybe Text)

-- | Abstract data type representing a 'FMTFSeqT' in the (strict) ST monad.
type FSTMTFSeqT s a = STRef s FMTFSeqT

-- | State function to update 'FSTMTFSeqT' with each step of the inverse MTF.
updateFSTMTFSeqT :: FSTMTFSeqT s (Maybe Text)
                 -> (Maybe Text)
                 -> ST s ()
updateFSTMTFSeqT :: forall s. FSTMTFSeqT s (Maybe Text) -> Maybe Text -> ST s ()
updateFSTMTFSeqT FSTMTFSeqT s (Maybe Text)
s Maybe Text
Nothing  = do
  Seq (Maybe Text)
s2 <- forall s a. STRef s a -> ST s a
readSTRef FSTMTFSeqT s (Maybe Text)
s
  forall s a. STRef s a -> a -> ST s ()
writeSTRef FSTMTFSeqT s (Maybe Text)
s (Seq (Maybe Text)
s2 forall a. Seq a -> a -> Seq a
DS.|> forall a. Maybe a
Nothing)
updateFSTMTFSeqT FSTMTFSeqT s (Maybe Text)
s (Just Text
e) = do
  Seq (Maybe Text)
s2 <- forall s a. STRef s a -> ST s a
readSTRef FSTMTFSeqT s (Maybe Text)
s
  forall s a. STRef s a -> a -> ST s ()
writeSTRef FSTMTFSeqT s (Maybe Text)
s (Seq (Maybe Text)
s2 forall a. Seq a -> a -> Seq a
DS.|> (forall a. a -> Maybe a
Just Text
e))

-- | State function to create empty 'FSTMTFSeqT' type.
emptyFSTMTFSeqT :: ST s (FSTMTFSeqT s a)
emptyFSTMTFSeqT :: forall s a. ST s (STMTFILT s a)
emptyFSTMTFSeqT = forall a s. a -> ST s (STRef s a)
newSTRef forall a. Seq a
DS.empty

-- | Abstract 'FSTMTFILT' and associated state type.
type FSTMTFILT s a = STRef s (Seq (Maybe Text))

-- | State function to load list into 'FSTMTFILT'.
loadFSTMTFILT :: FSTMTFILT s (Maybe Text)
              -> Seq (Maybe Text)
              -> ST s ()
loadFSTMTFILT :: forall s. STMTFILT s (Maybe Text) -> Seq (Maybe Text) -> ST s ()
loadFSTMTFILT FSTMTFILT s (Maybe Text)
s Seq (Maybe Text)
e = forall s a. STRef s a -> a -> ST s ()
writeSTRef FSTMTFILT s (Maybe Text)
s Seq (Maybe Text)
e

-- | State function to update 'FSTMTFILT'.
updateFSTMTFILT :: FSTMTFILT s (Maybe Text)
                -> Int
                -> ST s ()
updateFSTMTFILT :: forall s. FSTMTFILT s (Maybe Text) -> Int -> ST s ()
updateFSTMTFILT FSTMTFILT s (Maybe Text)
s Int
i = do
  Seq (Maybe Text)
s2 <- forall s a. STRef s a -> ST s a
readSTRef FSTMTFILT s (Maybe Text)
s
  let newheade :: Maybe Text
newheade = forall a. Seq a -> Int -> a
DS.index Seq (Maybe Text)
s2 Int
i
  forall s a. STRef s a -> a -> ST s ()
writeSTRef FSTMTFILT s (Maybe Text)
s (forall a. Int -> Seq a -> Seq a
DS.deleteAt Int
i Seq (Maybe Text)
s2)
  Seq (Maybe Text)
ns2 <- forall s a. STRef s a -> ST s a
readSTRef FSTMTFILT s (Maybe Text)
s
  forall s a. STRef s a -> a -> ST s ()
writeSTRef FSTMTFILT s (Maybe Text)
s (Maybe Text
newheade forall a. a -> Seq a -> Seq a
DS.<| Seq (Maybe Text)
ns2)

-- | State function to create empty 'FSTMTFILT' type.
emptyFSTMTFILT :: ST s (FSTMTFILT s a)
emptyFSTMTFILT :: forall s a. ST s (STMTFILT s a)
emptyFSTMTFILT = forall a s. a -> ST s (STRef s a)
newSTRef forall a. Seq a
DS.empty

-- | Strict state monad function.
seqFromMTFT :: MTFT
            -> ST s FMTFSeqT
seqFromMTFT :: forall s. MTFT -> ST s (Seq (Maybe Text))
seqFromMTFT (MTFT (Seq Int
DS.Empty,Seq (Maybe Text)
_)) = do
  FSTMTFSeqT s Any
ftmtfseqstackempty  <- forall s a. ST s (STMTFILT s a)
emptyFSTMTFSeqT
  Seq (Maybe Text)
ftmtfseqstackemptyr <- forall s a. STRef s a -> ST s a
readSTRef FSTMTFSeqT s Any
ftmtfseqstackempty
  forall (m :: * -> *) a. Monad m => a -> m a
return Seq (Maybe Text)
ftmtfseqstackemptyr
seqFromMTFT (MTFT (Seq Int
_,Seq (Maybe Text)
DS.Empty)) = do
  FSTMTFSeqT s Any
ftmtfseqstackempty  <- forall s a. ST s (STMTFILT s a)
emptyFSTMTFSeqT
  Seq (Maybe Text)
ftmtfseqstackemptyr <- forall s a. STRef s a -> ST s a
readSTRef FSTMTFSeqT s Any
ftmtfseqstackempty
  forall (m :: * -> *) a. Monad m => a -> m a
return Seq (Maybe Text)
ftmtfseqstackemptyr
seqFromMTFT MTFT
xs                  = do
  let xss :: (Seq Int, Seq (Maybe Text))
xss = (\(MTFT (Seq Int, Seq (Maybe Text))
t) -> (Seq Int, Seq (Maybe Text))
t) MTFT
xs
  FSTMTFSeqT s Any
ftmtfseqstack     <- forall s a. ST s (STMTFILT s a)
emptyFSTMTFSeqT
  FSTMTFSeqT s Any
ftmtfinitiallist  <- forall s a. ST s (STMTFILT s a)
emptyFSTMTFILT
  let il :: Seq (Maybe Text)
il = forall a. Ord a => Seq (Maybe a) -> Seq (Maybe a)
nubSeq' (forall a b. (a, b) -> b
snd (Seq Int, Seq (Maybe Text))
xss)
  forall s. STMTFILT s (Maybe Text) -> Seq (Maybe Text) -> ST s ()
loadFSTMTFILT FSTMTFSeqT s Any
ftmtfinitiallist
                Seq (Maybe Text)
il
  forall {s}.
Seq Int
-> STRef s (Seq (Maybe Text))
-> STRef s (Seq (Maybe Text))
-> ST s ()
iFMTFT (forall a b. (a, b) -> a
fst (Seq Int, Seq (Maybe Text))
xss)
         FSTMTFSeqT s Any
ftmtfinitiallist
         FSTMTFSeqT s Any
ftmtfseqstack
  Seq (Maybe Text)
ftmtfseqstackr <- forall s a. STRef s a -> ST s a
readSTRef FSTMTFSeqT s Any
ftmtfseqstack
  forall (m :: * -> *) a. Monad m => a -> m a
return Seq (Maybe Text)
ftmtfseqstackr
    where
      iFMTFT :: Seq Int
-> STRef s (Seq (Maybe Text))
-> STRef s (Seq (Maybe Text))
-> ST s ()
iFMTFT Seq Int
DS.Empty      STRef s (Seq (Maybe Text))
_       STRef s (Seq (Maybe Text))
_       = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      iFMTFT (Int
y DS.:<| Seq Int
ys) STRef s (Seq (Maybe Text))
ftmtfil STRef s (Seq (Maybe Text))
ftmtfss = do
        Seq (Maybe Text)
cftmtfil <- forall s a. STRef s a -> ST s a
readSTRef STRef s (Seq (Maybe Text))
ftmtfil
        forall s. FSTMTFSeqT s (Maybe Text) -> Maybe Text -> ST s ()
updateFSTMTFSeqT STRef s (Seq (Maybe Text))
ftmtfss
                         (forall a. Seq a -> Int -> a
DS.index Seq (Maybe Text)
cftmtfil Int
y)
        forall s. FSTMTFILT s (Maybe Text) -> Int -> ST s ()
updateFSTMTFILT STRef s (Seq (Maybe Text))
ftmtfil
                        Int
y
        Seq Int
-> STRef s (Seq (Maybe Text))
-> STRef s (Seq (Maybe Text))
-> ST s ()
iFMTFT Seq Int
ys
               STRef s (Seq (Maybe Text))
ftmtfil
               STRef s (Seq (Maybe Text))
ftmtfss

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