text-compression 0.1.0.15 → 0.1.0.16
raw patch · 7 files changed
+647/−24 lines, 7 filesPVP: minor bump suggested
API additions: PVP suggests at least a minor version bump
API changes (from Hackage documentation)
+ Data.FMIndex: bytestringFMIndexCount :: ByteString -> ByteString -> CIntB
+ Data.FMIndex: textFMIndexCount :: Text -> Text -> CIntT
+ Data.FMIndex.Internal: CB :: Maybe Int -> CB
+ Data.FMIndex.Internal: CT :: Maybe Int -> CT
+ Data.FMIndex.Internal: countFMIndexB :: PBCPat -> FMIndexB -> ST s CIntB
+ Data.FMIndex.Internal: countFMIndexT :: PTCPat -> FMIndexT -> ST s CIntT
+ Data.FMIndex.Internal: emptySTCBoolB :: ST s (STCBoolB s Bool)
+ Data.FMIndex.Internal: emptySTCBoolT :: ST s (STCBoolT s Bool)
+ Data.FMIndex.Internal: emptySTCCounterB :: ST s (STCCounterB s Int)
+ Data.FMIndex.Internal: emptySTCCounterT :: ST s (STCCounterT s Int)
+ Data.FMIndex.Internal: emptySTCCurrentEndB :: ST s (STCCurrentEndB s Int)
+ Data.FMIndex.Internal: emptySTCCurrentEndT :: ST s (STCCurrentEndT s Int)
+ Data.FMIndex.Internal: emptySTCCurrentStartB :: ST s (STCCurrentStartB s Int)
+ Data.FMIndex.Internal: emptySTCCurrentStartT :: ST s (STCCurrentStartT s Int)
+ Data.FMIndex.Internal: instance GHC.Classes.Eq Data.FMIndex.Internal.CB
+ Data.FMIndex.Internal: instance GHC.Classes.Eq Data.FMIndex.Internal.CT
+ Data.FMIndex.Internal: instance GHC.Classes.Ord Data.FMIndex.Internal.CB
+ Data.FMIndex.Internal: instance GHC.Classes.Ord Data.FMIndex.Internal.CT
+ Data.FMIndex.Internal: instance GHC.Generics.Generic Data.FMIndex.Internal.CB
+ Data.FMIndex.Internal: instance GHC.Generics.Generic Data.FMIndex.Internal.CT
+ Data.FMIndex.Internal: instance GHC.Read.Read Data.FMIndex.Internal.CB
+ Data.FMIndex.Internal: instance GHC.Read.Read Data.FMIndex.Internal.CT
+ Data.FMIndex.Internal: instance GHC.Show.Show Data.FMIndex.Internal.CB
+ Data.FMIndex.Internal: instance GHC.Show.Show Data.FMIndex.Internal.CT
+ Data.FMIndex.Internal: newtype CB
+ Data.FMIndex.Internal: newtype CT
+ Data.FMIndex.Internal: type CIntB = Maybe Int
+ Data.FMIndex.Internal: type CIntT = Maybe Int
+ Data.FMIndex.Internal: type PBCPat = Seq ByteString
+ Data.FMIndex.Internal: type PTCPat = Seq Text
+ Data.FMIndex.Internal: type STCBoolB s a = STRef s Bool
+ Data.FMIndex.Internal: type STCBoolT s a = STRef s Bool
+ Data.FMIndex.Internal: type STCCounterB s a = STRef s Int
+ Data.FMIndex.Internal: type STCCounterT s a = STRef s Int
+ Data.FMIndex.Internal: type STCCurrentEndB s a = STRef s Int
+ Data.FMIndex.Internal: type STCCurrentEndT s a = STRef s Int
+ Data.FMIndex.Internal: type STCCurrentStartB s a = STRef s Int
+ Data.FMIndex.Internal: type STCCurrentStartT s a = STRef s Int
+ Data.FMIndex.Internal: updateSTCBoolB :: STCBoolB s Bool -> Bool -> ST s ()
+ Data.FMIndex.Internal: updateSTCBoolT :: STCBoolT s Bool -> Bool -> ST s ()
+ Data.FMIndex.Internal: updateSTCCounterB :: STCCounterB s Int -> Int -> ST s ()
+ Data.FMIndex.Internal: updateSTCCounterT :: STCCounterT s Int -> Int -> ST s ()
+ Data.FMIndex.Internal: updateSTCCurrentEndB :: STCCurrentEndB s Int -> Int -> ST s ()
+ Data.FMIndex.Internal: updateSTCCurrentEndT :: STCCurrentEndT s Int -> Int -> ST s ()
+ Data.FMIndex.Internal: updateSTCCurrentStartB :: STCCurrentStartB s Int -> Int -> ST s ()
+ Data.FMIndex.Internal: updateSTCCurrentStartT :: STCCurrentStartT s Int -> Int -> ST s ()
Files
- CHANGELOG.md +8/−3
- src/Data/BWT/Internal.hs +27/−2
- src/Data/FMIndex.hs +48/−3
- src/Data/FMIndex/Internal.hs +469/−13
- src/Data/MTF/Internal.hs +54/−1
- src/Data/RLE/Internal.hs +40/−1
- text-compression.cabal +1/−1
CHANGELOG.md view
@@ -38,7 +38,7 @@ ## 0.1.0.9 -- 2022-11-12 -* Switching back to sequences for maintainability (for now).+* Switched back to sequences for maintainability (for now). ## 0.1.0.10 -- 2022-11-15 @@ -58,8 +58,13 @@ ## 0.1.0.14 -- 2022-11-23 -* Adding example FM-index output.+* Added example FM-index output. ## 0.1.0.15 -- 2022-11-23 -* Adding C[c] table for FM-index, and reworked FM-index implementation to include the C[c] table.+* Added C[c] table for FM-index, and reworked FM-index implementation to include the C[c] table.++## 0.1.0.16 -- 2022-11-28++* Added FM-index count operation and updated FM-index example text.+* Added contents to all internal modules.
src/Data/BWT/Internal.hs view
@@ -39,7 +39,27 @@ -- The internal 'BWTMatrix' data type relies upon the 'DS.Seq' as well. -module Data.BWT.Internal where+module Data.BWT.Internal ( -- * Base BWT types+ Suffix(..),+ SuffixArray,+ BWT(..),+ BWTMatrix(..),+ -- * To BWT functions+ saToBWT,+ createSuffixArray,+ -- * From BWT functions+ sortTB,+ BWTSeq,+ STBWTSeq,+ pushSTBWTSeq,+ emptySTBWTSeq,+ STBWTCounter,+ updateSTBWTCounter,+ emptySTBWTCounter,+ magicInverseBWT,+ -- * Create BWT Matrix function+ createBWTMatrix + ) where import Control.Monad as CM import Control.Monad.ST as CMST@@ -211,6 +231,11 @@ bwtcsf bwtcse +{--------------------}+++{-Create BWT Matrix function.-}+ -- | Simple yet efficient implementation of converting a given string -- into a BWT Matrix (the BWTMatrix type is a 'DS.Seq' ('Maybe' a). createBWTMatrix :: Ord a@@ -247,4 +272,4 @@ prefixes = DS.inits tseq tseq = DS.fromList t -{--------------------}+{-----------------------------}
src/Data/FMIndex.hs view
@@ -28,6 +28,13 @@ -- -- There are various other lower-level functions for interacting with the FMIndex implementation on 'ByteString' and 'Text' as well. --+-- = Operations+--+-- The count operation is supported by the 'countFMIndexB' function for 'ByteString's+-- and the 'countFMIndexT' function for 'Text'.+--+-- = Internal+-- -- @"Data.FMIndex.Internal"@ contains efficient and stateful implementations of the FMIndex and Inverse FMIndex algorithms. @@ -56,7 +63,10 @@ textFromFMIndexB, bytestringFromFMIndexB, textFromFMIndexT,- bytestringFromFMIndexT+ bytestringFromFMIndexT,+ -- * Count operations+ bytestringFMIndexCount,+ textFMIndexCount ) where import Data.BWT@@ -67,11 +77,11 @@ import Control.Monad.ST as CMST import Control.Monad.State.Strict() import Data.ByteString as BS-import Data.ByteString.Char8()+import Data.ByteString.Char8 as BSC8 (singleton,unpack) import Data.Char() import Data.Foldable() import Data.Maybe as DMaybe (isNothing,fromJust)-import Data.Sequence as DS (Seq(..),ViewL(..),viewl)+import Data.Sequence as DS (Seq(..),ViewL(..),fromList,viewl) import Data.STRef() import Data.Text as DText import Data.Text.Encoding as DTE (decodeUtf8,encodeUtf8)@@ -481,3 +491,38 @@ ) originalb {-------------------------}+++{-Count operations.-}++-- | Takes a pattern ('ByteString')+-- and an input 'ByteString'+-- and returns the number of occurences of the pattern+-- in the input 'ByteString'.+bytestringFMIndexCount :: ByteString+ -> ByteString+ -> CIntB+bytestringFMIndexCount pat input = do+ let bytestringfmindex = bytestringToBWTToFMIndexB input+ let patternf = fmap (BSC8.singleton) $+ DS.fromList $+ BSC8.unpack pat+ runST $ countFMIndexB patternf+ bytestringfmindex++-- | Takes a pattern ('Text')+-- and an input 'Text'+-- and returns the number of occurences of the pattern+-- in the input 'Text'.+textFMIndexCount :: Text+ -> Text+ -> CIntT+textFMIndexCount pat input = do+ let textfmindex = textToBWTToFMIndexT input+ let patternf = fmap (DText.singleton) $+ DS.fromList $+ DText.unpack pat+ runST $ countFMIndexT patternf+ textfmindex++{-------------------}
src/Data/FMIndex/Internal.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE MultiWayIf #-}-{-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE Strict #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE Strict #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeApplications #-}+{-# OPTIONS_GHC -Wno-name-shadowing #-} -- |@@ -42,11 +43,13 @@ -- -- The below example is taken from [this](https://en.wikipedia.org/wiki/FM-index) wikipedia page. ----- Given the following input, "abracadabra": --+--+-- Given the following input, "abracadabra"+-- -- and ----- Given the following Burrows-Wheeler matrix (BWM) of the input "abracadabra":+-- the following Burrows-Wheeler matrix (BWM) of the input "abracadabra": -- -- +----+---+---------------------------------------+---+ -- | I | F | | L |@@ -107,9 +110,114 @@ -- +---+---+---+---+---+---+---+---+---+---+----+----+----+ -- | r | 0 | 1 | 1 | 1 | 2 | 2 | 2 | 2 | 2 | 2 | 2 | 2 | -- +---+---+---+---+---+---+---+---+---+---+----+----+----++--+--+--+-- Keep in mind that the __$__ is translated into a __Nothing__. -module Data.FMIndex.Internal where+module Data.FMIndex.Internal ( -- * Base FM-index types+ FMIndexB(..),+ FMIndexT(..),+ OccCKB(..),+ OccCKT(..),+ CcB(..),+ CcT(..),+ CB(..),+ CT(..),+ -- * To OccCK (ByteString) functions+ PBOccCKSeqB,+ OccCKSeqB,+ STOccCKSeqB,+ updateSTOccCKSeqAB,+ updateSTOccCKSeqBB,+ emptySTOccCKSeqB,+ STOccCKILB,+ loadSTOccCKILB,+ emptySTOccCKILB,+ STOccCKCounterB,+ updateSTOccCKCounterB,+ emptySTOccCKCounterB,+ seqToOccCKB, + -- * To OccCK (Text) functions+ PTOccCKSeqT,+ OccCKSeqT,+ STOccCKSeqT,+ updateSTOccCKSeqAT,+ updateSTOccCKSeqBT,+ emptySTOccCKSeqT,+ STOccCKILT,+ loadSTOccCKILT,+ emptySTOccCKILT,+ STOccCKCounterT,+ updateSTOccCKCounterT,+ emptySTOccCKCounterT,+ seqToOccCKT,+ -- * Cc (ByteString) functions+ PBCcSeqB,+ CcSeqB,+ STCcSeqB,+ updateSTCcSeqB,+ emptySTCcSeqB,+ STCcILB,+ loadSTCcILB,+ emptySTCcILB,+ STCcCounterB,+ updateSTCcCounterB,+ emptySTCcCounterB,+ seqToCcB, + -- * Cc (Text) functions+ PTCcSeqT,+ CcSeqT,+ STCcSeqT,+ updateSTCcSeqT,+ emptySTCcSeqT,+ STCcILT,+ loadSTCcILT,+ emptySTCcILT,+ STCcCounterT,+ updateSTCcCounterT,+ emptySTCcCounterT,+ seqToCcT,+ -- * From FMIndex (ByteString) functions+ FFMIndexSeqB,+ seqFromFMIndexB,+ -- * From FMIndex (Text) functions+ FFMIndexSeqT,+ seqFromFMIndexT,+ -- * Count (ByteString) operation+ PBCPat,+ CIntB,+ STCBoolB,+ updateSTCBoolB,+ emptySTCBoolB,+ STCCounterB,+ updateSTCCounterB,+ emptySTCCounterB,+ STCCurrentStartB,+ updateSTCCurrentStartB,+ emptySTCCurrentStartB,+ STCCurrentEndB,+ updateSTCCurrentEndB,+ emptySTCCurrentEndB,+ countFMIndexB,+ -- * Count (Text) operation+ PTCPat,+ CIntT,+ STCBoolT,+ updateSTCBoolT,+ emptySTCBoolT,+ STCCounterT,+ updateSTCCounterT,+ emptySTCCounterT,+ STCCurrentStartT,+ updateSTCCurrentStartT,+ emptySTCCurrentStartT,+ STCCurrentEndT,+ updateSTCCurrentEndT,+ emptySTCCurrentEndT,+ countFMIndexT + ) where import Data.BWT.Internal() import Data.MTF.Internal@@ -117,16 +225,16 @@ import Control.Monad as CM import Control.Monad.ST as CMST import Control.Monad.State.Strict()-import Data.ByteString as BS+import Data.ByteString as BS hiding (count) import Data.ByteString.Char8() import Data.ByteString.Internal() import Data.Foldable() import Data.List() import Data.Maybe()-import Data.Sequence as DS (Seq(..),ViewR(..),empty,(|>))+import Data.Sequence as DS (Seq(..),ViewL(..),ViewR(..),empty,findIndexL,index,length,(|>)) import Data.Sequence.Internal as DSI import Data.STRef as DSTR-import Data.Text as DText+import Data.Text as DText hiding (count) import GHC.Generics (Generic) import Prelude as P @@ -157,6 +265,14 @@ newtype CcT = CcT (Seq (Int,Maybe Text)) deriving (Eq,Ord,Show,Read,Generic) +-- | Basic count ('ByteString') operation data type.+newtype CB = CB (Maybe Int)+ deriving (Eq,Ord,Show,Read,Generic)++-- | Basic count ('Text') operation data type.+newtype CT = CT (Maybe Int)+ deriving (Eq,Ord,Show,Read,Generic)+ {-------------------} @@ -214,8 +330,8 @@ -- | State function to update 'STOccCKCounterB'. updateSTOccCKCounterB :: STOccCKCounterB s Int- -> Int- -> ST s ()+ -> Int+ -> ST s () updateSTOccCKCounterB s e = writeSTRef s e -- | State function to create empty 'STOccCKCounterB' type.@@ -672,5 +788,345 @@ iFFMIndexT DS.Empty = DS.Empty iFFMIndexT ((_,b) DS.:<| _) = fmap (\(_,_,e) -> e) b++{-------------------------------}+++{-Count (ByteString) operation.-}++-- | Abstract 'PBCPat' type utilizing a 'Seq'.+type PBCPat = Seq ByteString++-- | Abstract 'CIntB' type utilizing an 'Int'.+type CIntB = Maybe Int++-- | Abstract 'STCBoolB' type utilizing a 'Bool'.+type STCBoolB s a = STRef s Bool++-- | State function to update 'STCBoolB' in the (strict) ST monad.+updateSTCBoolB :: STCBoolB s Bool+ -> Bool+ -> ST s ()+updateSTCBoolB s e = writeSTRef s e++-- | State function to create empty 'STCBoolB' type.+emptySTCBoolB :: ST s (STCBoolB s Bool)+emptySTCBoolB = newSTRef False++-- | Abstract data type representing a 'STCCounterB' in the (strict) ST monad.+type STCCounterB s a = STRef s Int++-- | State function to update 'STCCounterB'+updateSTCCounterB :: STCCounterB s Int+ -> Int+ -> ST s ()+updateSTCCounterB s e = writeSTRef s e++-- | State function to create empty 'STCCounterB' type.+emptySTCCounterB :: ST s (STCCounterB s Int)+emptySTCCounterB = newSTRef 0++-- | Abstract 'STCCurrentStartB' type utilizing a 'Seq'.+type STCCurrentStartB s a = STRef s Int++-- | State function to update 'STCCurrentStartB'.+updateSTCCurrentStartB :: STCCurrentStartB s Int+ -> Int+ -> ST s ()+updateSTCCurrentStartB s e = writeSTRef s e++-- | State function to create empty 'STCCurrentStartB' type.+emptySTCCurrentStartB :: ST s (STCCurrentStartB s Int)+emptySTCCurrentStartB = newSTRef (-1)++-- | Abstract 'STCCurrentEndB' type utilizing a 'Seq'.+type STCCurrentEndB s a = STRef s Int++-- | State function to update 'STCCurrentEndB'.+updateSTCCurrentEndB :: STCCurrentEndB s Int+ -> Int+ -> ST s ()+updateSTCCurrentEndB s e = writeSTRef s e++-- | State function to create empty 'STCCurrentEndB' type.+emptySTCCurrentEndB :: ST s (STCCurrentEndB s Int)+emptySTCCurrentEndB = newSTRef (-1)++-- | Count operation on a 'FMIndexB'.+-- This operation takes a pattern ('Seq' 'ByteString')+-- and returns the number of occurences of that pattern+-- in the original text T [credit](https://en.wikipedia.org/wiki/FM-index).+countFMIndexB :: PBCPat+ -> FMIndexB+ -> ST s CIntB +countFMIndexB DS.Empty _ = return Nothing+countFMIndexB _ (FMIndexB (CcB DS.Empty,_)) = return Nothing+countFMIndexB _ (FMIndexB (_,OccCKB DS.Empty)) = return Nothing+countFMIndexB xs ys = do+ bccounter <- emptySTCCounterB+ bcbool <- emptySTCBoolB+ bccurrentstart <- emptySTCCurrentStartB+ bccurrentend <- emptySTCCurrentEndB+ iCB xs+ ys+ bccounter+ bcbool+ bccurrentstart+ bccurrentend+ cbccurrentstart <- readSTRef bccurrentstart+ cbccurrentend <- readSTRef bccurrentend+ cbcbool <- readSTRef bcbool+ let count = if | (cbccurrentstart == (-1) && cbccurrentend == (-1)) ||+ ((cbccurrentend - cbccurrentstart) + 1) == 0 ||+ cbcbool+ -> Nothing + | otherwise+ -> Just ((cbccurrentend - cbccurrentstart) + 1)+ return count+ where+ iCB DS.Empty _ _ _ _ _ = pure ()+ iCB (as DS.:|> a) bs bcc bcb bccs bcce = do+ let ccbbs = (\(CcB b) -> b) $+ (\(a,_) -> a) $+ (\(FMIndexB b) -> b) bs+ let coccckbs = (\(OccCKB b) -> b) $+ (\(_,b) -> b) $+ (\(FMIndexB b) -> b) bs+ cbcc <- readSTRef bcc+ cbccs <- readSTRef bccs+ cbcce <- readSTRef bcce+ if | cbccs > cbcce+ -> do updateSTCBoolB bcb+ True+ pure ()+ | otherwise+ -> if | cbcc == 0+ -> do case DS.findIndexL (\(_,d) -> d == Just a) ccbbs of+ Nothing -> pure () + Just bindex -> do if | bindex == (DS.length ccbbs) - 1+ -> do let istart = (fst $ DS.index ccbbs bindex) + 1+ let iend = case viewl coccckbs of+ EmptyL -> (-1)+ (x DS.:< _) -> DS.length $+ snd x + updateSTCCurrentStartB bccs+ istart+ updateSTCCurrentEndB bcce+ iend+ updateSTCCounterB bcc+ 1+ iCB as+ bs+ bcc+ bcb+ bccs+ bcce + | otherwise+ -> do let istart = (fst $ DS.index ccbbs bindex) + 1+ let iend = fst $ DS.index ccbbs (bindex + 1) + updateSTCCurrentStartB bccs+ istart+ updateSTCCurrentEndB bcce+ iend+ updateSTCCounterB bcc+ 1+ iCB as+ bs+ bcc+ bcb+ bccs+ bcce+ | otherwise+ -> do case DS.findIndexL (\(_,d) -> d == Just a) ccbbs of+ Nothing -> pure ()+ Just bindex -> do case DS.findIndexL (\(e,_) -> e == Just a) coccckbs of+ Nothing -> pure ()+ Just cindex -> do let istart = (fst $ DS.index ccbbs bindex) ++ ((\(_,b,_) -> b) $+ DS.index (snd $ DS.index coccckbs cindex) (cbccs - 1 - 1)) ++ 1+ let iend = (fst $ DS.index ccbbs bindex) ++ ((\(_,b,_) -> b) $+ DS.index (snd $ DS.index coccckbs cindex) (cbcce - 1))+ updateSTCCurrentStartB bccs+ istart+ updateSTCCurrentEndB bcce+ iend+ iCB as+ bs+ bcc+ bcb+ bccs+ bcce++{-------------------------------}+++{-Count (Text) operation.-}++-- | Abstract 'PTCPat' type utilizing a 'Seq'.+type PTCPat = Seq Text++-- | Abstract 'CIntT' type utilizing an 'Int'.+type CIntT = Maybe Int++-- | Abstract 'STCBoolT' type utilizing a 'Bool'.+type STCBoolT s a = STRef s Bool++-- | State function to update 'STCBoolT' in the (strict) ST monad.+updateSTCBoolT :: STCBoolT s Bool+ -> Bool+ -> ST s ()+updateSTCBoolT s e = writeSTRef s e++-- | State function to create empty 'STCBoolT' type.+emptySTCBoolT :: ST s (STCBoolT s Bool)+emptySTCBoolT = newSTRef False++-- | Abstract data type representing a 'STCCounterT' in the (strict) ST monad.+type STCCounterT s a = STRef s Int++-- | State function to update 'STCCounterT'+updateSTCCounterT :: STCCounterT s Int+ -> Int+ -> ST s ()+updateSTCCounterT s e = writeSTRef s e++-- | State function to create empty 'STCCounterT' type.+emptySTCCounterT :: ST s (STCCounterT s Int)+emptySTCCounterT = newSTRef 0++-- | Abstract 'STCCurrentStartT' type utilizing a 'Seq'.+type STCCurrentStartT s a = STRef s Int++-- | State function to update 'STCCurrentStartT'.+updateSTCCurrentStartT :: STCCurrentStartT s Int+ -> Int+ -> ST s ()+updateSTCCurrentStartT s e = writeSTRef s e++-- | State function to create empty 'STCCurrentStartT' type.+emptySTCCurrentStartT :: ST s (STCCurrentStartT s Int)+emptySTCCurrentStartT = newSTRef (-1)++-- | Abstract 'STCCurrentEndT' type utilizing a 'Seq'.+type STCCurrentEndT s a = STRef s Int++-- | State function to update 'STCCurrentEndT'.+updateSTCCurrentEndT :: STCCurrentEndT s Int+ -> Int+ -> ST s ()+updateSTCCurrentEndT s e = writeSTRef s e++-- | State function to create empty 'STCCurrentEndT' type.+emptySTCCurrentEndT :: ST s (STCCurrentEndT s Int)+emptySTCCurrentEndT = newSTRef (-1)++-- | Count operation on a 'FMIndexT'.+-- This operation takes a pattern ('Seq' 'Text')+-- and returns the number of occurences of that pattern+-- in the original text T [credit](https://en.wikipedia.org/wiki/FM-index).+countFMIndexT :: PTCPat+ -> FMIndexT+ -> ST s CIntT+countFMIndexT DS.Empty _ = return Nothing+countFMIndexT _ (FMIndexT (CcT DS.Empty,_)) = return Nothing+countFMIndexT _ (FMIndexT (_,OccCKT DS.Empty)) = return Nothing+countFMIndexT xs ys = do+ tccounter <- emptySTCCounterT+ tcbool <- emptySTCBoolT+ tccurrentstart <- emptySTCCurrentStartT+ tccurrentend <- emptySTCCurrentEndT+ iCT xs+ ys+ tccounter+ tcbool+ tccurrentstart+ tccurrentend+ ctccurrentstart <- readSTRef tccurrentstart+ ctccurrentend <- readSTRef tccurrentend+ ctcbool <- readSTRef tcbool+ let count = if | (ctccurrentstart == (-1) && ctccurrentend == (-1)) ||+ ((ctccurrentend - ctccurrentstart) + 1) == 0 ||+ ctcbool+ -> Nothing+ | otherwise+ -> Just ((ctccurrentend - ctccurrentstart) + 1)+ return count+ where+ iCT DS.Empty _ _ _ _ _ = pure ()+ iCT (as DS.:|> a) bs tcc tcb tccs tcce = do+ let cctbs = (\(CcT t) -> t) $+ (\(a,_) -> a) $+ (\(FMIndexT t) -> t) bs+ let coccckts = (\(OccCKT t) -> t) $+ (\(_,b) -> b) $+ (\(FMIndexT t) -> t) bs+ ctcc <- readSTRef tcc+ ctccs <- readSTRef tccs+ ctcce <- readSTRef tcce+ if | ctccs > ctcce+ -> do updateSTCBoolT tcb+ True+ pure ()+ | otherwise+ -> if | ctcc == 0+ -> do case DS.findIndexL (\(_,d) -> d == Just a) cctbs of+ Nothing -> pure ()+ Just bindex -> do if | bindex == (DS.length cctbs) - 1+ -> do let istart = (fst $ DS.index cctbs bindex) + 1+ let iend = case viewl coccckts of+ EmptyL -> (-1)+ (x DS.:< _) -> DS.length $+ snd x+ updateSTCCurrentStartT tccs+ istart+ updateSTCCurrentEndT tcce+ iend+ updateSTCCounterT tcc+ 1+ iCT as+ bs+ tcc+ tcb+ tccs+ tcce+ | otherwise+ -> do let istart = (fst $ DS.index cctbs bindex) + 1+ let iend = fst $ DS.index cctbs (bindex + 1)+ updateSTCCurrentStartT tccs+ istart+ updateSTCCurrentEndT tcce+ iend+ updateSTCCounterT tcc+ 1+ iCT as+ bs+ tcc+ tcb+ tccs+ tcce+ | otherwise+ -> do case DS.findIndexL (\(_,d) -> d == Just a) cctbs of+ Nothing -> pure ()+ Just bindex -> do case DS.findIndexL (\(e,_) -> e == Just a) coccckts of+ Nothing -> pure ()+ Just cindex -> do let istart = (fst $ DS.index cctbs bindex) ++ ((\(_,b,_) -> b) $+ DS.index (snd $ DS.index coccckts cindex) (ctccs - 1 - 1)) ++ 1+ let iend = (fst $ DS.index cctbs bindex) ++ ((\(_,b,_) -> b) $+ DS.index (snd $ DS.index coccckts cindex) (ctcce - 1))+ updateSTCCurrentStartT tccs+ istart+ updateSTCCurrentEndT tcce+ iend+ iCT as+ bs+ tcc+ tcb+ tccs+ tcce {-------------------------------}
src/Data/MTF/Internal.hs view
@@ -38,7 +38,60 @@ -- 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+module Data.MTF.Internal ( -- * Base MTF types+ MTFB(..),+ MTFT(..),+ -- * Auxiliary functions+ nubSeq',+ -- * To MTF (ByteString) functions+ PBMTFSeqB,+ MTFLSSeqB,+ STMTFLSSeqB,+ initializeSTMTFLSSeqB,+ updateSTMTFLSSeqB,+ emptySTMTFLSSeqB,+ STMTFILB,+ loadSTMTFILB,+ emptySTMTFILB,+ STMTFCounterB,+ updateSTMTFCounterB,+ emptySTMTFCounterB,+ seqToMTFB,+ -- * To MTF (Text) functions+ PTMTFSeqT,+ MTFLSSeqT,+ STMTFLSSeqT,+ initializeSTMTFLSSeqT,+ updateSTMTFLSSeqT,+ emptySTMTFLSSeqT,+ STMTFILT,+ loadSTMTFILT,+ emptySTMTFILT,+ STMTFCounterT,+ updateSTMTFCounterT,+ emptySTMTFCounterT,+ seqToMTFT,+ -- * From MTF (ByteString) functions+ FMTFSeqB,+ FSTMTFSeqB,+ updateFSTMTFSeqB,+ emptyFSTMTFSeqB,+ FSTMTFILB,+ loadFSTMTFILB,+ updateFSTMTFILB,+ emptyFSTMTFILB,+ seqFromMTFB, + -- * From MTF (Text) functions+ FMTFSeqT,+ FSTMTFSeqT,+ updateFSTMTFSeqT,+ emptyFSTMTFSeqT,+ FSTMTFILT,+ loadFSTMTFILT,+ updateFSTMTFILT,+ emptyFSTMTFILT,+ seqFromMTFT+ ) where import Control.Monad as CM import Control.Monad.ST as CMST
src/Data/RLE/Internal.hs view
@@ -38,7 +38,46 @@ -- 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+module Data.RLE.Internal ( -- * Base RLE types+ RLEB(..),+ RLET(..),+ -- * To RLE (ByteString) functions+ RLESeqB,+ STRLESeqB,+ pushSTRLESeqB,+ emptySTRLESeqB,+ STRLETempB,+ updateSTRLETempB,+ emptySTRLETempB,+ STRLECounterB,+ updateSTRLECounterB,+ emptySTRLECounterB,+ seqToRLEB,+ -- * To RLE (Text) functions+ RLESeqT,+ STRLESeqT,+ pushSTRLESeqT,+ emptySTRLESeqT,+ STRLETempT,+ updateSTRLETempT,+ emptySTRLETempT,+ STRLECounterT,+ updateSTRLECounterT,+ emptySTRLECounterT,+ seqToRLET,+ -- * From RLE (ByteString) functions+ FRLESeqB,+ FSTRLESeqB,+ pushFSTRLESeqB,+ emptyFSTRLESeqB,+ seqFromRLEB,+ -- * From RLE (Text) functions+ FRLESeqT,+ FSTRLESeqT,+ pushFSTRLESeqT,+ emptyFSTRLESeqT,+ seqFromRLET+ ) where import Control.Monad as CM import Control.Monad.ST as CMST
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.15+version: 0.1.0.16 -- A short (one-line) description of the package. synopsis: A text compression library.