text-compression 0.1.0.6 → 0.1.0.7
raw patch · 5 files changed
+827/−21 lines, 5 files
Files
- CHANGELOG.md +8/−6
- src/Data/BWT.hs +21/−12
- src/Data/RLE.hs +308/−0
- src/Data/RLE/Internal.hs +485/−0
- text-compression.cabal +5/−3
CHANGELOG.md view
@@ -6,26 +6,28 @@ ## 0.1.0.1 -- 2022-10-31 -* First version, with some updated documentation.+* Updated documentation. ## 0.1.0.2 -- 2022-10-31 -* First version, with some updated documentation.+* Updated documentation. ## 0.1.0.3 -- 2022-10-31 -* First version, with some updated documentation.+* Updated documentation. ## 0.1.0.4 -- 2022-10-31 -* First version, with some updated documentation.+* Updated documentation. ## 0.1.0.5 -- 2022-11-01 -* First version. * Removed requirement for avoiding input with the '$' character in both the toBWT and fromBWT functions (both toBWT and fromBWT functions are now polymorphic). ## 0.1.0.6 -- 2022-11-05 -* First version. * Added helper functions to ease conversion of ByteStrings and Text to and from the BWT type.++## 0.1.0.7 -- 2022-11-07++* Added Run-length encoding (RLE) implementation.
src/Data/BWT.hs view
@@ -1,6 +1,7 @@-{-# LANGUAGE MultiWayIf #-}-{-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE Strict #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE Strict #-} -- |@@ -15,7 +16,7 @@ -- The two functions that most users will utilize are 'toBWT' and 'fromBWT'. -- There are auxilary function(s) inside of @"Data.BWT.Internal"@. ----- The helper functions for ByteString, 'bytestringToBWT' and 'bytestringFromBWT' and Text, 'textToBWT' and 'textFromBWT' should help for common use cases.+-- The helper functions for ByteString, 'bytestringToBWT', 'bytestringFromWord8BWT' , 'bytestringFromByteStringBWT' and Text, 'textToBWT' and 'textFromBWT' should help for common use cases. -- -- @"Data.BWT.Internal"@ also has the function 'createBWTMatrix', which can be useful as well, although not used by either 'toBWT' or 'fromBWT'. @@ -27,13 +28,14 @@ import Control.Monad() import Control.Monad.ST as CMST import Control.Monad.State.Strict()-import Data.ByteString as BS (ByteString,pack,unpack)+import Data.ByteString as BS (ByteString,concat,pack,unpack) import Data.Foldable as DFold (toList) import Data.Sequence as DS import Data.STRef() import Data.Text (Text) import Data.Text.Encoding as DTE (decodeUtf8,encodeUtf8) import Data.Word (Word8)+import GHC.Generics(Generic) {-toBWT Function(s)-}@@ -57,9 +59,10 @@ BWT Word8 bytestringToBWT = toBWT . BS.unpack --- newtype to ensure you only uncompress a BWT created--- from textToBWT, since [Word8] -> Text is partial+-- | A newtype to ensure you only uncompress a BWT created+-- from textToBWT, since [Word8] -> Text is partial. newtype TextBWT = TextBWT (BWT Word8)+ deriving (Eq,Ord,Show,Read,Generic) -- | Helper function for converting 'Text' -- to a 'TextBWT'.@@ -89,16 +92,22 @@ zipped = DS.zip bwt (DS.iterateN (DS.length bwt) (+1) 0) --- | Helper function for converting a 'BWT' 'Word8'+-- | Helper function for converting a 'BWT' of 'Word8's -- to a 'ByteString'.-bytestringFromBWT :: BWT Word8 ->- ByteString-bytestringFromBWT = BS.pack . fromBWT+bytestringFromWord8BWT :: BWT Word8+ -> ByteString+bytestringFromWord8BWT = BS.pack . fromBWT +-- | Helper function for converting a 'BWT' 'ByteString's+-- to a 'ByteString'.+bytestringFromByteStringBWT :: BWT ByteString+ -> ByteString+bytestringFromByteStringBWT = BS.concat . fromBWT+ -- | Helper function for converting 'TextBWT' -- to a 'Text' textFromBWT :: TextBWT -> Text textFromBWT (TextBWT x) = DTE.decodeUtf8 $- bytestringFromBWT x+ bytestringFromWord8BWT x {---------------------}
+ src/Data/RLE.hs view
@@ -0,0 +1,308 @@+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE Strict #-}+++-- |+-- Module : Data.RLE+-- Copyright : (c) Matthew Mosior 2022+-- License : BSD-style+-- Maintainer : mattm.github@gmail.com+-- Portability : portable+--+-- = Run-length encoding (RLE)+++module Data.RLE where++import Data.BWT+import Data.BWT.Internal +import Data.RLE.Internal++import Control.Monad()+import Control.Monad.ST as CMST+import Control.Monad.State.Strict()+import Data.ByteString as BS+import Data.ByteString.Char8()+import Data.Char()+import Data.Foldable()+import Data.Maybe as DMaybe (isNothing,fromJust)+import Data.Sequence as DS+import Data.STRef()+import Data.Text as DText +import Data.Text.Encoding as DTE (decodeUtf8,encodeUtf8)+import Data.Word (Word8)+import Prelude as P+++{-toRLE Function(s)-}++-- | Helper function for converting a 'ByteString'+-- to a 'RLEB' via a 'BWT' first.+bytestringToBWTToRLEB :: ByteString ->+ RLEB+bytestringToBWTToRLEB = bytestringBWTToRLEB . bytestringToBWT++-- | Helper function for converting a 'ByteString'+-- to a 'RLET' via a 'BWT' first.+bytestringToBWTToRLET :: ByteString ->+ RLET+bytestringToBWTToRLET = bytestringBWTToRLET . bytestringToBWT++-- | Helper function for converting a 'Text'+-- to a 'RLEB' via a 'BWT' first.+textToBWTToRLEB :: Text ->+ RLEB+textToBWTToRLEB = textBWTToRLEB . textToBWT++-- | Helper function for converting a 'Text'+-- to a 'RLET' via a 'BWT' first.+textToBWTToRLET :: Text ->+ RLET+textToBWTToRLET = textBWTToRLET . textToBWT++-- | Take a 'BWT' of 'Word8's and generate the+-- Run-length encoding ('RLEB').+textBWTToRLEB :: TextBWT+ -> RLEB+textBWTToRLEB xs =+ RLEB (CMST.runST $ seqToRLEB xss)+ where+ xss = fmap (\x -> if | isNothing x+ -> Nothing+ | otherwise+ -> Just $+ BS.singleton $+ fromJust x+ )+ ((\(TextBWT t) -> t) xs)++-- | Take a 'BWT' of 'Word8's and generate the+-- Run-length encoding ('RLEB').+bytestringBWTToRLEB :: BWT Word8+ -> RLEB+bytestringBWTToRLEB DS.Empty = RLEB DS.Empty+bytestringBWTToRLEB xs =+ RLEB (CMST.runST $ seqToRLEB xss)+ where+ xss = fmap (\x -> if | isNothing x+ -> Nothing+ | otherwise+ -> Just $+ BS.singleton $+ fromJust x+ )+ xs++-- | Take a 'BWT' of 'Word8's and generate the+-- Run-length encoding ('RLEB').+textBWTToRLET :: TextBWT+ -> RLET+textBWTToRLET xs =+ RLET (CMST.runST $ seqToRLET xss)+ where+ xss = fmap (\x -> if | isNothing x+ -> Nothing+ | otherwise+ -> Just $+ DTE.decodeUtf8 $+ BS.singleton $+ fromJust x+ )+ ((\(TextBWT t) -> t) xs)++-- | Take a 'BWT' of 'Word8's and generate the+-- Run-length encoding ('RLET').+bytestringBWTToRLET :: BWT Word8+ -> RLET+bytestringBWTToRLET DS.Empty = RLET DS.Empty+bytestringBWTToRLET xs =+ RLET (CMST.runST $ seqToRLET xss)+ where+ xss = fmap (\x -> if | isNothing x+ -> Nothing+ | otherwise+ -> Just $+ DTE.decodeUtf8 $+ BS.singleton $+ fromJust x+ )+ xs++-- | Takes a 'Text' and returns the Run-length encoding ('RLEB').+textToRLEB :: Seq (Maybe Text)+ -> RLEB+textToRLEB DS.Empty = RLEB DS.Empty+textToRLEB xs = + RLEB (CMST.runST $ seqToRLEB xss)+ where+ xss = fmap (\x -> if | isNothing x+ -> Nothing+ | otherwise+ -> Just $+ DTE.encodeUtf8 $+ fromJust x+ )+ xs++-- | Takes a 'Seq' of 'ByteString's and returns the Run-length encoding ('RLEB').+bytestringToRLEB :: Seq (Maybe ByteString)+ -> RLEB+bytestringToRLEB DS.Empty = RLEB DS.Empty+bytestringToRLEB xs =+ RLEB (CMST.runST $ seqToRLEB xs)++-- | Takes a 'Text' and returns the Run-length encoding (RLE).+textToRLET :: Seq (Maybe Text)+ -> RLET+textToRLET DS.Empty = RLET DS.Empty+textToRLET xs =+ RLET (CMST.runST $ seqToRLET xs)++-- | Takes a 'ByteString' and returns the Run-length encoding (RLE).+bytestringToRLET :: Seq (Maybe ByteString)+ -> RLET+bytestringToRLET DS.Empty = RLET DS.Empty+bytestringToRLET xs =+ RLET (CMST.runST $ seqToRLET xss)+ where+ xss = fmap (\x -> if | isNothing x+ -> Nothing+ | otherwise+ -> Just $+ DTE.decodeUtf8 $+ fromJust x+ )+ xs ++{-------------------}+++{-fromRLE function(s)-}++-- | Helper function for converting a 'BWT'ed 'RLEB'+-- back to the original 'ByteString'.+bytestringFromBWTFromRLEB :: RLEB + -> ByteString+bytestringFromBWTFromRLEB = bytestringFromByteStringBWT . bytestringBWTFromRLEB++-- | Helper function for converting a 'BWT'ed 'RLET'+-- back to the original 'ByteString'.+bytestringFromBWTFromRLET :: RLET+ -> ByteString+bytestringFromBWTFromRLET = bytestringFromByteStringBWT . fmap (\x -> if | isNothing x+ -> Nothing+ | otherwise+ -> Just $+ DTE.encodeUtf8 $+ fromJust x+ )+ .+ textBWTFromRLET++-- | Helper function for converting a 'BWT'ed 'RLEB'+-- back to the original 'Text'.+textFromBWTFromRLEB :: RLEB+ -> Text+textFromBWTFromRLEB = DTE.decodeUtf8 . bytestringFromByteStringBWT . bytestringBWTFromRLEB ++-- | Helper function for converting a 'BWT'ed 'RLET'+-- back to the original 'Text'.+textFromBWTFromRLET :: RLET+ -> Text+textFromBWTFromRLET = DTE.decodeUtf8 . bytestringFromByteStringBWT . bytestringBWTFromRLET++-- | Takes a 'RLET' and returns+-- the 'BWT' of 'Text's.+textBWTFromRLET :: RLET+ -> BWT Text+textBWTFromRLET (RLET DS.Empty) = DS.Empty+textBWTFromRLET xs = + CMST.runST $ seqFromRLET xs++-- | Takes a 'RLET' and returns+-- the 'BWT' of 'ByteString's.+bytestringBWTFromRLET :: RLET+ -> BWT ByteString+bytestringBWTFromRLET (RLET DS.Empty) = DS.Empty+bytestringBWTFromRLET xs = do+ let originalbwtb = CMST.runST $ seqFromRLET xs+ 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 DS.Empty) = DS.Empty+textBWTFromRLEB xs = do+ let originalbwtt = CMST.runST $ seqFromRLEB xs+ 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 DS.Empty) = DS.Empty+bytestringBWTFromRLEB xs =+ CMST.runST $ seqFromRLEB xs++-- | Takes a 'RLEB' and returns+-- the original 'Seq' of 'Text's.+textFromRLEB :: RLEB+ -> 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 'Seq' of 'ByteString's.+bytestringFromRLEB :: RLEB+ -> Seq (Maybe ByteString)+bytestringFromRLEB (RLEB DS.Empty) = DS.Empty+bytestringFromRLEB xs = do+ CMST.runST $ seqFromRLEB xs++-- | Takes a 'RLET' and returns+-- the original 'Seq' of 'Text's.+textFromRLET :: RLET+ -> Seq (Maybe Text)+textFromRLET (RLET DS.Empty) = DS.Empty+textFromRLET xs = do+ CMST.runST $ seqFromRLET xs++-- | Takes a 'RLET' and returns+-- the original 'Seq' of 'ByteString's.+bytestringFromRLET :: RLET+ -> 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
@@ -0,0 +1,485 @@+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE Strict #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeApplications #-}+++-- |+-- Module : Data.RLE.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 Run-length encoding (RLE)+-- and the Inverse RLE implementations, namely 'seqToRLEB', 'seqToRLET', 'seqFromRLEB', and 'seqFromRLET'.+--+-- 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.+++module Data.RLE.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 as BSC8 (pack,unpack)+import Data.ByteString.Internal()+import Data.List()+import Data.Maybe as DMaybe (fromJust,isJust,isNothing)+import Data.Sequence as DS+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 RLE ('ByteString') data type.+newtype RLEB = RLEB (Seq (Maybe ByteString))+ deriving (Eq,Ord,Show,Read,Generic)++-- | Basic RLE ('Text') data type.+newtype RLET = RLET (Seq (Maybe Text))+ deriving (Eq,Ord,Show,Read,Generic)++{-------------------}+++{-toRLE (ByteString) functions.-}++-- | Abstract 'RLESeqB' type utilizing a sequence.+type RLESeqB = Seq (Maybe ByteString)++-- | Abstract data type representing a 'RLESeqB' in the (strict) ST monad.+type STRLESeqB s a = STRef s RLESeqB++-- | 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 (s2 DS.|> Nothing)+pushSTRLESeqB s (Just e) = do+ s2 <- readSTRef s+ writeSTRef s (s2 DS.|> Just e)++-- | 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)++-- | State function to update 'STRLETempB'.+updateSTRLETempB :: STRLETempB s (Maybe ByteString) -> Maybe ByteString -> ST s ()+updateSTRLETempB s Nothing = writeSTRef s Nothing+updateSTRLETempB s (Just e) = writeSTRef s (Just e)++-- | State function to create empty 'STRLETempB' type.+emptySTRLETempB :: ST s (STRLETempB s a)+emptySTRLETempB = newSTRef (Just BS.empty)++-- | Abstract 'STRLECounterB' state type.+type STRLECounterB s a = STRef s Int++-- | State function to update 'STRLECounterB'.+updateSTRLECounterB :: STRLECounterB s Int -> Int -> ST s ()+updateSTRLECounterB s e = writeSTRef s e++-- | State function to create empty 'STRLECounterB' type.+emptySTRLECounterB :: ST s (STRLECounterB s Int)+emptySTRLECounterB = newSTRef (-1)++-- | Strict state monad function.+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+ x+ iRLEB xs+ brleseqstack+ brlecounterstack+ brletempstack+ brleseqstackr <- readSTRef brleseqstack+ return brleseqstackr+ where+ iRLEB DS.Empty brless brlecs brlets = do+ cbrlecs <- readSTRef brlecs+ cbrlets <- readSTRef brlets+ pushSTRLESeqB brless+ (Just $+ BSC8.pack $+ show cbrlecs)+ pushSTRLESeqB brless+ cbrlets+ pure ()+ iRLEB (y DS.:<| ys) brless brlecs brlets = do+ cbrlecs <- readSTRef brlecs+ cbrlets <- readSTRef brlets+ if | isNothing y+ -> do pushSTRLESeqB brless+ (Just $+ BSC8.pack $+ show cbrlecs)+ pushSTRLESeqB brless+ cbrlets + pushSTRLESeqB brless+ (Just $+ BSC8.pack $+ show (1 :: Int))+ pushSTRLESeqB brless+ Nothing+ updateSTRLETempB brlets+ Nothing + iRLEB ys+ brless+ brlecs+ brlets+ | isNothing cbrlets+ -> do updateSTRLECounterB brlecs+ 1+ updateSTRLETempB brlets+ y+ iRLEB ys+ brless+ brlecs+ brlets+ | fromJust cbrlets == fromJust y+ -> do updateSTRLECounterB brlecs+ (cbrlecs + 1)+ iRLEB ys+ brless+ brlecs+ brlets+ | otherwise+ -> do pushSTRLESeqB brless+ (Just $+ BSC8.pack $+ show cbrlecs)+ pushSTRLESeqB brless+ cbrlets+ updateSTRLECounterB brlecs+ 1+ updateSTRLETempB brlets+ y+ iRLEB ys+ brless+ brlecs+ brlets++{-------------------------------}+++{-toRLE (Text) functions.-}++-- | Abstract 'RLESeqT' type utilizing a sequence.+type RLESeqT = Seq (Maybe Text)++-- | Abstract data type representing a 'RLESeqT' in the (strict) ST monad.+type STRLESeqT s a = STRef s RLESeqT++-- | 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 (s2 DS.|> Nothing)+pushSTRLESeqT s (Just e) = do+ s2 <- readSTRef s+ writeSTRef s (s2 DS.|> Just e)++-- | 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)++-- | State function to update 'STRLETempT'.+updateSTRLETempT :: STRLETempT s (Maybe Text) -> (Maybe Text) -> ST s ()+updateSTRLETempT s Nothing = writeSTRef s Nothing+updateSTRLETempT s (Just e) = writeSTRef s (Just e)++-- | State function to create empty 'STRLETempT' type.+emptySTRLETempT :: ST s (STRLETempT s a)+emptySTRLETempT = newSTRef (Just DText.empty)++-- | Abstract 'STRLECounterT' and associated state type.+type STRLECounterT s a = STRef s Int++-- | State function to update 'STRLECounterT'.+updateSTRLECounterT :: STRLECounterT s Int -> Int -> ST s ()+updateSTRLECounterT s e = writeSTRef s e++-- | State function to create empty 'STRLECounterT' type.+emptySTRLECounterT :: ST s (STRLECounterT s Int)+emptySTRLECounterT = newSTRef (-1)++-- | Strict state monad function.+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+ x+ iRLET xs+ trleseqstack+ trlecounterstack+ trletempstack+ trleseqstackr <- readSTRef trleseqstack+ return trleseqstackr+ where+ iRLET DS.Empty trless trlecs trlets = do+ ctrlecs <- readSTRef trlecs+ ctrlets <- readSTRef trlets+ pushSTRLESeqT trless+ (Just $+ DText.pack $+ show ctrlecs)+ pushSTRLESeqT trless+ ctrlets + pure ()+ iRLET (y DS.:<| ys) trless trlecs trlets = do+ ctrlecs <- readSTRef trlecs+ ctrlets <- readSTRef trlets+ if | isNothing y+ -> do pushSTRLESeqT trless+ (Just $+ DText.pack $+ show ctrlecs)+ pushSTRLESeqT trless+ ctrlets+ pushSTRLESeqT trless+ (Just $+ DText.pack $+ show (1 :: Int))+ pushSTRLESeqT trless+ Nothing+ updateSTRLETempT trlets+ Nothing+ iRLET ys+ trless+ trlecs+ trlets+ | isNothing ctrlets+ -> do updateSTRLECounterT trlecs+ 1+ updateSTRLETempT trlets+ y+ iRLET ys+ trless+ trlecs+ trlets+ | fromJust ctrlets == fromJust y+ -> do updateSTRLECounterT trlecs+ (ctrlecs + 1)+ iRLET ys+ trless+ trlecs+ trlets+ | otherwise+ -> do pushSTRLESeqT trless+ (Just $+ DText.pack $+ show ctrlecs)+ pushSTRLESeqT trless+ ctrlets+ updateSTRLECounterT trlecs+ 1+ updateSTRLETempT trlets+ y+ iRLET ys+ trless+ trlecs+ trlets++{-------------------------}+++{-fromRLE (ByteString) functions.-}++-- | Abstract 'FRLESeqB' type utilizing a sequence.+type FRLESeqB = Seq (Maybe ByteString)++-- | Abstract data type representing a 'FRLESeqB' in the (strict) ST monad.+type FSTRLESeqB s a = STRef s FRLESeqB++-- | 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 (s2 DS.|> Nothing)+pushFSTRLESeqB s (Just e) = do+ s2 <- readSTRef s+ writeSTRef s (s2 DS.|> Just e)++-- | State function to create empty 'FSTRLESeqB' type.+emptyFSTRLESeqB :: ST s (FSTRLESeqB s a)+emptyFSTRLESeqB = newSTRef DS.empty++-- | Strict state monad function.+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 (y1 DS.:<| y2 DS.:<| DS.Empty) fbrless =+ if | isJust y1 &&+ isNothing y2+ -> do pushFSTRLESeqB fbrless+ Nothing+ pure () + | otherwise+ -> do let y1' = read $+ BSC8.unpack $+ fromJust y1 :: Int+ let y2' = fromJust y2+ CM.replicateM_ y1'+ (pushFSTRLESeqB fbrless+ (Just y2'))+ pure () + iFRLEB (y1 DS.:<| y2 DS.:<| ys) fbrless =+ if | isJust y1 &&+ isNothing y2+ -> do pushFSTRLESeqB fbrless+ Nothing+ iFRLEB ys+ fbrless+ | otherwise+ -> do let y1' = read $+ BSC8.unpack $+ fromJust y1 :: Int+ let y2' = fromJust y2+ CM.replicateM_ y1'+ (pushFSTRLESeqB fbrless+ (Just y2'))+ iFRLEB ys+ fbrless + iFRLEB (DSI.Seq EmptyT) _ = pure ()+ iFRLEB (DSI.Seq (Single _)) _ = pure ()+ iFRLEB (DSI.Seq (Deep _ _ _ _)) _ = pure ()++{---------------------------------}+++{-fromRLE (Text) functions.-}++-- | Abstract 'FRLESeqT' type utilizing a sequence.+type FRLESeqT = Seq (Maybe Text)++-- | Abstract data type representing a 'FRLESeqT' in the (strict) ST monad.+type FSTRLESeqT s a = STRef s FRLESeqT++-- | 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 (s2 DS.|> Nothing)+pushFSTRLESeqT s (Just e) = do+ s2 <- readSTRef s+ writeSTRef s (s2 DS.|> Just e)++-- | State function to create empty 'FSTRLESeqT' type.+emptyFSTRLESeqT :: ST s (FSTRLESeqT s a)+emptyFSTRLESeqT = newSTRef DS.empty++-- | Strict state monad function.+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 y2+ -> do pushFSTRLESeqT ftrless+ Nothing+ pure ()+ | otherwise+ -> do let y1' = read $+ DText.unpack $+ fromJust y1 :: Int+ let y2' = fromJust y2+ CM.replicateM_ y1'+ (pushFSTRLESeqT ftrless+ (Just y2'))+ pure ()+ iFRLET (y1 DS.:<| y2 DS.:<| ys) ftrless =+ if | isJust y1 &&+ isNothing y2+ -> do pushFSTRLESeqT ftrless+ Nothing+ iFRLET ys+ ftrless+ | otherwise+ -> do let y1' = read $+ DText.unpack $+ fromJust y1 :: Int+ let y2' = fromJust y2+ CM.replicateM_ y1'+ (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,13 +20,13 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 0.1.0.6+version: 0.1.0.7 -- A short (one-line) description of the package. synopsis: A text compression library. -- A longer description of the package.-description: This package contains efficient implementations of the Burrows-Wheeler Transform (BWT) and Inverse BWT algorithms.+description: This package contains efficient implementations of various text compression algorithms. -- URL for the project homepage or repository. homepage: https://github.com/Matthew-Mosior/text-compression@@ -66,7 +66,9 @@ -- Modules exported by the library. exposed-modules: Data.BWT.Internal,- Data.BWT+ Data.BWT,+ Data.RLE.Internal,+ Data.RLE -- Modules included in this library but not exported. -- other-modules: