--------------------------------------------------------------------------------
-- |
-- Module      :  Data.IndexedDoublyLinkedList
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--------------------------------------------------------------------------------
module Data.IndexedDoublyLinkedList( DLList(..)
                                   , Cell(..), emptyCell
                                   , DLListMonad, runDLListMonad
                                   , Index

                                   , singletons
                                   , writeList
                                   , valueAt, getNext, getPrev
                                   , toListFrom, toListFromR, toListContains
                                   , toListFromK, toListFromRK
                                   , insertAfter, insertBefore
                                   , delete
                                   , dump
                                   ) where

import           Control.Monad.Primitive (PrimMonad(..))
import           Control.Monad.Reader (ReaderT, runReaderT)
import           Control.Monad.Reader.Class
import           Control.Monad.ST
import           Data.Foldable (forM_)
import           Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
import           Data.Util
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as MV

--------------------------------------------------------------------------------

-- | Cell indices. Must be non-negative.
type Index = Int

-- TODO: Switch to unobxed sums for these!

-- | Cells in the Linked List
data Cell = Cell { Cell -> Maybe Index
prev :: Maybe Index
                 , Cell -> Maybe Index
next :: Maybe Index
                 } deriving (Index -> Cell -> ShowS
[Cell] -> ShowS
Cell -> String
(Index -> Cell -> ShowS)
-> (Cell -> String) -> ([Cell] -> ShowS) -> Show Cell
forall a.
(Index -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cell] -> ShowS
$cshowList :: [Cell] -> ShowS
show :: Cell -> String
$cshow :: Cell -> String
showsPrec :: Index -> Cell -> ShowS
$cshowsPrec :: Index -> Cell -> ShowS
Show,Cell -> Cell -> Bool
(Cell -> Cell -> Bool) -> (Cell -> Cell -> Bool) -> Eq Cell
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cell -> Cell -> Bool
$c/= :: Cell -> Cell -> Bool
== :: Cell -> Cell -> Bool
$c== :: Cell -> Cell -> Bool
Eq)

-- | Empty cell with no next or prev cells.
emptyCell :: Cell
emptyCell :: Cell
emptyCell = Maybe Index -> Maybe Index -> Cell
Cell Maybe Index
forall a. Maybe a
Nothing Maybe Index
forall a. Maybe a
Nothing

-- | Doubly linked list implemented by a mutable vector. So actually
-- this data type can represent a collection of Linked Lists that can
-- efficiently be concatenated and split.
--
-- Supports O(1) indexing, and O(1) insertions, deletions
data DLList s a = DLList { DLList s a -> Vector a
values :: !(V.Vector a)
                         , DLList s a -> MVector s Cell
llist  :: !(MV.MVector s Cell)
                         }

instance Functor (DLList s) where
  fmap :: (a -> b) -> DLList s a -> DLList s b
