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


-- |
-- Module      :  Data.BWT.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 Burrows-Wheeler Transform (BWT)
-- and the Inverse BWT.
--
-- The implementation of the BWT relies upon 'DS.Seq' provided
-- by the [containers](https://hackage.haskell.org/package/containers).
--
-- The internal 'BWTMatrix' data type relies upon the 'DS.Seq' as well.


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
import Control.Monad.State.Strict()
import Data.Foldable() 
import Data.List()
import Data.Maybe as DMaybe (fromJust,isNothing)
import Data.Sequence as DS (Seq(..),empty,findIndexL,fromList,length,index,inits,null,tails,unstableSortBy,unstableSortOn,zip,(><),(|>),(<|))
import Data.STRef as DSTR
import GHC.Generics
import Prelude as P


{-Base level types.-}

-- | Basic suffix data type.  Used to describe
-- the core data inside of the 'SuffixArray' data type.
data Suffix a = Suffix { forall a. Suffix a -> Int
suffixindex    :: Int
                       , forall a. Suffix a -> Int
suffixstartpos :: Int
                       , forall a. Suffix a -> Maybe (Seq a)
suffix         :: Maybe (Seq a)
                       }
  deriving (Suffix a -> Suffix a -> Bool
forall a. Eq a => Suffix a -> Suffix a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Suffix a -> Suffix a -> Bool
$c/= :: forall a. Eq a => Suffix a -> Suffix a -> Bool
== :: Suffix a -> Suffix a -> Bool
$c== :: forall a. Eq a => Suffix a -> Suffix a -> Bool
Eq,Suffix a -> Suffix a -> Bool
Suffix a -> Suffix a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Suffix a)
forall a. Ord a => Suffix a -> Suffix a -> Bool
forall a. Ord a => Suffix a -> Suffix a -> Ordering
forall a. Ord a => Suffix a -> Suffix a -> Suffix a
min :: Suffix a -> Suffix a -> Suffix a
$cmin :: forall a. Ord a => Suffix a -> Suffix a -> Suffix a
max :: Suffix a -> Suffix a -> Suffix a
$cmax :: forall a. Ord a => Suffix a -> Suffix a -> Suffix a
>= :: Suffix a -> Suffix a -> Bool
$c>= :: forall a. Ord a => Suffix a -> Suffix a -> Bool
> :: Suffix a -> Suffix a -> Bool
$c> :: forall a. Ord a => Suffix a -> Suffix a -> Bool
<= :: Suffix a -> Suffix a -> Bool
$c<= :: forall a. Ord a => Suffix a -> Suffix a -> Bool
< :: Suffix a -> Suffix a -> Bool
$c< :: forall a. Ord a => Suffix a -> Suffix a -> Bool
compare :: Suffix a -> Suffix a -> Ordering
$ccompare :: forall a. Ord a => Suffix a -> Suffix a -> Ordering
Ord,Int -> Suffix a -> ShowS
forall a. Show a => Int -> Suffix a -> ShowS
forall a. Show a => [Suffix a] -> ShowS
forall a. Show a => Suffix a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Suffix a] -> ShowS
$cshowList :: forall a. Show a => [Suffix a] -> ShowS
show :: Suffix a -> String
$cshow :: forall a. Show a => Suffix a -> String
showsPrec :: Int -> Suffix a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Suffix a -> ShowS
Show,ReadPrec [Suffix a]
ReadPrec (Suffix a)
ReadS [Suffix a]
forall a. Read a => ReadPrec [Suffix a]
forall a. Read a => ReadPrec (Suffix a)
forall a. Read a => Int -> ReadS (Suffix a)
forall a. Read a => ReadS [Suffix a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Suffix a]
$creadListPrec :: forall a. Read a => ReadPrec [Suffix a]
readPrec :: ReadPrec (Suffix a)
$creadPrec :: forall a. Read a => ReadPrec (Suffix a)
readList :: ReadS [Suffix a]
$creadList :: forall a. Read a => ReadS [Suffix a]
readsPrec :: Int -> ReadS (Suffix a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Suffix a)
Read,forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Suffix a) x -> Suffix a
forall a x. Suffix a -> Rep (Suffix a) x
$cto :: forall a x. Rep (Suffix a) x -> Suffix a
$cfrom :: forall a x. Suffix a -> Rep (Suffix a) x
Generic)

-- | The SuffixArray data type.
-- Uses 'DS.Seq' internally.
type SuffixArray a = Seq (Suffix a)

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

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

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


{-toBWT functions.-}

-- | Computes the Burrows-Wheeler Transform (BWT) using the suffix array
-- and the original string (represented as a 'DS.Seq' for performance).
saToBWT :: SuffixArray a
        -> Seq a        
        -> Seq (Maybe a)
