packages feed

text-compression 0.1.0.8 → 0.1.0.9

raw patch · 6 files changed

+363/−414 lines, 6 filesdep −vectordep −vector-algorithmsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: vector, vector-algorithms

API changes (from Hackage documentation)

- Data.BWT.Internal: emptySTBWTVec :: ST s (STBWTVec s a)
- Data.BWT.Internal: instance (Data.Vector.Unboxed.Base.Unbox a, GHC.Classes.Eq a) => GHC.Classes.Eq (Data.BWT.Internal.Suffix a)
- Data.BWT.Internal: instance (Data.Vector.Unboxed.Base.Unbox a, GHC.Classes.Ord a) => GHC.Classes.Ord (Data.BWT.Internal.Suffix a)
- Data.BWT.Internal: instance (GHC.Read.Read a, Data.Vector.Unboxed.Base.Unbox a) => GHC.Read.Read (Data.BWT.Internal.Suffix a)
- Data.BWT.Internal: instance (GHC.Show.Show a, Data.Vector.Unboxed.Base.Unbox a) => GHC.Show.Show (Data.BWT.Internal.Suffix a)
- Data.BWT.Internal: pushSTBWTVec :: STBWTVec s a -> a -> ST s ()
- Data.BWT.Internal: sortVecBWT :: Ord a => Vector (a, Int) -> Vector (a, Int)
- Data.BWT.Internal: sortVecSA :: Ord a => Vector (Int, a) -> Vector (Int, a)
- Data.BWT.Internal: tailsV :: Unbox a => Vector a -> [Vector a]
- Data.BWT.Internal: type BWTVec a = Vector a
- Data.BWT.Internal: type STBWTVec s a = STRef s (BWTVec a)
- Data.RLE.Internal: emptyFSTRLEVecB :: ST s (FSTRLEVecB s a)
- Data.RLE.Internal: emptyFSTRLEVecT :: ST s (FSTRLEVecT s a)
- Data.RLE.Internal: emptySTRLEVecB :: ST s (STRLEVecB s a)
- Data.RLE.Internal: emptySTRLEVecT :: ST s (STRLEVecT s a)
- Data.RLE.Internal: pushFSTRLEVecB :: FSTRLEVecB s (Maybe ByteString) -> Maybe ByteString -> ST s ()
- Data.RLE.Internal: pushFSTRLEVecT :: FSTRLEVecT s (Maybe Text) -> Maybe Text -> ST s ()
- Data.RLE.Internal: pushSTRLEVecB :: STRLEVecB s (Maybe ByteString) -> Maybe ByteString -> ST s ()
- Data.RLE.Internal: pushSTRLEVecT :: STRLEVecT s (Maybe Text) -> Maybe Text -> ST s ()
- Data.RLE.Internal: type FRLEVecB = Vector (Maybe ByteString)
- Data.RLE.Internal: type FRLEVecT = Vector (Maybe Text)
- Data.RLE.Internal: type FSTRLEVecB s a = STRef s FRLEVecB
- Data.RLE.Internal: type FSTRLEVecT s a = STRef s FRLEVecT
- Data.RLE.Internal: type RLEVecB = Vector (Maybe ByteString)
- Data.RLE.Internal: type RLEVecT = Vector (Maybe Text)
- Data.RLE.Internal: type STRLEVecB s a = STRef s RLEVecB
- Data.RLE.Internal: type STRLEVecT s a = STRef s RLEVecT
- Data.RLE.Internal: unconsb2 :: Vector a -> Maybe (a, Vector a, Maybe (Vector a))
- Data.RLE.Internal: unconst2 :: Vector a -> Maybe (a, Vector a, Maybe (Vector a))
- Data.RLE.Internal: vecFromRLEB :: RLEB -> ST s FRLEVecB
- Data.RLE.Internal: vecFromRLET :: RLET -> ST s FRLEVecT
- Data.RLE.Internal: vecToRLEB :: RLEVecB -> ST s RLEVecB
- Data.RLE.Internal: vecToRLET :: RLEVecT -> ST s RLEVecT
+ Data.BWT.Internal: emptySTBWTSeq :: ST s (STBWTSeq s a)
+ Data.BWT.Internal: instance GHC.Classes.Eq a => GHC.Classes.Eq (Data.BWT.Internal.Suffix a)
+ Data.BWT.Internal: instance GHC.Classes.Ord a => GHC.Classes.Ord (Data.BWT.Internal.Suffix a)
+ Data.BWT.Internal: instance GHC.Read.Read a => GHC.Read.Read (Data.BWT.Internal.Suffix a)
+ Data.BWT.Internal: instance GHC.Show.Show a => GHC.Show.Show (Data.BWT.Internal.Suffix a)
+ Data.BWT.Internal: pushSTBWTSeq :: STBWTSeq s a -> a -> ST s ()
+ Data.BWT.Internal: type BWTSeq a = Seq a
+ Data.BWT.Internal: type STBWTSeq s a = STRef s (BWTSeq a)
+ Data.RLE.Internal: emptyFSTRLESeqB :: ST s (FSTRLESeqB s a)
+ Data.RLE.Internal: emptyFSTRLESeqT :: ST s (FSTRLESeqT s a)
+ Data.RLE.Internal: emptySTRLESeqB :: ST s (STRLESeqB s a)
+ Data.RLE.Internal: emptySTRLESeqT :: ST s (STRLESeqT s a)
+ Data.RLE.Internal: pushFSTRLESeqB :: FSTRLESeqB s (Maybe ByteString) -> Maybe ByteString -> ST s ()
+ Data.RLE.Internal: pushFSTRLESeqT :: FSTRLESeqT s (Maybe Text) -> Maybe Text -> ST s ()
+ Data.RLE.Internal: pushSTRLESeqB :: STRLESeqB s (Maybe ByteString) -> Maybe ByteString -> ST s ()
+ Data.RLE.Internal: pushSTRLESeqT :: STRLESeqT s (Maybe Text) -> Maybe Text -> ST s ()
+ Data.RLE.Internal: seqFromRLEB :: RLEB -> ST s FRLESeqB
+ Data.RLE.Internal: seqFromRLET :: RLET -> ST s FRLESeqT
+ Data.RLE.Internal: seqToRLEB :: RLESeqB -> ST s RLESeqB
+ Data.RLE.Internal: seqToRLET :: RLESeqT -> ST s RLESeqT
+ Data.RLE.Internal: type FRLESeqB = Seq (Maybe ByteString)
+ Data.RLE.Internal: type FRLESeqT = Seq (Maybe Text)
+ Data.RLE.Internal: type FSTRLESeqB s a = STRef s FRLESeqB
+ Data.RLE.Internal: type FSTRLESeqT s a = STRef s FRLESeqT
+ Data.RLE.Internal: type RLESeqB = Seq (Maybe ByteString)
+ Data.RLE.Internal: type RLESeqT = Seq (Maybe Text)
+ Data.RLE.Internal: type STRLESeqB s a = STRef s RLESeqB
+ Data.RLE.Internal: type STRLESeqT s a = STRef s RLESeqT
- Data.BWT: toBWT :: (Unbox a, Ord a) => [a] -> BWT a
+ Data.BWT: toBWT :: Ord a => [a] -> BWT a
- Data.BWT.Internal: BWT :: Vector (Maybe a) -> BWT a
+ Data.BWT.Internal: BWT :: Seq (Maybe a) -> BWT a
- Data.BWT.Internal: Suffix :: Int -> Int -> Maybe (Vector a) -> Suffix a
+ Data.BWT.Internal: Suffix :: Int -> Int -> Maybe (Seq a) -> Suffix a
- Data.BWT.Internal: [suffix] :: Suffix a -> Maybe (Vector a)
+ Data.BWT.Internal: [suffix] :: Suffix a -> Maybe (Seq a)
- Data.BWT.Internal: createSuffixArray :: (Unbox a, Ord a) => Vector a -> SuffixArray a
+ Data.BWT.Internal: createSuffixArray :: Ord a => Seq a -> SuffixArray a
- Data.BWT.Internal: magicInverseBWT :: Vector (Maybe a, Int) -> ST s (BWTVec a)
+ Data.BWT.Internal: magicInverseBWT :: Seq (Maybe a, Int) -> ST s (BWTSeq a)
- Data.BWT.Internal: saToBWT :: Unbox a => SuffixArray a -> Vector a -> BWT a
+ Data.BWT.Internal: saToBWT :: SuffixArray a -> Seq a -> Seq (Maybe a)
- Data.BWT.Internal: type SuffixArray a = Vector (Suffix a)
+ Data.BWT.Internal: type SuffixArray a = Seq (Suffix a)
- Data.RLE: bytestringFromRLEB :: RLEB -> Vector (Maybe ByteString)
+ Data.RLE: bytestringFromRLEB :: RLEB -> Seq (Maybe ByteString)
- Data.RLE: bytestringFromRLET :: RLET -> Vector (Maybe ByteString)
+ Data.RLE: bytestringFromRLET :: RLET -> Seq (Maybe ByteString)
- Data.RLE: bytestringToRLEB :: Vector (Maybe ByteString) -> RLEB
+ Data.RLE: bytestringToRLEB :: Seq (Maybe ByteString) -> RLEB
- Data.RLE: bytestringToRLET :: Vector (Maybe ByteString) -> RLET
+ Data.RLE: bytestringToRLET :: Seq (Maybe ByteString) -> RLET
- Data.RLE: textFromRLEB :: RLEB -> Vector (Maybe Text)
+ Data.RLE: textFromRLEB :: RLEB -> Seq (Maybe Text)
- Data.RLE: textFromRLET :: RLET -> Vector (Maybe Text)
+ Data.RLE: textFromRLET :: RLET -> Seq (Maybe Text)
- Data.RLE: textToRLEB :: Vector (Maybe Text) -> RLEB
+ Data.RLE: textToRLEB :: Seq (Maybe Text) -> RLEB
- Data.RLE: textToRLET :: Vector (Maybe Text) -> RLET
+ Data.RLE: textToRLET :: Seq (Maybe Text) -> RLET
- Data.RLE.Internal: RLEB :: Vector (Maybe ByteString) -> RLEB
+ Data.RLE.Internal: RLEB :: Seq (Maybe ByteString) -> RLEB
- Data.RLE.Internal: RLET :: Vector (Maybe Text) -> RLET
+ Data.RLE.Internal: RLET :: Seq (Maybe Text) -> RLET