fmap a -> b
f (DLList Vector a
v MVector s Cell
l) = Vector b -> MVector s Cell -> DLList s b
forall s a. Vector a -> MVector s Cell -> DLList s a
DLList ((a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Vector a
v) MVector s Cell
l


--------------------------------------------------------------------------------

-- | Monad in which we can use the IndexedDoublyLinkedList.
newtype DLListMonad s b a = DLListMonad { DLListMonad s b a -> ReaderT (DLList s b) (ST s) a
runDLListMonad' :: ReaderT (DLList s b) (ST s) a }
                         deriving (a -> DLListMonad s b b -> DLListMonad s b a
(a -> b) -> DLListMonad s b a -> DLListMonad s b b
(forall a b. (a -> b) -> DLListMonad s b a -> DLListMonad s b b)
-> (forall a b. a -> DLListMonad s b b -> DLListMonad s b a)
-> Functor (DLListMonad s b)
forall a b. a -> DLListMonad s b b -> DLListMonad s b a
forall a b. (a -> b) -> DLListMonad s b a -> DLListMonad s b b
forall s b a b. a -> DLListMonad s b b -> DLListMonad s b a
forall s b a b. (a -> b) -> DLListMonad s b a -> DLListMonad s b b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> DLListMonad s b b -> DLListMonad s b a
$c<$ :: forall s b a b. a -> DLListMonad s b b -> DLListMonad s b a
fmap :: (a -> b) -> DLListMonad s b a -> DLListMonad s b b
$cfmap :: forall s b a b. (a -> b) -> DLListMonad s b a -> DLListMonad s b b
Functor,Functor (DLListMonad s b)
a -> DLListMonad s b a
Functor (DLListMonad s b)
-> (forall a. a -> DLListMonad s b a)
-> (forall a b.
    DLListMonad s b (a -> b) -> DLListMonad s b a -> DLListMonad s b b)
-> (forall a b c.
    (a -> b -> c)
    -> DLListMonad s b a -> DLListMonad s b b -> DLListMonad s b c)
-> (forall a b.
    DLListMonad s b a -> DLListMonad s b b -> DLListMonad s b b)
-> (forall a b.
    DLListMonad s b a -> DLListMonad s b b -> DLListMonad s b a)
-> Applicative (DLListMonad s b)
DLListMonad s b a -> DLListMonad s b b -> DLListMonad s b b
DLListMonad s b a -> DLListMonad s b b -> DLListMonad s b a
DLListMonad s b (a -> b) -> DLListMonad s b a -> DLListMonad s b b
(a -> b -> c)
-> DLListMonad s b a -> DLListMonad s b b -> DLListMonad s b c
forall a. a -> DLListMonad s b a
forall s b. Functor (DLListMonad s b)
forall a b.
DLListMonad s b a -> DLListMonad s b b -> DLListMonad s b a
forall a b.
DLListMonad s b a -> DLListMonad s b b -> DLListMonad s b b
forall a b.
DLListMonad s b (a -> b) -> DLListMonad s b a -> DLListMonad s b b
forall s b a. a -> DLListMonad s b a
forall a b c.
(a -> b -> c)
-> DLListMonad s b a -> DLListMonad s b b -> DLListMonad s b c
forall s b a b.
DLListMonad s b a -> DLListMonad s b b -> DLListMonad s b a
forall s b a b.
DLListMonad s b a -> DLListMonad s b b -> DLListMonad s b b
forall s b a b.
DLListMonad s b (a -> b) -> DLListMonad s b a -> DLListMonad s b b
forall s b a b c.
(a -> b -> c)
-> DLListMonad s b a -> DLListMonad s b b -> DLListMonad s b c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: DLListMonad s b a -> DLListMonad s b b -> DLListMonad s b a
$c<* :: forall s b a b.
DLListMonad s b a -> DLListMonad s b b -> DLListMonad s b a
*> :: DLListMonad s b a -> DLListMonad s b b -> DLListMonad s b b
$c*> :: forall s b a b.
DLListMonad s b a -> DLListMonad s b b -> DLListMonad s b b
liftA2 :: (a -> b -> c)
-> DLListMonad s b a -> DLListMonad s b b -> DLListMonad s b c
$cliftA2 :: forall s b a b c.
(a -> b -> c)
-> DLListMonad s b a -> DLListMonad s b b -> DLListMonad s b c
<*> :: DLListMonad s b (a -> b) -> DLListMonad s b a -> DLListMonad s b b
$c<*> :: forall s b a b.
DLListMonad s b (a -> b) -> DLListMonad s b a -> DLListMonad s b b
pure :: a -> DLListMonad s b a
$cpure :: forall s b a. a -> DLListMonad s b a
$cp1Applicative :: forall s b. Functor (DLListMonad s b)
Applicative,Applicative (DLListMonad s b)
a -> DLListMonad s b a
Applicative (DLListMonad s b)
-> (forall a b.
    DLListMonad s b a -> (a -> DLListMonad s b b) -> DLListMonad s b b)
-> (forall a b.
    DLListMonad s b a -> DLListMonad s b b -> DLListMonad s b b)
-> (forall a. a -> DLListMonad s b a)
-> Monad (DLListMonad s b)
DLListMonad s b a -> (a -> DLListMonad s b b) -> DLListMonad s b b
DLListMonad s b a -> DLListMonad s b b -> DLListMonad s b b
forall a. a -> DLListMonad s b a
forall s b. Applicative (DLListMonad s b)
forall a b.
DLListMonad s b a -> DLListMonad s b b -> DLListMonad s b b
forall a b.
DLListMonad s b a -> (a -> DLListMonad s b b) -> DLListMonad s b b
forall s b a. a -> DLListMonad s b a
forall s b a b.
DLListMonad s b a -> DLListMonad s b b -> DLListMonad s b b
forall s b a b.
DLListMonad s b a -> (a -> DLListMonad s b b) -> DLListMonad s b b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> DLListMonad s b a
$creturn :: forall s b a. a -> DLListMonad s b a
>> :: DLListMonad s b a -> DLListMonad s b b -> DLListMonad s b b
$c>> :: forall s b a b.
DLListMonad s b a -> DLListMonad s b b -> DLListMonad s b b
>>= :: DLListMonad s b a -> (a -> DLListMonad s b b) -> DLListMonad s b b
$c>>= :: forall s b a b.
DLListMonad s b a -> (a -> DLListMonad s b b) -> DLListMonad s b b
$cp1Monad :: forall s b. Applicative (DLListMonad s b)
Monad)

instance PrimMonad (DLListMonad s b) where
  type PrimState (DLListMonad s b) = s
  primitive :: (State# (PrimState (DLListMonad s b))
 -> (# State# (PrimState (DLListMonad s b)), a #))
-> DLListMonad s b a
primitive = ReaderT (DLList s b) (ST s) a -> DLListMonad s b a
forall s b a. ReaderT (DLList s b) (ST s) a -> DLListMonad s b a
DLListMonad (ReaderT (DLList s b) (ST s) a -> DLListMonad s b a)
-> ((State# s -> (# State# s, a #))
    -> ReaderT (DLList s b) (ST s) a)
-> (State# s -> (# State# s, a #))
-> DLListMonad s b a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State# s -> (# State# s, a #)) -> ReaderT (DLList s b) (ST s) a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive

instance MonadReader (DLList s b) (DLListMonad s b) where
  local :: (DLList s b -> DLList s b)
-> DLListMonad s b a -> DLListMonad s b a
local DLList s b -> DLList s b
f = ReaderT (DLList s b) (ST s) a -> DLListMonad s b a
forall s b a. ReaderT (DLList s b) (ST s) a -> DLListMonad s b a
DLListMonad (ReaderT (DLList s b) (ST s) a -> DLListMonad s b a)
-> (DLListMonad s b a -> ReaderT (DLList s b) (ST s) a)
-> DLListMonad s b a
-> DLListMonad s b a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DLList s b -> DLList s b)
-> ReaderT (DLList s b) (ST s) a -> ReaderT (DLList s b) (ST s) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local DLList s b -> DLList s b
f (ReaderT (DLList s b) (ST s) a -> ReaderT (DLList s b) (ST s) a)
-> (DLListMonad s b a -> ReaderT (DLList s b) (ST s) a)
-> DLListMonad s b a
-> ReaderT (DLList s b) (ST s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DLListMonad s b a -> ReaderT (DLList s b) (ST s) a
forall s b a. DLListMonad s b a -> ReaderT (DLList s b) (ST s) a
runDLListMonad'
  ask :: DLListMonad s b (DLList s b)
ask = ReaderT (DLList s b) (ST s) (DLList s b)
-> DLListMonad s b (DLList s b)
forall s b a. ReaderT (DLList s b) (ST s) a -> DLListMonad s b a
DLListMonad ReaderT (DLList s b) (ST s) (DLList s b)
forall r (m :: * -> *). MonadReader r m => m r
ask

-- | Runs a DLList Computation, starting with singleton values, crated
-- from the input vector.
runDLListMonad         :: V.Vector b -> (forall s. DLListMonad s b a) -> a
runDLListMonad :: Vector b -> (forall s. DLListMonad s b a) -> a
runDLListMonad Vector b
vs forall s. DLListMonad s b a
comp = (forall s. ST s a) -> a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s a) -> a) -> (forall s. ST s a) -> a
forall a b. (a -> b) -> a -> b
$ Vector b -> ST s (DLList s b)
forall (m :: * -> *) s b.
(PrimMonad m, s ~ PrimState m) =>
Vector b -> m (DLList s b)
singletons Vector b
vs ST s (DLList s b) -> (DLList s b -> ST s a) -> ST s a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ReaderT (DLList s b) (ST s) a -> DLList s b -> ST s a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (DLListMonad s b a -> ReaderT (DLList s b) (ST s) a
forall s b a. DLListMonad s b a -> ReaderT (DLList s b) (ST s) a
runDLListMonad' DLListMonad s b a
forall s. DLListMonad s b a
comp)

----------------------------------------

-- | Constructs a new DoublyLinkedList. Every element is its own singleton list
singletons    :: (PrimMonad m, s ~ PrimState m) => V.Vector b -> m (DLList s b)
singletons :: Vector b -> m (DLList s b)
singletons Vector b
vs = Vector b -> MVector s Cell -> DLList s b
forall s a. Vector a -> MVector s Cell -> DLList s a
DLList Vector b
vs (MVector s Cell -> DLList s b)
-> m (MVector s Cell) -> m (DLList s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index -> Cell -> m (MVector (PrimState m) Cell)
forall (m :: * -> *) a.
PrimMonad m =>
Index -> a -> m (MVector (PrimState m) a)
MV.replicate (Vector b -> Index
forall a. Vector a -> Index
V.length Vector b
vs) Cell
emptyCell

-- | Sets the DoublyLinkedList to the given List.
--
-- Indices that do not occur in the list are not touched.
writeList   :: NonEmpty Index -> DLListMonad s b ()
writeList :: NonEmpty Index -> DLListMonad s b ()
writeList NonEmpty Index
h = do MVector s Cell
v <- (DLList s b -> MVector s Cell) -> DLListMonad s b (MVector s Cell)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DLList s b -> MVector s Cell
forall s a. DLList s a -> MVector s Cell
llist
                 [STR (Maybe Index) Index (Maybe Index)]
-> (STR (Maybe Index) Index (Maybe Index) -> DLListMonad s b ())
-> DLListMonad s b ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (NonEmpty Index -> [STR (Maybe Index) Index (Maybe Index)]
forall a. NonEmpty a -> [STR (Maybe a) a (Maybe a)]
withNeighs NonEmpty Index
h) ((STR (Maybe Index) Index (Maybe Index) -> DLListMonad s b ())
 -> DLListMonad s b ())
-> (STR (Maybe Index) Index (Maybe Index) -> DLListMonad s b ())
-> DLListMonad s b ()
forall a b. (a -> b) -> a -> b
$ \(STR Maybe Index
p Index
i Maybe Index
s) ->
                   MVector (PrimState (DLListMonad s b)) Cell
-> Index -> (Cell -> Cell) -> DLListMonad s b ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Index -> (a -> a) -> m ()
modify MVector s Cell
MVector (PrimState (DLListMonad s b)) Cell
v Index
i ((Cell -> Cell) -> DLListMonad s b ())
-> (Cell -> Cell) -> DLListMonad s b ()
forall a b. (a -> b) -> a -> b
$ \Cell
c -> Cell
c { prev :: Maybe Index
prev = Maybe Index
p , next :: Maybe Index
next = Maybe Index
s }
  where
    withNeighs :: NonEmpty a -> [STR (Maybe a) a (Maybe a)]
withNeighs (a
x:|[a]
xs) = let l :: [a]
l = a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs
                         in (Maybe a -> a -> Maybe a -> STR (Maybe a) a (Maybe a))
-> [Maybe a] -> [a] -> [Maybe a] -> [STR (Maybe a) a (Maybe a)]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 Maybe a -> a -> Maybe a -> STR (Maybe a) a (Maybe a)
forall a b c. a -> b -> c -> STR a b c
STR (Maybe a
forall a. Maybe a
Nothing Maybe a -> [Maybe a] -> [Maybe a]
forall a. a -> [a] -> [a]
: (a -> Maybe a) -> [a] -> [Maybe a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Maybe a
forall a. a -> Maybe a
Just [a]
l) [a]
l ((a -> Maybe a) -> [a] -> [Maybe a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Maybe a
forall a. a -> Maybe a
Just [a]
xs [Maybe a] -> [Maybe a] -> [Maybe a]
forall a. [a] -> [a] -> [a]
++ [Maybe a
forall a. Maybe a
Nothing])

----------------------------------------
-- * Queries

-- | Gets the value at Index i
valueAt    :: Index -> DLListMonad s b b
valueAt :: Index -> DLListMonad s b b
valueAt  Index
i = (DLList s b -> b) -> DLListMonad s b b
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((Vector b -> Index -> b
forall a. Vector a -> Index -> a
V.! Index
i) (Vector b -> b) -> (DLList s b -> Vector b) -> DLList s b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DLList s b -> Vector b
forall s a. DLList s a -> Vector a
values)

-- | Next element in the List
getNext   :: Index -> DLListMonad s b (Maybe Index)
getNext :: Index -> DLListMonad s b (Maybe Index)
getNext Index
i = do MVector s Cell
v <- (DLList s b -> MVector s Cell) -> DLListMonad s b (MVector s Cell)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DLList s b -> MVector s Cell
forall s a. DLList s a -> MVector s Cell
llist
               Cell -> Maybe Index
next (Cell -> Maybe Index)
-> DLListMonad s b Cell -> DLListMonad s b (Maybe Index)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState (DLListMonad s b)) Cell
-> Index -> DLListMonad s b Cell
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Index -> m a
MV.read MVector s Cell
MVector (PrimState (DLListMonad s b)) Cell
v Index
i

-- | Previous Element in the List
getPrev   :: Index -> DLListMonad s b (Maybe Index)
getPrev :: Index -> DLListMonad s b (Maybe Index)
getPrev Index
i = do MVector s Cell
v <- (DLList s b -> MVector s Cell) -> DLListMonad s b (MVector s Cell)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DLList s b -> MVector s Cell
forall s a. DLList s a -> MVector s Cell
llist
               Cell -> Maybe Index
prev (Cell -> Maybe Index)
-> DLListMonad s b Cell -> DLListMonad s b (Maybe Index)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState (DLListMonad s b)) Cell
-> Index -> DLListMonad s b Cell
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Index -> m a
MV.read MVector s Cell
MVector (PrimState (DLListMonad s b)) Cell
v Index
i

-- | Computes a maximal length list starting from the Given index
--
-- running time: \(O(k)\), where \(k\) is the length of the output list
toListFrom   :: Index -> DLListMonad s b (NonEmpty Index)
toListFrom :: Index -> DLListMonad s b (NonEmpty Index)
toListFrom Index
i = (Index
i Index -> [Index] -> NonEmpty Index
forall a. a -> [a] -> NonEmpty a
:|) ([Index] -> NonEmpty Index)
-> DLListMonad s b [Index] -> DLListMonad s b (NonEmpty Index)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Index -> DLListMonad s b (Maybe Index))
-> Index -> DLListMonad s b [Index]
forall (m :: * -> *) a. Monad m => (a -> m (Maybe a)) -> a -> m [a]
iterateM Index -> DLListMonad s b (Maybe Index)
forall s b. Index -> DLListMonad s b (Maybe Index)
getNext Index
i

-- | Takes the current element and its k next's
toListFromK     :: Index -> Int -> DLListMonad s b (NonEmpty Index)
toListFromK :: Index -> Index -> DLListMonad s b (NonEmpty Index)
toListFromK Index
i Index
k = (Index
i Index -> [Index] -> NonEmpty Index
forall a. a -> [a] -> NonEmpty a
:|) ([Index] -> NonEmpty Index)
-> DLListMonad s b [Index] -> DLListMonad s b (NonEmpty Index)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index
-> (Index -> DLListMonad s b (Maybe Index))
-> Index
-> DLListMonad s b [Index]
forall (m :: * -> *) a.
Monad m =>
Index -> (a -> m (Maybe a)) -> a -> m [a]
replicateM Index
k Index -> DLListMonad s b (Maybe Index)
forall s b. Index -> DLListMonad s b (Maybe Index)
getNext Index
i

-- | Computes a maximal length list by walking backwards in the
-- DoublyLinkedList, starting from the Given index
--
-- running time: \(O(k)\), where \(k\) is the length of the output list
toListFromR :: Index -> DLListMonad s b (NonEmpty Index)
toListFromR :: Index -> DLListMonad s b (NonEmpty Index)
toListFromR Index
i = (Index
i Index -> [Index] -> NonEmpty Index
forall a. a -> [a] -> NonEmpty a
:|) ([Index] -> NonEmpty Index)
-> DLListMonad s b [Index] -> DLListMonad s b (NonEmpty Index)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Index -> DLListMonad s b (Maybe Index))
-> Index -> DLListMonad s b [Index]
forall (m :: * -> *) a. Monad m => (a -> m (Maybe a)) -> a -> m [a]
iterateM Index -> DLListMonad s b (Maybe Index)
forall s b. Index -> DLListMonad s b (Maybe Index)
getPrev Index
i

-- | Takes the current element and its k prev's
toListFromRK     :: Index -> Int -> DLListMonad s b (NonEmpty Index)
toListFromRK :: Index -> Index -> DLListMonad s b (NonEmpty Index)
toListFromRK Index
i Index
k = (Index
i Index -> [Index] -> NonEmpty Index
forall a. a -> [a] -> NonEmpty a
:|) ([Index] -> NonEmpty Index)
-> DLListMonad s b [Index] -> DLListMonad s b (NonEmpty Index)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index
-> (Index -> DLListMonad s b (Maybe Index))
-> Index
-> DLListMonad s b [Index]
forall (m :: * -> *) a.
Monad m =>
Index -> (a -> m (Maybe a)) -> a -> m [a]
replicateM Index
k Index -> DLListMonad s b (Maybe Index)
forall s b. Index -> DLListMonad s b (Maybe Index)
getPrev Index
i

-- | Computes a maximal length list that contains the element i.
--
-- running time: \(O(k)\), where \(k\) is the length of the output
-- list
toListContains   :: Index -> DLListMonad s b (NonEmpty Index)
toListContains :: Index -> DLListMonad s b (NonEmpty Index)
toListContains Index
i = NonEmpty Index -> NonEmpty Index -> NonEmpty Index
forall a. NonEmpty a -> NonEmpty a -> NonEmpty a
f (NonEmpty Index -> NonEmpty Index -> NonEmpty Index)
-> DLListMonad s b (NonEmpty Index)
-> DLListMonad s b (NonEmpty Index -> NonEmpty Index)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index -> DLListMonad s b (NonEmpty Index)
forall s b. Index -> DLListMonad s b (NonEmpty Index)
toListFromR Index
i DLListMonad s b (NonEmpty Index -> NonEmpty Index)
-> DLListMonad s b (NonEmpty Index)
-> DLListMonad s b (NonEmpty Index)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Index -> DLListMonad s b (NonEmpty Index)
forall s b. Index -> DLListMonad s b (NonEmpty Index)
toListFrom Index
i
  where
    f :: NonEmpty a -> NonEmpty a -> NonEmpty a
f NonEmpty a
l NonEmpty a
r = [a] -> NonEmpty a
forall a. [a] -> NonEmpty a
NonEmpty.fromList ([a] -> NonEmpty a) -> [a] -> NonEmpty a
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
reverse (NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty a
l) [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NonEmpty.tail NonEmpty a
r


----------------------------------------
-- * Updates

-- | Inserts the second argument after the first one into the linked list
insertAfter     :: Index -> Index -> DLListMonad s b ()
insertAfter :: Index -> Index -> DLListMonad s b ()
insertAfter Index
i Index
j = do MVector s Cell
v  <- (DLList s b -> MVector s Cell) -> DLListMonad s b (MVector s Cell)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DLList s b -> MVector s Cell
forall s a. DLList s a -> MVector s Cell
llist
                     Maybe Index
mr <- Index -> DLListMonad s b (Maybe Index)
forall s b. Index -> DLListMonad s b (Maybe Index)
getNext Index
i
                     MVector (PrimState (DLListMonad s b)) Cell
-> Index -> (Cell -> Cell) -> DLListMonad s b ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Index -> (a -> a) -> m ()
modify  MVector s Cell
MVector (PrimState (DLListMonad s b)) Cell
v Index
i  ((Cell -> Cell) -> DLListMonad s b ())
-> (Cell -> Cell) -> DLListMonad s b ()
forall a b. (a -> b) -> a -> b
$ \Cell
c -> Cell
c { next :: Maybe Index
next = Index -> Maybe Index
forall a. a -> Maybe a
Just Index
j }
                     MVector (PrimState (DLListMonad s b)) Cell
-> Index -> (Cell -> Cell) -> DLListMonad s b ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Index -> (a -> a) -> m ()
modify  MVector s Cell
MVector (PrimState (DLListMonad s b)) Cell
v Index
j  ((Cell -> Cell) -> DLListMonad s b ())
-> (Cell -> Cell) -> DLListMonad s b ()
forall a b. (a -> b) -> a -> b
$ \Cell
c -> Cell
c { prev :: Maybe Index
prev = Index -> Maybe Index
forall a. a -> Maybe a
Just Index
i , next :: Maybe Index
next = Maybe Index
mr }
                     MVector (PrimState (DLListMonad s b)) Cell
-> Maybe Index -> (Cell -> Cell) -> DLListMonad s b ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Maybe Index -> (a -> a) -> m ()
mModify MVector s Cell
MVector (PrimState (DLListMonad s b)) Cell
v Maybe Index
mr ((Cell -> Cell) -> DLListMonad s b ())
-> (Cell -> Cell) -> DLListMonad s b ()
forall a b. (a -> b) -> a -> b
$ \Cell
c -> Cell
c { prev :: Maybe Index
prev = Index -> Maybe Index
forall a. a -> Maybe a
Just Index
j }

-- | Inserts the second argument before the first one into the linked list
insertBefore     :: Index -> Index -> DLListMonad s b ()
insertBefore :: Index -> Index -> DLListMonad s b ()
insertBefore Index
i Index
h = do MVector s Cell
v <- (DLList s b -> MVector s Cell) -> DLListMonad s b (MVector s Cell)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DLList s b -> MVector s Cell
forall s a. DLList s a -> MVector s Cell
llist
                      Maybe Index
ml <- Index -> DLListMonad s b (Maybe Index)
forall s b. Index -> DLListMonad s b (Maybe Index)
getPrev Index
i
                      MVector (PrimState (DLListMonad s b)) Cell
-> Maybe Index -> (Cell -> Cell) -> DLListMonad s b ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Maybe Index -> (a -> a) -> m ()
mModify MVector s Cell
MVector (PrimState (DLListMonad s b)) Cell
v Maybe Index
ml ((Cell -> Cell) -> DLListMonad s b ())
-> (Cell -> Cell) -> DLListMonad s b ()
forall a b. (a -> b) -> a -> b
$ \Cell
c -> Cell
c { next :: Maybe Index
next = Index -> Maybe Index
forall a. a -> Maybe a
Just Index
h }
                      MVector (PrimState (DLListMonad s b)) Cell
-> Index -> (Cell -> Cell) -> DLListMonad s b ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Index -> (a -> a) -> m ()
modify  MVector s Cell
MVector (PrimState (DLListMonad s b)) Cell
v Index
h  ((Cell -> Cell) -> DLListMonad s b ())
-> (Cell -> Cell) -> DLListMonad s b ()
forall a b. (a -> b) -> a -> b
$ \Cell
c -> Cell
c { prev :: Maybe Index
prev = Maybe Index
ml , next :: Maybe Index
next = Index -> Maybe Index
forall a. a -> Maybe a
Just Index
i }
                      MVector (PrimState (DLListMonad s b)) Cell
-> Index -> (Cell -> Cell) -> DLListMonad s b ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Index -> (a -> a) -> m ()
modify  MVector s Cell
MVector (PrimState (DLListMonad s b)) Cell
v Index
i  ((Cell -> Cell) -> DLListMonad s b ())
-> (Cell -> Cell) -> DLListMonad s b ()
forall a b. (a -> b) -> a -> b
$ \Cell
c -> Cell
c { prev :: Maybe Index
prev = Index -> Maybe Index
forall a. a -> Maybe a
Just Index
h }

-- | Deletes the element from the linked list. This element thus
-- essentially becomes a singleton list. Returns the pair of indices
-- that now have become neighbours (i.e. the predecessor and successor
-- of j just before we deleted j).
delete   :: Index -> DLListMonad s b (Maybe Index, Maybe Index)
delete :: Index -> DLListMonad s b (Maybe Index, Maybe Index)
delete Index
j = do MVector s Cell
v <- (DLList s b -> MVector s Cell) -> DLListMonad s b (MVector s Cell)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DLList s b -> MVector s Cell
forall s a. DLList s a -> MVector s Cell
llist
              Maybe Index
ml <- Index -> DLListMonad s b (Maybe Index)
forall s b. Index -> DLListMonad s b (Maybe Index)
getPrev Index
j
              Maybe Index
mr <- Index -> DLListMonad s b (Maybe Index)
forall s b. Index -> DLListMonad s b (Maybe Index)
getNext Index
j
              MVector (PrimState (DLListMonad s b)) Cell
-> Index -> (Cell -> Cell) -> DLListMonad s b ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Index -> (a -> a) -> m ()
modify  MVector s Cell
MVector (PrimState (DLListMonad s b)) Cell
v Index
j  ((Cell -> Cell) -> DLListMonad s b ())
-> (Cell -> Cell) -> DLListMonad s b ()
forall a b. (a -> b) -> a -> b
$ \Cell
c -> Cell
c { prev :: Maybe Index
prev = Maybe Index
forall a. Maybe a
Nothing, next :: Maybe Index
next = Maybe Index
forall a. Maybe a
Nothing }
              MVector (PrimState (DLListMonad s b)) Cell
-> Maybe Index -> (Cell -> Cell) -> DLListMonad s b ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Maybe Index -> (a -> a) -> m ()
mModify MVector s Cell
MVector (PrimState (DLListMonad s b)) Cell
v Maybe Index
ml ((Cell -> Cell) -> DLListMonad s b ())
-> (Cell -> Cell) -> DLListMonad s b ()
forall a b. (a -> b) -> a -> b
$ \Cell
c -> Cell
c { next :: Maybe Index
next = Maybe Index
mr }
              MVector (PrimState (DLListMonad s b)) Cell
-> Maybe Index -> (Cell -> Cell) -> DLListMonad s b ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Maybe Index -> (a -> a) -> m ()
mModify MVector s Cell
MVector (PrimState (DLListMonad s b)) Cell
v Maybe Index
mr ((Cell -> Cell) -> DLListMonad s b ())
-> (Cell -> Cell) -> DLListMonad s b ()
forall a b. (a -> b) -> a -> b
$ \Cell
c -> Cell
c { prev :: Maybe Index
prev = Maybe Index
ml }
              (Maybe Index, Maybe Index)
-> DLListMonad s b (Maybe Index, Maybe Index)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Index
ml,Maybe Index
mr)




----------------------------------------
-- * Helper functions

-- | Applies the action at most n times.
replicateM     :: Monad m => Int -> (a -> m (Maybe a)) -> a -> m [a]
replicateM :: Index -> (a -> m (Maybe a)) -> a -> m [a]
replicateM Index
n a -> m (Maybe a)
f = Index -> a -> m [a]
go Index
n
  where
    go :: Index -> a -> m [a]
go Index
0 a
_ = [a] -> m [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    go Index
k a
x = a -> m (Maybe a)
f a
x m (Maybe a) -> (Maybe a -> m [a]) -> m [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
               Maybe a
Nothing -> [a] -> m [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
               Just a
y  -> (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> m [a] -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index -> a -> m [a]
go (Index
kIndex -> Index -> Index
forall a. Num a => a -> a -> a
-Index
1) a
y

iterateM  :: Monad m => (a -> m (Maybe a)) -> a -> m [a]
iterateM :: (a -> m (Maybe a)) -> a -> m [a]
iterateM a -> m (Maybe a)
f = a -> m [a]
go
  where
    go :: a -> m [a]
go a
x = a -> m (Maybe a)
f a
x m (Maybe a) -> (Maybe a -> m [a]) -> m [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
             Maybe a
Nothing -> [a] -> m [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
             Just a
y  -> (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> m [a] -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m [a]
go a
y

mModify   :: PrimMonad m => MV.MVector (PrimState m) a -> Maybe Int -> (a -> a) -> m ()
mModify :: MVector (PrimState m) a -> Maybe Index -> (a -> a) -> m ()
mModify MVector (PrimState m) a
v Maybe Index
mi a -> a
f = case Maybe Index
mi of
                   Maybe Index
Nothing -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                   Just Index
i  -> MVector (PrimState m) a -> Index -> (a -> a) -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Index -> (a -> a) -> m ()
modify MVector (PrimState m) a
v Index
i a -> a
f

modify        :: PrimMonad m => MV.MVector (PrimState m) a -> Int -> (a -> a) -> m ()
modify :: MVector (PrimState m) a -> Index -> (a -> a) -> m ()
modify MVector (PrimState m) a
v Index
i a -> a
f = MVector (PrimState m) a -> (a -> a) -> Index -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> (a -> a) -> Index -> m ()
MV.modify MVector (PrimState m) a
v a -> a
f Index
i


--------------------------------------------------------------------------------

-- | For debugging purposes, dump the values and the cells
dump :: DLListMonad s a (V.Vector a, V.Vector Cell)
dump :: DLListMonad s a (Vector a, Vector Cell)
dump = do DLList Vector a
v MVector s Cell
cs <- DLListMonad s a (DLList s a)
forall r (m :: * -> *). MonadReader r m => m r
ask
          Vector Cell
cs' <- MVector (PrimState (DLListMonad s a)) Cell
-> DLListMonad s a (Vector Cell)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
V.freeze MVector s Cell
MVector (PrimState (DLListMonad s a)) Cell
cs
          (Vector a, Vector Cell) -> DLListMonad s a (Vector a, Vector Cell)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vector a
v,Vector Cell
cs')