saToBWT :: forall a. SuffixArray a -> Seq a -> Seq (Maybe a)
saToBWT Seq (Suffix a)
DS.Empty      Seq a
_ = forall a. Seq a
DS.Empty
saToBWT (Suffix a
y DS.:<| Seq (Suffix a)
ys) Seq a
t =
  if | forall a. Suffix a -> Int
suffixstartpos Suffix a
y forall a. Eq a => a -> a -> Bool
/= Int
1
     -> (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Seq a -> Int -> a
DS.index Seq a
t (forall a. Suffix a -> Int
suffixstartpos Suffix a
y forall a. Num a => a -> a -> a
- Int
1 forall a. Num a => a -> a -> a
- Int
1))
        forall a. a -> Seq a -> Seq a
DS.<| (forall a. SuffixArray a -> Seq a -> Seq (Maybe a)
saToBWT Seq (Suffix a)
ys Seq a
t)
     | Bool
otherwise
     -> forall a. Maybe a
Nothing
        forall a. a -> Seq a -> Seq a
DS.<| (forall a. SuffixArray a -> Seq a -> Seq (Maybe a)
saToBWT Seq (Suffix a)
ys Seq a
t)

-- | Computes the corresponding 'SuffixArray' of a given string. Please see [suffix array](https://en.wikipedia.org/wiki/Suffix_array)
-- for more information. 
createSuffixArray :: Ord a
                  => Seq a
                  -> SuffixArray a
createSuffixArray :: forall a. Ord a => Seq a -> SuffixArray a
createSuffixArray Seq a
xs =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Int
a,Int
b,Seq a
c) -> if | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. Seq a -> Bool
DS.null Seq a
c
                       -> Suffix { suffixindex :: Int
suffixindex    = Int
a
                                 , suffixstartpos :: Int
suffixstartpos = Int
b
                                 , suffix :: Maybe (Seq a)
suffix         = forall a. a -> Maybe a
Just Seq a
c
                                 }
                       | Bool
otherwise
                       -> Suffix { suffixindex :: Int
suffixindex    = Int
a
                                 , suffixstartpos :: Int
suffixstartpos = Int
b
                                 , suffix :: Maybe (Seq a)
suffix         = forall a. Maybe a
Nothing
                                 }
       )
  Seq (Int, Int, Seq a)
xsssuffixesfff
    where
      xsssuffixes :: Seq (Seq a)
xsssuffixes         = forall a. Seq a -> Seq (Seq a)
DS.tails Seq a
xs
      xsssuffixesf :: Seq (Int, Seq a)
xsssuffixesf        = forall a b. Seq a -> Seq b -> Seq (a, b)
DS.zip (forall a. [a] -> Seq a
DS.fromList [Int
1..(forall a. Seq a -> Int
DS.length Seq (Seq a)
xsssuffixes)])
                                   Seq (Seq a)
xsssuffixes
      xsssuffixesffsorted :: Seq (Int, Seq a)
xsssuffixesffsorted = forall b a. Ord b => (a -> b) -> Seq a -> Seq a
DS.unstableSortOn forall a b. (a, b) -> b
snd Seq (Int, Seq a)
xsssuffixesf
      xsssuffixesfff :: Seq (Int, Int, Seq a)
xsssuffixesfff      = (\(Int
a,(Int
b,Seq a
c)) -> (Int
a,Int
b,Seq a
c))
                            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                            forall a b. Seq a -> Seq b -> Seq (a, b)
DS.zip (forall a. [a] -> Seq a
DS.fromList [Int
1..(forall a. Seq a -> Int
DS.length Seq (Int, Seq a)
xsssuffixesffsorted)])
                                   Seq (Int, Seq a)
xsssuffixesffsorted

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


{-fromBWT functions.-}