Files

CHANGELOG.md view
@@ -35,3 +35,7 @@ ## 0.1.0.8 -- 2022-11-11  * Optimized BWT and RLE implementations by switching out sequences with vectors.++## 0.1.0.9 -- 2022-11-12++* Switching back to sequences for maintainability (for now).
src/Data/BWT.hs view
@@ -30,29 +30,28 @@ import Control.Monad.State.Strict() import Data.ByteString as BS (ByteString,concat,pack,unpack) import Data.Foldable as DFold (toList)+import Data.Sequence as DS (Seq(..),fromList,iterateN,length,unstableSortBy,zip) import Data.STRef() import Data.Text (Text) import Data.Text.Encoding as DTE (decodeUtf8,encodeUtf8)-import Data.Vector as DVB (empty,iterateN,length,zip)-import Data.Vector.Unboxed as DVU (Unbox,fromList) import Data.Word (Word8)-import GHC.Generics (Generic)+import GHC.Generics(Generic)   {-toBWT Function(s)-}  -- | Takes a String and returns the Burrows-Wheeler Transform (BWT). -- Implemented via a 'SuffixArray'.-toBWT :: (Unbox a,Ord a)-      => [a]-      -> BWT a-toBWT [] = BWT DVB.empty+toBWT :: Ord a =>+         [a]   ->+         BWT a+toBWT [] = BWT DS.Empty toBWT xs = do   let saxs = createSuffixArray xss-  saToBWT saxs-          xss+  BWT (saToBWT saxs+               xss)     where-      xss = DVU.fromList xs+      xss = DS.fromList xs  -- | Helper function for converting a 'ByteString' -- to a 'BWT' 'Word8'.@@ -81,16 +80,17 @@ -- This function utilizes the state monad (strict) in order -- to implement the [Magic](https://www.youtube.com/watch?v=QwSsppKrCj4) Inverse BWT algorithm by backtracking -- indices starting with the (__Nothing__,_) entry.-fromBWT :: Ord a-        => BWT a-        -> [a]+fromBWT :: Ord a =>+           BWT a ->+           [a] fromBWT bwt = do   let originall = CMST.runST $ magicInverseBWT magicsz   DFold.toList originall     where-      magicsz = sortVecBWT zipped-      zipped  = DVB.zip bwtt-                        (DVB.iterateN (DVB.length bwtt) (+1) 0)+      magicsz = DS.unstableSortBy (\(a,b) (c,d) -> sortTB (a,b) (c,d))+                zipped+      zipped  = DS.zip bwtt+                       (DS.iterateN (DS.length bwtt) (+1) 0)       bwtt    = (\(BWT t) -> t) bwt  -- | Helper function for converting a 'BWT' of 'Word8's
src/Data/BWT/Internal.hs view
@@ -33,28 +33,25 @@ -- Various data structures and custom data types to describe the Burrows-Wheeler Transform (BWT) -- and the Inverse BWT. ----- The implementation of the BWT relies upon Boxed vectors, 'DVB.Vector', and Unboxed vectors, 'DVU.Vector',--- provided by the [vector](https://hackage.haskell.org/package/vector).+-- The implementation of the BWT relies upon sequence provided+-- by the [containers](https://hackage.haskell.org/package/containers). -- -- The internal 'BWTMatrix' data type relies upon the [massiv](https://hackage.haskell.org/package/massiv) package.   module Data.BWT.Internal where -import Control.Monad as CM (when)-import Control.Monad.ST as CMST (ST,runST)+import Control.Monad as CM+import Control.Monad.ST as CMST import Control.Monad.State.Strict() import Data.Foldable as DFold-import Data.List as DL (length,map)+import Data.List as DL import Data.Maybe as DMaybe (fromJust,isNothing)-import Data.Sequence as DS (fromList,(><),null,singleton,zip,sortBy,tails,inits)+import Data.Sequence as DS (Seq(..),empty,findIndexL,fromList,length,index,inits,null,singleton,tails,unstableSortBy,unstableSortOn,zip,(><),(|>),(<|)) import Data.Massiv.Array as DMA import Data.Massiv.Core()-import Data.STRef as DSTR (STRef,newSTRef,readSTRef,writeSTRef)-import Data.Vector as DVB (Vector,empty,findIndex,fromList,iterateN,map,snoc,thaw,unsafeFreeze,zip,uncons,(!))-import Data.Vector.Algorithms.Tim as DVAT (sortBy)-import Data.Vector.Unboxed as DVU (Vector,empty,null,tail,uncons,(!))-import GHC.Generics (Generic)+import Data.STRef as DSTR+import GHC.Generics import Prelude as P  @@ -64,19 +61,20 @@ -- the core data inside of the 'SuffixArray' data type. data Suffix a = Suffix { suffixindex    :: Int                        , suffixstartpos :: Int-                       , suffix         :: Maybe (DVU.Vector a)+                       , suffix         :: Maybe (Seq a)                        }   deriving (Show,Read,Eq,Ord,Generic)  -- | The SuffixArray data type.--- Uses 'DVB.Vector' internally.-type SuffixArray a = DVB.Vector (Suffix a)+-- Uses sequence internally.+type SuffixArray a = Seq (Suffix a)  -- | The BWT data type.--- Uses 'DVU.Vector' internally.-newtype BWT a = BWT (DVB.Vector (Maybe a))+-- Uses sequence internally.+newtype BWT a = BWT (Seq (Maybe a))   deriving (Eq,Ord,Show,Read,Generic) + -- | The BWTMatrix data type. -- Uses a massiv array internally. type BWTMatrix = DMA.Array BN Ix1 String@@ -87,80 +85,46 @@ {-toBWT functions.-}  -- | Computes the Burrows-Wheeler Transform (BWT) using the suffix array--- and the original string (represented as a 'DVB.Vector' for performance).-saToBWT :: Unbox a-        => SuffixArray a-        -> DVU.Vector a-        -> BWT a-saToBWT (DVB.uncons -> Nothing) _ = BWT DVB.empty-saToBWT vs                      t =-  BWT-    (DVB.map (\v -> if | suffixstartpos v /= 1-                       -> Just $-                          (DVU.!) t (suffixstartpos v - 1 - 1)-                       | otherwise-                       -> Nothing-             )-     vs)---- | 'DVU.Vector' based implementation of the--- well-known tails function in the List library.-tailsV :: Unbox a-       => DVU.Vector a-       -> [DVU.Vector a]-tailsV (DVU.uncons -> Nothing) = [DVU.empty]-tailsV vs                      =-  vs : (tailsV (DVU.tail vs))---- | Custom sort function for 'DVB.Vector's--- used in the 'createSuffixArray' function.-sortVecSA :: Ord a-          => DVB.Vector (Int,a)-          -> DVB.Vector (Int,a)-sortVecSA vs =-  CMST.runST-    (do mv <- DVB.thaw vs-        DVAT.sortBy (\(_,b) (_,d) -> compare b d) mv-        DVB.unsafeFreeze mv)---- | Custom sort function for 'DVB.Vector's--- used in the fromBWT function.-sortVecBWT :: Ord a-           => DVB.Vector (a,Int)-           -> DVB.Vector (a,Int)-sortVecBWT vs =-  CMST.runST-    (do mv <- DVB.thaw vs-        DVAT.sortBy (\(a,b) (c,d) -> sortTB (a,b) (c,d)) mv-        DVB.unsafeFreeze mv) +-- and the original string (represented as a sequence for performance).+saToBWT :: SuffixArray a ->+           Seq a         ->+           Seq (Maybe a)+saToBWT DS.Empty      _ = DS.Empty+saToBWT (y DS.:<| ys) t =+  if | suffixstartpos y /= 1+     -> (Just $ DS.index t (suffixstartpos y - 1 - 1))+        DS.<| (saToBWT ys t)+     | otherwise+     -> Nothing+        DS.<| (saToBWT ys t)  -- | Computes the corresponding 'SuffixArray' of a given string. Please see [suffix array](https://en.wikipedia.org/wiki/Suffix_array)--- for more information.-createSuffixArray :: (Unbox a,Ord a)-                    => DVU.Vector a -                    -> SuffixArray a-createSuffixArray vs =-  DVB.map (\(a,b,c) -> if | not $ DVU.null c-                          -> Suffix { suffixindex    = a-                                    , suffixstartpos = b-                                    , suffix         = Just c-                                    }-                          | otherwise-                          -> Suffix { suffixindex    = a-                                    , suffixstartpos = b-                                    , suffix         = Nothing-                                    }-          )-  vssuffixesfff+-- for more information. +createSuffixArray :: Ord a =>+                     Seq a ->+                     SuffixArray a+createSuffixArray xs =+  fmap (\(a,b,c) -> if | not $ DS.null c+                       -> Suffix { suffixindex    = a+                                 , suffixstartpos = b+                                 , suffix         = Just c+                                 }+                       | otherwise+                       -> Suffix { suffixindex    = a+                                 , suffixstartpos = b+                                 , suffix         = Nothing+                                 }+       )+  xsssuffixesfff     where-      vssuffixes         = tailsV vs-      vssuffixesf        = DVB.zip (DVB.iterateN (DL.length vssuffixes) (+1) 1 :: DVB.Vector Int)-                                   (DVB.fromList vssuffixes)-      vssuffixesffsorted = sortVecSA vssuffixesf-      vssuffixesfff      = (\(a,(b,c)) -> (a,b,c))-                           <$>-                           DVB.zip (DVB.iterateN (DL.length vssuffixesffsorted) (+1) 1 :: DVB.Vector Int)-                                   vssuffixesffsorted +      xsssuffixes         = DS.tails xs+      xsssuffixesf        = DS.zip (DS.fromList [1..(DS.length xsssuffixes)])+                                   xsssuffixes+      xsssuffixesffsorted = DS.unstableSortOn snd xsssuffixesf+      xsssuffixesfff      = (\(a,(b,c)) -> (a,b,c))+                            <$>+                            DS.zip (DS.fromList [1..(DS.length xsssuffixesffsorted)])+                                   xsssuffixesffsorted  {------------------} @@ -178,20 +142,20 @@                          compare i1 i2  -- | Abstract BWTSeq type utilizing a sequence.-type BWTVec a = DVB.Vector a+type BWTSeq a = Seq a --- | Abstract data type representing a 'BWTVec' in the (strict) ST monad.-type STBWTVec s a = STRef s (BWTVec a)+-- | Abstract data type representing a BWTSeq in the (strict) ST monad.+type STBWTSeq s a = STRef s (BWTSeq a) --- | State function to push 'BWTVec' data into stack.-pushSTBWTVec :: STBWTVec s a -> a -> ST s ()-pushSTBWTVec s e = do+-- | State function to push BWTString data into stack.+pushSTBWTSeq :: STBWTSeq s a -> a -> ST s ()+pushSTBWTSeq s e = do   s2 <- readSTRef s-  writeSTRef s (DVB.snoc s2 e)+  writeSTRef s (s2 DS.|> e) --- | State function to create empty 'STBWTVec' type.-emptySTBWTVec :: ST s (STBWTVec s a)-emptySTBWTVec = newSTRef DVB.empty+-- | State function to create empty STBWTString type.+emptySTBWTSeq :: ST s (STBWTSeq s a)+emptySTBWTSeq = newSTRef DS.empty  -- | Abstract BWTCounter and associated state type. type STBWTCounter s a = STRef s Int@@ -205,43 +169,43 @@ emptySTBWTCounter = newSTRef (-1)  -- | "Magic" Inverse BWT function.-magicInverseBWT :: DVB.Vector (Maybe a,Int) ->-                   ST s (BWTVec a)-magicInverseBWT (DVB.uncons -> Nothing) = do-  bwtvecstackempty  <- emptySTBWTVec-  bwtvecstackemptyr <- readSTRef bwtvecstackempty-  return bwtvecstackemptyr-magicInverseBWT xs                      = do-  bwtvecstack      <- emptySTBWTVec+magicInverseBWT :: Seq (Maybe a,Int) ->+                   ST s (BWTSeq a)+magicInverseBWT DS.Empty = do+  bwtseqstackempty  <- emptySTBWTSeq+  bwtseqstackemptyr <- readSTRef bwtseqstackempty+  return bwtseqstackemptyr+magicInverseBWT xs       = do+  bwtseqstack      <- emptySTBWTSeq   bwtcounterstackf <- emptySTBWTCounter   bwtcounterstacke <- emptySTBWTCounter-  case (DVB.findIndex (\x -> isNothing $ fst x) xs) of-    Nothing           -> do bwtvecstackr <- readSTRef bwtvecstack-                            return bwtvecstackr-    Just nothingindex -> do let nothingfirst = (DVB.!) xs+  case (DS.findIndexL (\x -> isNothing $ fst x) xs) of+    Nothing           -> do bwtseqstackr <- readSTRef bwtseqstack+                            return bwtseqstackr+    Just nothingindex -> do let nothingfirst = DS.index xs                                                         nothingindex                             updateSTBWTCounter bwtcounterstacke                                                nothingindex                             updateSTBWTCounter bwtcounterstackf                                                (snd nothingfirst)                             iBWT xs-                                 bwtvecstack+                                 bwtseqstack                                  bwtcounterstackf                                  bwtcounterstacke-                            bwtvecstackr <- readSTRef bwtvecstack-                            return bwtvecstackr+                            bwtseqstackr <- readSTRef bwtseqstack+                            return bwtseqstackr       where-        iBWT ys bwtvs bwtcsf bwtcse = do+        iBWT ys bwtss bwtcsf bwtcse = do           cbwtcsf <- readSTRef bwtcsf           cbwtcse <- readSTRef bwtcse           CM.when (cbwtcsf /= cbwtcse) $ do -            let next = (DVB.!) ys cbwtcsf-            pushSTBWTVec bwtvs+            let next = DS.index ys cbwtcsf+            pushSTBWTSeq bwtss                          (DMaybe.fromJust $ fst next)             updateSTBWTCounter bwtcsf                                (snd next)             iBWT ys-                 bwtvs+                 bwtss                  bwtcsf                  bwtcse @@ -250,7 +214,7 @@ createBWTMatrix :: String ->                    BWTMatrix createBWTMatrix t =-  DMA.fromList (ParN 0) zippedffff :: DMA.Array BN Ix1 String+  DMA.fromList (ParN 0) zippedffff :: Array BN Ix1 String     where       zippedffff = DL.map DFold.toList $                    DL.map (\(a,b) -> if | isNothing a@@ -266,7 +230,7 @@                           )                    zippedfff       zippedfff  = DFold.toList zippedff-      zippedff   = DS.sortBy (\(a,_) (c,_) -> compare a c)+      zippedff   = DS.unstableSortBy (\(a,_) (c,_) -> compare a c)                    zippedp       zippedp    = DS.zip suffixesf prefixesf       suffixesf  = fmap (\x -> if | DS.null x
src/Data/RLE.hs view
@@ -28,11 +28,10 @@ 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.Vector as DVB (Vector,empty,map,uncons)-import Data.Vector.Unboxed() import Data.Word (Word8) import Prelude as P @@ -68,7 +67,7 @@ textBWTToRLEB :: TextBWT               -> RLEB textBWTToRLEB xs =-  RLEB (CMST.runST $ vecToRLEB xss)+  RLEB (CMST.runST $ seqToRLEB xss)     where       xss = fmap (\x -> if | isNothing x                            -> Nothing@@ -84,9 +83,9 @@ -- Run-length encoding ('RLEB'). bytestringBWTToRLEB :: BWT Word8                     -> RLEB-bytestringBWTToRLEB (BWT (DVB.uncons -> Nothing)) = RLEB DVB.empty-bytestringBWTToRLEB xs                            =-  RLEB (CMST.runST $ vecToRLEB xss)+bytestringBWTToRLEB (BWT DS.Empty) = RLEB DS.Empty+bytestringBWTToRLEB xs             =+  RLEB (CMST.runST $ seqToRLEB xss)     where       xss = fmap (\x -> if | isNothing x                            -> Nothing@@ -102,7 +101,7 @@ textBWTToRLET :: TextBWT               -> RLET textBWTToRLET xs =-  RLET (CMST.runST $ vecToRLET xss)+  RLET (CMST.runST $ seqToRLET xss)     where       xss = fmap (\x -> if | isNothing x                            -> Nothing@@ -119,9 +118,9 @@ -- Run-length encoding ('RLET'). bytestringBWTToRLET :: BWT Word8                     -> RLET-bytestringBWTToRLET (BWT (DVB.uncons -> Nothing)) = RLET DVB.empty-bytestringBWTToRLET xs                            =-  RLET (CMST.runST $ vecToRLET xss)+bytestringBWTToRLET (BWT DS.Empty) = RLET DS.Empty+bytestringBWTToRLET xs             =+  RLET (CMST.runST $ seqToRLET xss)     where       xss = fmap (\x -> if | isNothing x                            -> Nothing@@ -134,11 +133,11 @@             ((\(BWT t) -> t) xs)  -- | Takes a 'Text' and returns the Run-length encoding ('RLEB').-textToRLEB :: DVB.Vector (Maybe Text)+textToRLEB :: Seq (Maybe Text)            -> RLEB-textToRLEB (DVB.uncons -> Nothing) = RLEB DVB.empty-textToRLEB xs                      = -  RLEB (CMST.runST $ vecToRLEB xss)+textToRLEB DS.Empty = RLEB DS.Empty+textToRLEB xs       = +  RLEB (CMST.runST $ seqToRLEB xss)     where       xss = fmap (\x -> if | isNothing x                            -> Nothing@@ -149,26 +148,26 @@                  )             xs --- | Takes a 'DVB.Vector' of 'ByteString's and returns the Run-length encoding ('RLEB').-bytestringToRLEB :: DVB.Vector (Maybe ByteString)+-- | Takes a 'Seq' of 'ByteString's and returns the Run-length encoding ('RLEB').+bytestringToRLEB :: Seq (Maybe ByteString)                  -> RLEB-bytestringToRLEB (DVB.uncons -> Nothing) = RLEB DVB.empty-bytestringToRLEB xs                      =- RLEB (CMST.runST $ vecToRLEB xs)+bytestringToRLEB DS.Empty = RLEB DS.Empty+bytestringToRLEB xs       =+ RLEB (CMST.runST $ seqToRLEB xs)  -- | Takes a 'Text' and returns the Run-length encoding (RLE).-textToRLET :: DVB.Vector (Maybe Text)+textToRLET :: Seq (Maybe Text)            -> RLET-textToRLET (DVB.uncons -> Nothing) = RLET DVB.empty-textToRLET xs                      =-  RLET (CMST.runST $ vecToRLET xs)+textToRLET DS.Empty = RLET DS.Empty+textToRLET xs       =+  RLET (CMST.runST $ seqToRLET xs)  -- | Takes a 'ByteString' and returns the Run-length encoding (RLE).-bytestringToRLET :: DVB.Vector (Maybe ByteString)+bytestringToRLET :: Seq (Maybe ByteString)                  -> RLET-bytestringToRLET (DVB.uncons -> Nothing) = RLET DVB.empty-bytestringToRLET xs                      =-  RLET (CMST.runST $ vecToRLET xss)+bytestringToRLET DS.Empty = RLET DS.Empty+bytestringToRLET xs       =+  RLET (CMST.runST $ seqToRLET xss)     where       xss = fmap (\x -> if | isNothing x                            -> Nothing@@ -194,17 +193,17 @@ -- back to the original 'ByteString'. bytestringFromBWTFromRLET :: RLET                           -> ByteString-bytestringFromBWTFromRLET vs = bytestringFromByteStringBWT $+bytestringFromBWTFromRLET xs = bytestringFromByteStringBWT $                                BWT                         $-                               DVB.map (\x -> if | isNothing x-                                                 -> Nothing-                                                 | otherwise-                                                 -> Just           $-                                                    DTE.encodeUtf8 $-                                                    fromJust x-                                       )-                                                           $ -                               ((\(BWT t) -> t) (textBWTFromRLET vs))+                               fmap (\x -> if | isNothing x+                                              -> Nothing+                                              | otherwise+                                              -> Just           $+                                                 DTE.encodeUtf8 $+                                                 fromJust x+                                    )+                                                           $+                            ((\(BWT t) -> t) (textBWTFromRLET xs))  -- | Helper function for converting a 'BWT'ed 'RLEB' -- back to the original 'Text'.@@ -222,92 +221,92 @@ -- the 'BWT' of 'Text's. textBWTFromRLET :: RLET                 -> BWT Text-textBWTFromRLET (RLET (DVB.uncons -> Nothing)) = BWT DVB.empty-textBWTFromRLET vs              = -  BWT (CMST.runST $ vecFromRLET vs)+textBWTFromRLET (RLET DS.Empty) = BWT DS.Empty+textBWTFromRLET xs              = +  BWT (CMST.runST $ seqFromRLET xs)  -- | Takes a 'RLET' and returns -- the 'BWT' of 'ByteString's. bytestringBWTFromRLET :: RLET                       -> BWT ByteString-bytestringBWTFromRLET (RLET (DVB.uncons -> Nothing)) = BWT DVB.empty-bytestringBWTFromRLET vs                             = do-  let originalbwtb = CMST.runST $ vecFromRLET vs-  BWT (DVB.map (\x -> if | isNothing x-                         -> Nothing-                         | otherwise-                         -> Just           $-                            DTE.encodeUtf8 $-                            fromJust x -               ) originalbwtb)+bytestringBWTFromRLET (RLET DS.Empty) = BWT DS.Empty+bytestringBWTFromRLET xs              = do+  let originalbwtb = CMST.runST $ seqFromRLET xs+  BWT (fmap (\x -> if | isNothing x+                      -> Nothing+                      | otherwise+                      -> Just           $+                         DTE.encodeUtf8 $+                        fromJust x +            ) originalbwtb)  -- | Takes a 'RLEB' and returns -- the 'BWT' of 'Text's. textBWTFromRLEB :: RLEB                 -> BWT Text-textBWTFromRLEB (RLEB (DVB.uncons -> Nothing)) = BWT DVB.empty-textBWTFromRLEB vs                             = do-  let originalbwtt = CMST.runST $ vecFromRLEB vs-  BWT (DVB.map (\x -> if | isNothing x-                         -> Nothing-                         | otherwise-                         -> Just           $-                            DTE.decodeUtf8 $-                            fromJust x-               ) originalbwtt)+textBWTFromRLEB (RLEB DS.Empty) = BWT DS.Empty+textBWTFromRLEB xs              = do+  let originalbwtt = CMST.runST $ seqFromRLEB xs+  BWT (fmap (\x -> if | isNothing x+                      -> Nothing+                      | otherwise+                      -> Just           $+                         DTE.decodeUtf8 $+                        fromJust x+            ) originalbwtt)  -- | Take a 'RLEB' and returns -- the 'BWT' of 'ByteString's. bytestringBWTFromRLEB :: RLEB                        -> BWT ByteString-bytestringBWTFromRLEB (RLEB (DVB.uncons -> Nothing)) = BWT DVB.empty-bytestringBWTFromRLEB vs                             =-  BWT (CMST.runST $ vecFromRLEB vs)+bytestringBWTFromRLEB (RLEB DS.Empty) = BWT DS.Empty+bytestringBWTFromRLEB xs              =+  BWT (CMST.runST $ seqFromRLEB xs)  -- | Takes a 'RLEB' and returns--- the original 'DVB.Vector' of 'Text's.+-- the original 'Seq' of 'Text's. textFromRLEB :: RLEB-             -> DVB.Vector (Maybe Text)-textFromRLEB (RLEB (DVB.uncons -> Nothing)) = DVB.empty-textFromRLEB vs                             = do-  let originalt = CMST.runST $ vecFromRLEB vs-  DVB.map (\x -> if | isNothing x-                    -> Nothing-                    | otherwise-                    -> Just           $-                       DTE.decodeUtf8 $-                       fromJust x-          ) originalt+             -> Seq (Maybe Text)+textFromRLEB (RLEB DS.Empty) = DS.Empty+textFromRLEB xs              = do+  let originalt = CMST.runST $ seqFromRLEB xs+  fmap (\x -> if | isNothing x+                 -> Nothing+                 | otherwise+                 -> Just           $+                    DTE.decodeUtf8 $+                    fromJust x+       ) originalt  -- | Takes a 'RLEB' and returns--- the original 'DVB.Vector' of 'ByteString's.+-- the original 'Seq' of 'ByteString's. bytestringFromRLEB :: RLEB-                   -> DVB.Vector (Maybe ByteString)-bytestringFromRLEB (RLEB (DVB.uncons -> Nothing)) = DVB.empty-bytestringFromRLEB vs                             =-  CMST.runST $ vecFromRLEB vs+                   -> Seq (Maybe ByteString)+bytestringFromRLEB (RLEB DS.Empty) = DS.Empty+bytestringFromRLEB xs              = do+  CMST.runST $ seqFromRLEB xs  -- | Takes a 'RLET' and returns--- the original 'DVB.Vector' of 'Text's.+-- the original 'Seq' of 'Text's. textFromRLET :: RLET-             -> DVB.Vector (Maybe Text)-textFromRLET (RLET (DVB.uncons -> Nothing)) = DVB.empty-textFromRLET vs                             =-  CMST.runST $ vecFromRLET vs+             -> Seq (Maybe Text)+textFromRLET (RLET DS.Empty) = DS.Empty+textFromRLET xs              = do+  CMST.runST $ seqFromRLET xs  -- | Takes a 'RLET' and returns--- the original 'DVB.Vector' of 'ByteString's.+-- the original 'Seq' of 'ByteString's. bytestringFromRLET :: RLET-                   -> DVB.Vector (Maybe ByteString)-bytestringFromRLET (RLET (DVB.uncons -> Nothing)) = DVB.empty-bytestringFromRLET vs                             = do-  let originalb = CMST.runST $ vecFromRLET vs-  DVB.map (\x -> if | isNothing x-                    -> Nothing-                    | otherwise-                    -> Just           $-                       DTE.encodeUtf8 $-                       fromJust x-          ) originalb+                   -> Seq (Maybe ByteString)+bytestringFromRLET (RLET DS.Empty) = DS.Empty+bytestringFromRLET xs              = do+  let originalb = CMST.runST $ seqFromRLET xs+  fmap (\x -> if | isNothing x+                 -> Nothing+                 | otherwise+                 -> Just           $ +                    DTE.encodeUtf8 $+                    fromJust x+       ) originalb  {---------------------}
src/Data/RLE/Internal.hs view
@@ -31,9 +31,9 @@ -- = Description -- -- Various data structures and custom data types to describe the Run-length encoding (RLE)--- and the Inverse RLE implementations, namely 'vecToRLEB', 'vecToRLET', 'vecFromRLEB', and 'vecFromRLET'.+-- and the Inverse RLE implementations, namely 'seqToRLEB', 'seqToRLET', 'seqFromRLEB', and 'seqFromRLET'. ----- The RLE implementations rely heavily upon 'DVB.Vector' provided by the [vector](https://hackage.haskell.org/package/vector) library,+-- The RLE 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. @@ -48,10 +48,10 @@ import Data.ByteString.Internal() import Data.List() import Data.Maybe as DMaybe (fromJust,isJust,isNothing)+import Data.Sequence as DS (Seq(..),empty,(|>))+import Data.Sequence.Internal as DSI import Data.STRef as DSTR import Data.Text as DText-import Data.Vector as DVB-import Data.Vector.Unboxed() import GHC.Generics (Generic) import Prelude as P @@ -59,11 +59,11 @@ {-Base level types.-}  -- | Basic RLE ('ByteString') data type.-newtype RLEB = RLEB (DVB.Vector (Maybe ByteString))+newtype RLEB = RLEB (Seq (Maybe ByteString))   deriving (Eq,Ord,Show,Read,Generic)  -- | Basic RLE ('Text') data type.-newtype RLET = RLET (DVB.Vector (Maybe Text))+newtype RLET = RLET (Seq (Maybe Text))   deriving (Eq,Ord,Show,Read,Generic)  {-------------------}@@ -71,24 +71,24 @@  {-toRLE (ByteString) functions.-} --- | Abstract 'RLEVecB' type utilizing a sequence.-type RLEVecB = DVB.Vector (Maybe ByteString)+-- | Abstract 'RLESeqB' type utilizing a sequence.+type RLESeqB = Seq (Maybe ByteString) --- | Abstract data type representing a 'RLEVecB' in the (strict) ST monad.-type STRLEVecB s a = STRef s RLEVecB+-- | Abstract data type representing a 'RLESeqB' in the (strict) ST monad.+type STRLESeqB s a = STRef s RLESeqB --- | State function to push 'RLEVecB' data into stack.-pushSTRLEVecB :: STRLEVecB s (Maybe ByteString) -> Maybe ByteString -> ST s ()-pushSTRLEVecB s Nothing  = do+-- | State function to push 'RLESeqB' data into stack.+pushSTRLESeqB :: STRLESeqB s (Maybe ByteString) -> Maybe ByteString -> ST s ()+pushSTRLESeqB s Nothing  = do   s2 <- readSTRef s-  writeSTRef s (DVB.snoc s2 Nothing)-pushSTRLEVecB s (Just e) = do+  writeSTRef s (s2 DS.|> Nothing)+pushSTRLESeqB s (Just e) = do   s2 <- readSTRef s-  writeSTRef s (DVB.snoc s2 (Just e))+  writeSTRef s (s2 DS.|> Just e) --- | State function to create empty 'STRLEVecB' type.-emptySTRLEVecB :: ST s (STRLEVecB s a)-emptySTRLEVecB = newSTRef DVB.empty+-- | State function to create empty 'STRLESeqB' type.+emptySTRLESeqB :: ST s (STRLESeqB s a)+emptySTRLESeqB = newSTRef DS.empty  -- | Abstract 'STRLETempB' and associated state type. type STRLETempB s a = STRef s (Maybe ByteString)@@ -114,52 +114,52 @@ emptySTRLECounterB = newSTRef (-1)  -- | Strict state monad function.-vecToRLEB :: RLEVecB-          -> ST s RLEVecB-vecToRLEB (DVB.uncons -> Nothing)     = do-  brlevecstackempty  <- emptySTRLEVecB-  brlevecstackemptyr <- readSTRef brlevecstackempty-  return brlevecstackemptyr-vecToRLEB (DVB.uncons -> Just (v,vs)) = do-  brlevecstack     <- emptySTRLEVecB+seqToRLEB :: RLESeqB+          -> ST s RLESeqB+seqToRLEB DS.Empty      = do+  brleseqstackempty  <- emptySTRLESeqB+  brleseqstackemptyr <- readSTRef brleseqstackempty+  return brleseqstackemptyr+seqToRLEB (x DS.:<| xs) = do+  brleseqstack     <- emptySTRLESeqB   brlecounterstack <- emptySTRLECounterB   brletempstack    <- emptySTRLETempB   updateSTRLECounterB brlecounterstack                       1    updateSTRLETempB brletempstack-                   v-  iRLEB vs-        brlevecstack+                   x+  iRLEB xs+        brleseqstack         brlecounterstack         brletempstack-  brlevecstackr <- readSTRef brlevecstack-  return brlevecstackr+  brleseqstackr <- readSTRef brleseqstack+  return brleseqstackr     where-      iRLEB (DVB.uncons -> Nothing)     brless brlecs brlets = do+      iRLEB DS.Empty      brless brlecs brlets = do         cbrlecs <- readSTRef brlecs         cbrlets <- readSTRef brlets-        pushSTRLEVecB brless+        pushSTRLESeqB brless                       (Just      $                        BSC8.pack $                        show cbrlecs)-        pushSTRLEVecB brless+        pushSTRLESeqB brless                       cbrlets         pure ()-      iRLEB (DVB.uncons -> Just (y,ys)) brless brlecs brlets = do+      iRLEB (y DS.:<| ys) brless brlecs brlets = do         cbrlecs <- readSTRef brlecs         cbrlets <- readSTRef brlets         if | isNothing y-           -> do pushSTRLEVecB brless+           -> do pushSTRLESeqB brless                                (Just      $                                 BSC8.pack $                                 show cbrlecs)-                 pushSTRLEVecB brless+                 pushSTRLESeqB brless                                cbrlets -                 pushSTRLEVecB brless+                 pushSTRLESeqB brless                                (Just      $                                 BSC8.pack $                                 show (1 :: Int))-                 pushSTRLEVecB brless+                 pushSTRLESeqB brless                                Nothing                  updateSTRLETempB brlets                                   Nothing             @@ -184,11 +184,11 @@                        brlecs                        brlets            | otherwise-           -> do pushSTRLEVecB brless+           -> do pushSTRLESeqB brless                                (Just      $                                 BSC8.pack $                                 show cbrlecs)-                 pushSTRLEVecB brless+                 pushSTRLESeqB brless                                cbrlets                  updateSTRLECounterB brlecs                                      1@@ -204,24 +204,24 @@  {-toRLE (Text) functions.-} --- | Abstract 'RLEVecT' type utilizing a sequence.-type RLEVecT = DVB.Vector (Maybe Text)+-- | Abstract 'RLESeqT' type utilizing a sequence.+type RLESeqT = Seq (Maybe Text) --- | Abstract data type representing a 'RLEVecT' in the (strict) ST monad.-type STRLEVecT s a = STRef s RLEVecT+-- | Abstract data type representing a 'RLESeqT' in the (strict) ST monad.+type STRLESeqT s a = STRef s RLESeqT --- | State function to push 'RLEVecT' data into stack.-pushSTRLEVecT :: STRLEVecT s (Maybe Text) -> (Maybe Text) -> ST s ()-pushSTRLEVecT s Nothing  = do+-- | State function to push 'RLESeqT' data into stack.+pushSTRLESeqT :: STRLESeqT s (Maybe Text) -> (Maybe Text) -> ST s ()+pushSTRLESeqT s Nothing  = do   s2 <- readSTRef s-  writeSTRef s (DVB.snoc s2 Nothing)-pushSTRLEVecT s (Just e) = do+  writeSTRef s (s2 DS.|> Nothing)+pushSTRLESeqT s (Just e) = do   s2 <- readSTRef s-  writeSTRef s (DVB.snoc s2 (Just e))+  writeSTRef s (s2 DS.|> Just e) --- | State function to create empty 'STRLEVecT' type.-emptySTRLEVecT :: ST s (STRLEVecT s a)-emptySTRLEVecT = newSTRef DVB.empty+-- | State function to create empty 'STRLESeqT' type.+emptySTRLESeqT :: ST s (STRLESeqT s a)+emptySTRLESeqT = newSTRef DS.empty  -- | Abstract 'STRLETempT' state type. type STRLETempT s a = STRef s (Maybe Text)@@ -247,52 +247,52 @@ emptySTRLECounterT = newSTRef (-1)  -- | Strict state monad function.-vecToRLET :: RLEVecT ->-             ST s RLEVecT-vecToRLET (DVB.uncons -> Nothing)     = do-  trlevecstackempty  <- emptySTRLEVecT-  trlevecstackemptyr <- readSTRef trlevecstackempty-  return trlevecstackemptyr-vecToRLET (DVB.uncons -> Just (v,vs)) = do-  trlevecstack     <- emptySTRLEVecT+seqToRLET :: RLESeqT ->+             ST s RLESeqT+seqToRLET DS.Empty      = do+  trleseqstackempty  <- emptySTRLESeqT+  trleseqstackemptyr <- readSTRef trleseqstackempty+  return trleseqstackemptyr+seqToRLET (x DS.:<| xs) = do+  trleseqstack     <- emptySTRLESeqT   trlecounterstack <- emptySTRLECounterT   trletempstack    <- emptySTRLETempT   updateSTRLECounterT trlecounterstack                       1   updateSTRLETempT trletempstack-                   v-  iRLET vs-        trlevecstack+                   x+  iRLET xs+        trleseqstack         trlecounterstack         trletempstack-  trlevecstackr <- readSTRef trlevecstack-  return trlevecstackr+  trleseqstackr <- readSTRef trleseqstack+  return trleseqstackr     where-      iRLET (DVB.uncons -> Nothing)     trless trlecs trlets = do+      iRLET DS.Empty      trless trlecs trlets = do         ctrlecs <- readSTRef trlecs         ctrlets <- readSTRef trlets-        pushSTRLEVecT trless+        pushSTRLESeqT trless                       (Just       $                        DText.pack $                        show ctrlecs)-        pushSTRLEVecT trless+        pushSTRLESeqT trless                       ctrlets          pure ()-      iRLET (DVB.uncons -> Just (y,ys)) trless trlecs trlets = do+      iRLET (y DS.:<| ys) trless trlecs trlets = do         ctrlecs <- readSTRef trlecs         ctrlets <- readSTRef trlets         if | isNothing y-           -> do pushSTRLEVecT trless+           -> do pushSTRLESeqT trless                                (Just       $                                 DText.pack $                                 show ctrlecs)-                 pushSTRLEVecT trless+                 pushSTRLESeqT trless                                ctrlets-                 pushSTRLEVecT trless+                 pushSTRLESeqT trless                                (Just       $                                 DText.pack $                                 show (1 :: Int))-                 pushSTRLEVecT trless+                 pushSTRLESeqT trless                                Nothing                  updateSTRLETempT trlets                                   Nothing@@ -317,11 +317,11 @@                        trlecs                        trlets            | otherwise-           -> do pushSTRLEVecT trless+           -> do pushSTRLESeqT trless                                (Just       $                                 DText.pack $                                 show ctrlecs)-                 pushSTRLEVecT trless+                 pushSTRLESeqT trless                                ctrlets                  updateSTRLECounterT trlecs                                      1@@ -337,69 +337,59 @@  {-fromRLE (ByteString) functions.-} --- | 'DVB.Vector' auxilary function--- to pattern match on first two elements--- of a vector.-unconsb2 :: DVB.Vector a -> Maybe (a,DVB.Vector a,Maybe (DVB.Vector a))-unconsb2 v = if | DVB.length v < 3-                -> Just (DVB.unsafeHead v,DVB.drop 1 v,Nothing)-                | otherwise-                -> Just (DVB.unsafeHead v,DVB.drop 1 v,Just $ DVB.drop 2 v)---- | Abstract 'FRLEVecB' type utilizing a sequence.-type FRLEVecB = DVB.Vector (Maybe ByteString)+-- | Abstract 'FRLESeqB' type utilizing a sequence.+type FRLESeqB = Seq (Maybe ByteString) --- | Abstract data type representing a 'FRLEVecB' in the (strict) ST monad.-type FSTRLEVecB s a = STRef s FRLEVecB+-- | Abstract data type representing a 'FRLESeqB' in the (strict) ST monad.+type FSTRLESeqB s a = STRef s FRLESeqB --- | State function to push 'FRLEVecB' data into stack.-pushFSTRLEVecB :: FSTRLEVecB s (Maybe ByteString) -> (Maybe ByteString) -> ST s ()-pushFSTRLEVecB s Nothing  = do+-- | State function to push 'FRLESeqB' data into stack.+pushFSTRLESeqB :: FSTRLESeqB s (Maybe ByteString) -> (Maybe ByteString) -> ST s ()+pushFSTRLESeqB s Nothing  = do   s2 <- readSTRef s-  writeSTRef s (DVB.snoc s2 Nothing)-pushFSTRLEVecB s (Just e) = do+  writeSTRef s (s2 DS.|> Nothing)+pushFSTRLESeqB s (Just e) = do   s2 <- readSTRef s-  writeSTRef s (DVB.snoc s2 (Just e))+  writeSTRef s (s2 DS.|> Just e) --- | State function to create empty 'FSTRLEVecB' type.-emptyFSTRLEVecB :: ST s (FSTRLEVecB s a)-emptyFSTRLEVecB = newSTRef DVB.empty+-- | State function to create empty 'FSTRLESeqB' type.+emptyFSTRLESeqB :: ST s (FSTRLESeqB s a)+emptyFSTRLESeqB = newSTRef DS.empty  -- | Strict state monad function.-vecFromRLEB :: RLEB-            -> ST s FRLEVecB-vecFromRLEB (RLEB (DVB.uncons -> Nothing)) = do-  fbrlevecstackempty  <- emptyFSTRLEVecB-  fbrlevecstackemptyr <- readSTRef fbrlevecstackempty-  return fbrlevecstackemptyr-vecFromRLEB vs                             = do-  fbrlevecstack <- emptySTRLEVecB-  let rlebvec = (\(RLEB b) -> b) vs-  iFRLEB rlebvec-         fbrlevecstack-  fbrlevecstackr <- readSTRef fbrlevecstack-  return fbrlevecstackr+seqFromRLEB :: RLEB+            -> ST s FRLESeqB+seqFromRLEB (RLEB DS.Empty) = do+  fbrleseqstackempty  <- emptyFSTRLESeqB+  fbrleseqstackemptyr <- readSTRef fbrleseqstackempty+  return fbrleseqstackemptyr+seqFromRLEB xs              = do+  fbrleseqstack <- emptySTRLESeqB+  let rlebseq = (\(RLEB b) -> b) xs+  iFRLEB rlebseq+         fbrleseqstack+  fbrleseqstackr <- readSTRef fbrleseqstack+  return fbrleseqstackr     where-      iFRLEB (unconsb2 -> Just (y1,y2,Nothing)) fbrless =+      iFRLEB (y1 DS.:<| y2 DS.:<| DS.Empty) fbrless =         if | isJust y1    &&-             isNothing (DVB.head y2)-           -> do pushFSTRLEVecB fbrless+             isNothing y2+           -> do pushFSTRLESeqB fbrless                                 Nothing                  pure ()             | otherwise            -> do let y1' = read        $                            BSC8.unpack $                            fromJust y1 :: Int-                 let y2' = fromJust $-                           DVB.head y2+                 let y2' = fromJust y2                  CM.replicateM_ y1'-                                (pushFSTRLEVecB fbrless+                                (pushFSTRLESeqB fbrless                                                 (Just y2'))                  pure () -      iFRLEB (unconsb2 -> Just (y1,y2,Just ys)) fbrless =+      iFRLEB (y1 DS.:<| y2 DS.:<| ys)       fbrless =         if | isJust y1     &&-             isNothing (DVB.head y2)-           -> do pushFSTRLEVecB fbrless+             isNothing y2+           -> do pushFSTRLESeqB fbrless                                 Nothing                  iFRLEB ys                         fbrless@@ -407,82 +397,74 @@            -> do let y1' = read        $                            BSC8.unpack $                            fromJust y1 :: Int-                 let y2' = fromJust $-                           DVB.head y2+                 let y2' = fromJust y2                  CM.replicateM_ y1'-                                (pushFSTRLEVecB fbrless+                                (pushFSTRLESeqB fbrless                                                 (Just y2'))                  iFRLEB ys-                        fbrless+                        fbrless +      iFRLEB (DSI.Seq EmptyT)               _       = pure ()+      iFRLEB (DSI.Seq (Single _))           _       = pure ()+      iFRLEB (DSI.Seq (Deep _ _ _ _))       _       = pure ()  {---------------------------------}   {-fromRLE (Text) functions.-} --- | 'DVB.Vector' auxilary function--- to pattern match on first two elements--- of a vector.-unconst2 :: DVB.Vector a -> Maybe (a,DVB.Vector a, Maybe (DVB.Vector a))-unconst2 v = if | DVB.length v < 3-                -> Just (DVB.unsafeHead v,DVB.drop 1 v,Nothing)-                | otherwise-                -> Just (DVB.unsafeHead v, DVB.drop 1 v,Just $ DVB.drop 2 v)---- | Abstract 'FRLEVecT' type utilizing a sequence.-type FRLEVecT = DVB.Vector (Maybe Text)+-- | Abstract 'FRLESeqT' type utilizing a sequence.+type FRLESeqT = Seq (Maybe Text) --- | Abstract data type representing a 'FRLEVecT' in the (strict) ST monad.-type FSTRLEVecT s a = STRef s FRLEVecT+-- | Abstract data type representing a 'FRLESeqT' in the (strict) ST monad.+type FSTRLESeqT s a = STRef s FRLESeqT --- | State function to push 'FSTRLEVecT' data into stack.-pushFSTRLEVecT :: FSTRLEVecT s (Maybe Text) -> (Maybe Text) -> ST s ()-pushFSTRLEVecT s Nothing  = do+-- | State function to push 'FSTRLESeqT' data into stack.+pushFSTRLESeqT :: FSTRLESeqT s (Maybe Text) -> (Maybe Text) -> ST s ()+pushFSTRLESeqT s Nothing  = do   s2 <- readSTRef s-  writeSTRef s (DVB.snoc s2 Nothing)-pushFSTRLEVecT s (Just e) = do+  writeSTRef s (s2 DS.|> Nothing)+pushFSTRLESeqT s (Just e) = do   s2 <- readSTRef s-  writeSTRef s (DVB.snoc s2 (Just e))+  writeSTRef s (s2 DS.|> Just e) --- | State function to create empty 'FSTRLEVecT' type.-emptyFSTRLEVecT :: ST s (FSTRLEVecT s a)-emptyFSTRLEVecT = newSTRef DVB.empty+-- | State function to create empty 'FSTRLESeqT' type.+emptyFSTRLESeqT :: ST s (FSTRLESeqT s a)+emptyFSTRLESeqT = newSTRef DS.empty  -- | Strict state monad function.-vecFromRLET :: RLET ->-               ST s FRLEVecT-vecFromRLET (RLET (DVB.uncons -> Nothing)) = do-  ftrlevecstackempty  <- emptyFSTRLEVecT-  ftrlevecstackemptyr <- readSTRef ftrlevecstackempty-  return ftrlevecstackemptyr-vecFromRLET vs                             = do-  ftrlevecstack <- emptySTRLEVecT-  let rletvec = (\(RLET t) -> t) vs-  iFRLET rletvec-         ftrlevecstack-  ftrlevecstackr <- readSTRef ftrlevecstack-  return ftrlevecstackr-    where -      iFRLET (unconst2 -> Just (y1,y2,Nothing)) ftrless =+seqFromRLET :: RLET ->+               ST s FRLESeqT+seqFromRLET (RLET DS.Empty) = do+  ftrleseqstackempty  <- emptyFSTRLESeqT+  ftrleseqstackemptyr <- readSTRef ftrleseqstackempty+  return ftrleseqstackemptyr+seqFromRLET xs              = do+  ftrleseqstack <- emptySTRLESeqT+  let rletseq = (\(RLET t) -> t) xs+  iFRLET rletseq+         ftrleseqstack+  ftrleseqstackr <- readSTRef ftrleseqstack+  return ftrleseqstackr+    where+      iFRLET (y1 DS.:<| y2 DS.:<| DS.Empty) ftrless =         if | isJust y1    &&-             isNothing (DVB.head y2)-           -> do pushFSTRLEVecT ftrless+             isNothing y2+           -> do pushFSTRLESeqT ftrless                                 Nothing                  pure ()            | otherwise            -> do let y1' = read         $                            DText.unpack $                            fromJust y1 :: Int-                 let y2' = fromJust $-                           DVB.head y2+                 let y2' = fromJust y2                  CM.replicateM_ y1'-                                (pushFSTRLEVecT ftrless+                                (pushFSTRLESeqT ftrless                                                 (Just y2'))                  pure ()-      iFRLET (unconst2 -> Just (y1,y2,Just ys)) ftrless =+      iFRLET (y1 DS.:<| y2 DS.:<| ys)       ftrless =         if | isJust y1     &&-             isNothing (DVB.head y2)-           -> do pushFSTRLEVecT ftrless+             isNothing y2+           -> do pushFSTRLESeqT ftrless                                 Nothing                  iFRLET ys                         ftrless@@ -490,12 +472,14 @@            -> do let y1' = read         $                            DText.unpack $                            fromJust y1 :: Int-                 let y2' = fromJust $-                           DVB.head y2+                 let y2' = fromJust y2                  CM.replicateM_ y1'-                                (pushFSTRLEVecT ftrless+                                (pushFSTRLESeqT ftrless                                                 (Just y2'))                  iFRLET ys                         ftrless+      iFRLET (DSI.Seq EmptyT)               _       = pure ()+      iFRLET (DSI.Seq (Single _))           _       = pure ()+      iFRLET (DSI.Seq (Deep _ _ _ _))       _       = pure ()  {---------------------------}
text-compression.cabal view
@@ -20,7 +20,7 @@ -- PVP summary:     +-+------- breaking API changes --                  | | +----- non-breaking API additions --                  | | | +--- code changes with no API change-version:            0.1.0.8+version:            0.1.0.9  -- A short (one-line) description of the package. synopsis:           A text compression library.@@ -76,14 +76,12 @@     -- other-extensions:      -- Other library packages from which modules are imported.-    build-depends:    base              ^>=4.16.3.0, -                      bytestring        >= 0.11.3 && < 0.12,-                      containers        >= 0.6.5 && < 0.7,-                      massiv            >= 1.0.2 && < 1.1,-                      mtl               >= 2.2.2 && < 2.3,-                      text              >= 1.2.5 && < 1.3,-                      vector            >= 0.13.0 && < 0.14,-                      vector-algorithms >= 0.9.0 && < 0.10+    build-depends:    base       ^>=4.16.3.0,+                      bytestring >= 0.11.3 && < 0.12,+                      containers >= 0.6.5 && < 0.7,+                      massiv     >= 1.0.2 && < 1.1,+                      mtl        >= 2.2.2 && < 2.3,+                      text       >= 1.2.5 && < 1.3      -- Directories containing source files.     hs-source-dirs:   src