-- | Hierarchical sorting scheme that compares fst first then snd.
-- Necessary for the setting up the BWT in order to correctly
-- invert it using the [Magic](https://www.youtube.com/watch?v=QwSsppKrCj4) algorithm.
sortTB :: (Ord a1,Ord a2)
       => (a1, a2)
       -> (a1, a2)
       -> Ordering
sortTB :: forall a1 a2. (Ord a1, Ord a2) => (a1, a2) -> (a1, a2) -> Ordering
sortTB (a1
c1,a2
i1) (a1
c2,a2
i2) = forall a. Ord a => a -> a -> Ordering
compare a1
c1 a1
c2 forall a. Semigroup a => a -> a -> a
<>
                         forall a. Ord a => a -> a -> Ordering
compare a2
i1 a2
i2

-- | Abstract BWTSeq type utilizing a 'DS.Seq'.
type BWTSeq a = Seq a

-- | Abstract data type representing a BWTSeq in the (strict) ST monad.
type STBWTSeq s a = STRef s (BWTSeq a)

-- | State function to push BWTString data into stack.
pushSTBWTSeq :: STBWTSeq s a
             -> a
             -> ST s ()
pushSTBWTSeq :: forall s a. STBWTSeq s a -> a -> ST s ()
pushSTBWTSeq STBWTSeq s a
s a
e = do
  BWTSeq a
s2 <- forall s a. STRef s a -> ST s a
readSTRef STBWTSeq s a
s
  forall s a. STRef s a -> a -> ST s ()
writeSTRef STBWTSeq s a
s (BWTSeq a
s2 forall a. Seq a -> a -> Seq a
DS.|> a
e)

-- | State function to create empty STBWTString type.
emptySTBWTSeq :: ST s (STBWTSeq s a)
emptySTBWTSeq :: forall s a. ST s (STBWTSeq s a)
emptySTBWTSeq = forall a s. a -> ST s (STRef s a)
newSTRef forall a. Seq a
DS.empty

-- | Abstract BWTCounter and associated state type.
type STBWTCounter s a = STRef s Int

-- | State function to update BWTCounter.
updateSTBWTCounter :: STBWTCounter s Int
                   -> Int
                   -> ST s ()
updateSTBWTCounter :: forall s. STBWTCounter s Int -> Int -> ST s ()
updateSTBWTCounter STBWTCounter s Int
s Int
e = forall s a. STRef s a -> a -> ST s ()
writeSTRef STBWTCounter s Int
s Int
e

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

-- | "Magic" Inverse BWT function.
magicInverseBWT :: Seq (Maybe a,Int)
                -> ST s (BWTSeq a)
magicInverseBWT :: forall a s. Seq (Maybe a, Int) -> ST s (BWTSeq a)
magicInverseBWT Seq (Maybe a, Int)
DS.Empty = do
  STBWTSeq s a
bwtseqstackempty  <- forall s a. ST s (STBWTSeq s a)
emptySTBWTSeq
  BWTSeq a
bwtseqstackemptyr <- forall s a. STRef s a -> ST s a
readSTRef STBWTSeq s a
bwtseqstackempty
  forall (m :: * -> *) a. Monad m => a -> m a
return BWTSeq a
bwtseqstackemptyr
magicInverseBWT Seq (Maybe a, Int)
xs       = do
  STBWTSeq s a
bwtseqstack      <- forall s a. ST s (STBWTSeq s a)
emptySTBWTSeq
  STBWTCounter s Int
bwtcounterstackf <- forall s. ST s (STBWTCounter s Int)
emptySTBWTCounter
  STBWTCounter s Int
bwtcounterstacke <- forall s. ST s (STBWTCounter s Int)
emptySTBWTCounter
  case (forall a. (a -> Bool) -> Seq a -> Maybe Int
DS.findIndexL (\(Maybe a, Int)
x -> forall a. Maybe a -> Bool
isNothing forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst (Maybe a, Int)
x) Seq (Maybe a, Int)
xs) of
    Maybe Int
Nothing           -> do BWTSeq a
bwtseqstackr <- forall s a. STRef s a -> ST s a
readSTRef STBWTSeq s a
bwtseqstack
                            forall (m :: * -> *) a. Monad m => a -> m a
return BWTSeq a
bwtseqstackr
    Just Int
nothingindex -> do let nothingfirst :: (Maybe a, Int)
nothingfirst = forall a. Seq a -> Int -> a
DS.index Seq (Maybe a, Int)
xs
                                                        Int
nothingindex
                            forall s. STBWTCounter s Int -> Int -> ST s ()
updateSTBWTCounter STBWTCounter s Int
bwtcounterstacke
                                               Int
nothingindex
                            forall s. STBWTCounter s Int -> Int -> ST s ()
updateSTBWTCounter STBWTCounter s Int
bwtcounterstackf
                                               (forall a b. (a, b) -> b
snd (Maybe a, Int)
nothingfirst)
                            forall {a} {s}.
Seq (Maybe a, Int)
-> STBWTSeq s a -> STRef s Int -> STRef s Int -> ST s ()
iBWT Seq (Maybe a, Int)
xs
                                 STBWTSeq s a
bwtseqstack
                                 STBWTCounter s Int
bwtcounterstackf
                                 STBWTCounter s Int
bwtcounterstacke
                            BWTSeq a
bwtseqstackr <- forall s a. STRef s a -> ST s a
readSTRef STBWTSeq s a
bwtseqstack
                            forall (m :: * -> *) a. Monad m => a -> m a
return BWTSeq a
bwtseqstackr
      where
        iBWT :: Seq (Maybe a, Int)
-> STBWTSeq s a -> STRef s Int -> STRef s Int -> ST s ()
iBWT Seq (Maybe a, Int)
ys STBWTSeq s a
bwtss STRef s Int
bwtcsf STRef s Int
bwtcse = do
          Int
cbwtcsf <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
bwtcsf
          Int
cbwtcse <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
bwtcse
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
CM.when (Int
cbwtcsf forall a. Eq a => a -> a -> Bool
/= Int
cbwtcse) forall a b. (a -> b) -> a -> b
$ do 
            let next :: (Maybe a, Int)
next = forall a. Seq a -> Int -> a
DS.index Seq (Maybe a, Int)
ys Int
cbwtcsf
            forall s a. STBWTSeq s a -> a -> ST s ()
pushSTBWTSeq STBWTSeq s a
bwtss
                         (forall a. HasCallStack => Maybe a -> a
DMaybe.fromJust forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst (Maybe a, Int)
next)
            forall s. STBWTCounter s Int -> Int -> ST s ()
updateSTBWTCounter STRef s Int
bwtcsf
                               (forall a b. (a, b) -> b
snd (Maybe a, Int)
next)
            Seq (Maybe a, Int)
-> STBWTSeq s a -> STRef s Int -> STRef s Int -> ST s ()
iBWT Seq (Maybe a, Int)
ys
                 STBWTSeq s a
bwtss
                 STRef s Int
bwtcsf
                 STRef s Int
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
                => [a]
                -> BWTMatrix a
createBWTMatrix :: forall a. Ord a => [a] -> BWTMatrix a
createBWTMatrix [a]
t =
  forall a. Seq (Seq (Maybe a)) -> BWTMatrix a
BWTMatrix (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Maybe (Seq a)
a,Maybe (Seq a)
b) -> if | forall a. Maybe a -> Bool
isNothing Maybe (Seq a)
a
                                -> forall a. Maybe a
Nothing forall a. a -> Seq a -> Seq a
DS.<|
                                   (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> forall a. a -> Maybe a
Just a
x) forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Seq a)
b)
                                | forall a. Maybe a -> Bool
isNothing Maybe (Seq a)
b
                                -> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> forall a. a -> Maybe a
Just a
x) forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Seq a)
a) forall a. Seq a -> a -> Seq a
DS.|>
                                   forall a. Maybe a
Nothing
                                | Bool
otherwise
                                -> ((forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> forall a. a -> Maybe a
Just a
x) forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Seq a)
a) forall a. Seq a -> a -> Seq a
DS.|> forall a. Maybe a
Nothing) forall a. Seq a -> Seq a -> Seq a
DS.><
                                   (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> forall a. a -> Maybe a
Just a
x) forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Seq a)
b)
                  ) Seq (Maybe (Seq a), Maybe (Seq a))
zippedf)
    where
      zippedf :: Seq (Maybe (Seq a), Maybe (Seq a))
zippedf    = forall a. (a -> a -> Ordering) -> Seq a -> Seq a
DS.unstableSortBy (\(Maybe (Seq a)
a,Maybe (Seq a)
_) (Maybe (Seq a)
c,Maybe (Seq a)
_) -> forall a. Ord a => a -> a -> Ordering
compare Maybe (Seq a)
a Maybe (Seq a)
c)
                   Seq (Maybe (Seq a), Maybe (Seq a))
zippedp
      zippedp :: Seq (Maybe (Seq a), Maybe (Seq a))
zippedp    = forall a b. Seq a -> Seq b -> Seq (a, b)
DS.zip Seq (Maybe (Seq a))
suffixesf Seq (Maybe (Seq a))
prefixesf
      suffixesf :: Seq (Maybe (Seq a))
suffixesf  = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Seq a
x -> if | forall a. Seq a -> Bool
DS.null Seq a
x
                                  -> forall a. Maybe a
Nothing
                                  | Bool
otherwise
                                  -> forall a. a -> Maybe a
Just Seq a
x
                        )
                   Seq (Seq a)
suffixes
      prefixesf :: Seq (Maybe (Seq a))
prefixesf  = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Seq a
x -> if | forall a. Seq a -> Bool
DS.null Seq a
x
                                  -> forall a. Maybe a
Nothing
                                  | Bool
otherwise
                                  -> forall a. a -> Maybe a
Just Seq a
x
                        )
                   Seq (Seq a)
prefixes
      suffixes :: Seq (Seq a)
suffixes   = forall a. Seq a -> Seq (Seq a)
DS.tails Seq a
tseq
      prefixes :: Seq (Seq a)
prefixes   = forall a. Seq a -> Seq (Seq a)
DS.inits Seq a
tseq
      tseq :: Seq a
tseq       = forall a. [a] -> Seq a
DS.fromList [a]
t

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