--------------------------------------------------------------------------------
-- |
-- Module      :  Data.IndexedDoublyLinkedList.Bare
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--------------------------------------------------------------------------------
module Data.IndexedDoublyLinkedList.Bare(
    IDLList(..)
  , Cell(..), emptyCell
  , IDLListMonad, runIDLListMonad
  , Index

  , singletons
  , writeList
  , 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

-- | 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
newtype IDLList s = IDLList { IDLList s -> MVector s Cell
llist  :: MV.MVector s Cell }

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

-- | Monad in which we can use the IndexedDoublyLinkedList.
newtype IDLListMonad s a = IDLListMonad { IDLListMonad s a -> ReaderT (IDLList s) (ST s) a
runIDLListMonad' :: ReaderT (IDLList s) (ST s) a }
                        deriving (a -> IDLListMonad s b -> IDLListMonad s a
(a -> b) -> IDLListMonad s a -> IDLListMonad s b
(forall a b. (a -> b) -> IDLListMonad s a -> IDLListMonad s b)
-> (forall a b. a -> IDLListMonad s b -> IDLListMonad s a)
-> Functor (IDLListMonad s)
forall a b. a -> IDLListMonad s b -> IDLListMonad s a
forall a b. (a -> b) -> IDLListMonad s a -> IDLListMonad s b
forall s a b. a -> IDLListMonad s b -> IDLListMonad s a
forall s a b. (a -> b) -> IDLListMonad s a -> IDLListMonad s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> IDLListMonad s b -> IDLListMonad s a
$c<$ :: forall s a b. a -> IDLListMonad s b -> IDLListMonad s a
fmap :: (a -> b) -> IDLListMonad s a -> IDLListMonad s b
$cfmap :: forall s a b. (a -> b) -> IDLListMonad s a -> IDLListMonad s b
Functor,Functor (IDLListMonad s)
a -> IDLListMonad s a
Functor (IDLListMonad s)
-> (forall a. a -> IDLListMonad s a)
-> (forall a b.
    IDLListMonad s (a -> b) -> IDLListMonad s a -> IDLListMonad s b)
-> (forall a b c.
    (a -> b -> c)
    -> IDLListMonad s a -> IDLListMonad s b -> IDLListMonad s c)
-> (forall a b.
    IDLListMonad s a -> IDLListMonad s b -> IDLListMonad s b)
-> (forall a b.
    IDLListMonad s a -> IDLListMonad s b -> IDLListMonad s a)
-> Applicative (IDLListMonad s)
IDLListMonad s a -> IDLListMonad s b -> IDLListMonad s b
IDLListMonad s a -> IDLListMonad s b -> IDLListMonad s a
IDLListMonad s (a -> b) -> IDLListMonad s a -> IDLListMonad s b
(a -> b -> c)
-> IDLListMonad s a -> IDLListMonad s b -> IDLListMonad s c
forall s. Functor (IDLListMonad s)
forall a. a -> IDLListMonad s a
forall s a. a -> IDLListMonad s a
forall a b.
IDLListMonad s a -> IDLListMonad s b -> IDLListMonad s a
forall a b.
IDLListMonad s a -> IDLListMonad s b -> IDLListMonad s b
forall a b.
IDLListMonad s (a -> b) -> IDLListMonad s a -> IDLListMonad s b
forall s a b.
IDLListMonad s a -> IDLListMonad s b -> IDLListMonad s a
forall s a b.
IDLListMonad s a -> IDLListMonad s b -> IDLListMonad s b
forall s a b.
IDLListMonad s (a -> b) -> IDLListMonad s a -> IDLListMonad s b
forall a b c.
(a -> b -> c)
-> IDLListMonad s a -> IDLListMonad s b -> IDLListMonad s c
forall s a b c.
(a -> b -> c)
-> IDLListMonad s a -> IDLListMonad s b -> IDLListMonad s 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
<* :: IDLListMonad s a -> IDLListMonad s b -> IDLListMonad s a
$c<* :: forall s a b.
IDLListMonad s a -> IDLListMonad s b -> IDLListMonad s a
*> :: IDLListMonad s a -> IDLListMonad s b -> IDLListMonad s b
$c*> :: forall s a b.
IDLListMonad s a -> IDLListMonad s b -> IDLListMonad s b
liftA2 :: (a -> b -> c)
-> IDLListMonad s a -> IDLListMonad s b -> IDLListMonad s c
$cliftA2 :: forall s a b c.
(a -> b -> c)
-> IDLListMonad s a -> IDLListMonad s b -> IDLListMonad s c
<*> :: IDLListMonad s (a -> b) -> IDLListMonad s a -> IDLListMonad s b
$c<*> :: forall s a b.
IDLListMonad s (a -> b) -> IDLListMonad s a -> IDLListMonad s b
pure :: a -> IDLListMonad s a
$cpure :: forall s a. a -> IDLListMonad s a
$cp1Applicative :: forall s. Functor (IDLListMonad s)
Applicative,Applicative (IDLListMonad s)
a -> IDLListMonad s a
Applicative (IDLListMonad s)
-> (forall a b.
    IDLListMonad s a -> (a -> IDLListMonad s b) -> IDLListMonad s b)
-> (forall a b.
    IDLListMonad s a -> IDLListMonad s b -> IDLListMonad s b)
-> (forall a. a -> IDLListMonad s a)
-> Monad (IDLListMonad s)
IDLListMonad s a -> (a -> IDLListMonad s b) -> IDLListMonad s b
IDLListMonad s a -> IDLListMonad s b -> IDLListMonad s b
forall s. Applicative (IDLListMonad s)
forall a. a -> IDLListMonad s a
forall s a. a -> IDLListMonad s a
forall a b.
IDLListMonad s a -> IDLListMonad s b -> IDLListMonad s b
forall a b.
IDLListMonad s a -> (a -> IDLListMonad s b) -> IDLListMonad s b
forall s a b.
IDLListMonad s a -> IDLListMonad s b -> IDLListMonad s b
forall s a b.
IDLListMonad s a -> (a -> IDLListMonad s b) -> IDLListMonad s 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 -> IDLListMonad s a
$creturn :: forall s a. a -> IDLListMonad s a
>> :: IDLListMonad s a -> IDLListMonad s b -> IDLListMonad s b
$c>> :: forall s a b.
IDLListMonad s a -> IDLListMonad s b -> IDLListMonad s b
>>= :: IDLListMonad s a -> (a -> IDLListMonad s b) -> IDLListMonad s b
$c>>= :: forall s a b.
IDLListMonad s a -> (a -> IDLListMonad s b) -> IDLListMonad s b
$cp1Monad :: forall s. Applicative (IDLListMonad s)
Monad)

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

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

-- | Runs a DLList Computation, starting with n singleton values
runIDLListMonad        :: Int -> (forall s. IDLListMonad s a) -> a
runIDLListMonad :: Index -> (forall s. IDLListMonad s a) -> a
runIDLListMonad Index
n forall s. IDLListMonad s 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
$ Index -> ST s (IDLList s)
forall (m :: * -> *) s.
(PrimMonad m, s ~ PrimState m) =>
Index -> m (IDLList s)
singletons Index
n ST s (IDLList s) -> (IDLList s -> ST s a) -> ST s a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ReaderT (IDLList s) (ST s) a -> IDLList s -> ST s a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (IDLListMonad s a -> ReaderT (IDLList s) (ST s) a
forall s a. IDLListMonad s a -> ReaderT (IDLList s) (ST s) a
runIDLListMonad' IDLListMonad s a
forall s. IDLListMonad s a
comp)

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

-- | Constructs a new DoublyLinkedList, of size at most n
singletons   :: (PrimMonad m, s ~ PrimState m) => Int -> m (IDLList s)
singletons :: Index -> m (IDLList s)
singletons Index
n = MVector s Cell -> IDLList s
forall s. MVector s Cell -> IDLList s
IDLList (MVector s Cell -> IDLList s)
-> m (MVector s Cell) -> m (IDLList s)
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 Index
n Cell
emptyCell

-- | Sets the DoublyLinkedList to the given List.
--
-- Indices that do not occur in the list are not touched.
writeList   :: NonEmpty Index -> IDLListMonad s ()
writeList :: NonEmpty Index -> IDLListMonad s ()
writeList NonEmpty Index
h = do MVector s Cell
v <- (IDLList s -> MVector s Cell) -> IDLListMonad s (MVector s Cell)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks IDLList s -> MVector s Cell
forall s. IDLList s -> MVector s Cell
llist
                 [STR (Maybe Index) Index (Maybe Index)]
-> (STR (Maybe Index) Index (Maybe Index) -> IDLListMonad s ())
-> IDLListMonad s ()
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) -> IDLListMonad s ())
 -> IDLListMonad s ())
-> (STR (Maybe Index) Index (Maybe Index) -> IDLListMonad s ())
-> IDLListMonad s ()
forall a b. (a -> b) -> a -> b
$ \(STR Maybe Index
p Index
i Maybe Index
s) ->
                   MVector (PrimState (IDLListMonad s)) Cell
-> Index -> (Cell -> Cell) -> IDLListMonad s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Index -> (a -> a) -> m ()
modify MVector s Cell
MVector (PrimState (IDLListMonad s)) Cell
v Index
i ((Cell -> Cell) -> IDLListMonad s ())
-> (Cell -> Cell) -> IDLListMonad s ()
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

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

-- | Previous Element in the List
getPrev   :: Index -> IDLListMonad s (Maybe Index)
getPrev :: Index -> IDLListMonad s (Maybe Index)
getPrev Index
i = do MVector s Cell
v <- (IDLList s -> MVector s Cell) -> IDLListMonad s (MVector s Cell)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks IDLList s -> MVector s Cell
forall s. IDLList s -> MVector s Cell
llist
               Cell -> Maybe Index
prev (Cell -> Maybe Index)
-> IDLListMonad s Cell -> IDLListMonad s (Maybe Index)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState (IDLListMonad s)) Cell
-> Index -> IDLListMonad s Cell
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Index -> m a
MV.read MVector s Cell
MVector (PrimState (IDLListMonad s)) 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 -> IDLListMonad s (NonEmpty Index)
toListFrom :: Index -> IDLListMonad s (NonEmpty Index)
toListFrom Index
i = (Index
i Index -> [Index] -> NonEmpty Index
forall a. a -> [a] -> NonEmpty a
:|) ([Index] -> NonEmpty Index)
-> IDLListMonad s [Index] -> IDLListMonad s (NonEmpty Index)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Index -> IDLListMonad s (Maybe Index))
-> Index -> IDLListMonad s [Index]
forall (m :: * -> *) a. Monad m => (a -> m (Maybe a)) -> a -> m [a]
iterateM Index -> IDLListMonad s (Maybe Index)
forall s. Index -> IDLListMonad s (Maybe Index)
getNext Index
i

-- | Takes the current element and its k next's
toListFromK     :: Index -> Int -> IDLListMonad s (NonEmpty Index)
toListFromK :: Index -> Index -> IDLListMonad s (NonEmpty Index)
toListFromK Index
i Index
k = (Index
i Index -> [Index] -> NonEmpty Index
forall a. a -> [a] -> NonEmpty a
:|) ([Index] -> NonEmpty Index)
-> IDLListMonad s [Index] -> IDLListMonad s (NonEmpty Index)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index
-> (Index -> IDLListMonad s (Maybe Index))
-> Index
-> IDLListMonad s [Index]
forall (m :: * -> *) a.
Monad m =>
Index -> (a -> m (Maybe a)) -> a -> m [a]
replicateM Index
k Index -> IDLListMonad s (Maybe Index)
forall s. Index -> IDLListMonad s (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 -> IDLListMonad s (NonEmpty Index)
toListFromR :: Index -> IDLListMonad s (NonEmpty Index)
toListFromR Index
i = (Index
i Index -> [Index] -> NonEmpty Index
forall a. a -> [a] -> NonEmpty a
:|) ([Index] -> NonEmpty Index)
-> IDLListMonad s [Index] -> IDLListMonad s (NonEmpty Index)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Index -> IDLListMonad s (Maybe Index))
-> Index -> IDLListMonad s [Index]
forall (m :: * -> *) a. Monad m => (a -> m (Maybe a)) -> a -> m [a]
iterateM Index -> IDLListMonad s (Maybe Index)
forall s. Index -> IDLListMonad s (Maybe Index)
getPrev Index
i

-- | Takes the current element and its k prev's
toListFromRK     :: Index -> Int -> IDLListMonad s (NonEmpty Index)
toListFromRK :: Index -> Index -> IDLListMonad s (NonEmpty Index)
toListFromRK Index
i Index
k = (Index
i Index -> [Index] -> NonEmpty Index
forall a. a -> [a] -> NonEmpty a
:|) ([Index] -> NonEmpty Index)
-> IDLListMonad s [Index] -> IDLListMonad s (NonEmpty Index)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index
-> (Index -> IDLListMonad s (Maybe Index))
-> Index
-> IDLListMonad s [Index]
forall (m :: * -> *) a.
Monad m =>
Index -> (a -> m (Maybe a)) -> a -> m [a]
replicateM Index
k Index -> IDLListMonad s (Maybe Index)
forall s. Index -> IDLListMonad s (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 -> IDLListMonad s (NonEmpty Index)
toListContains :: Index -> IDLListMonad s (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)
-> IDLListMonad s (NonEmpty Index)
-> IDLListMonad s (NonEmpty Index -> NonEmpty Index)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index -> IDLListMonad s (NonEmpty Index)
forall s. Index -> IDLListMonad s (NonEmpty Index)
toListFromR Index
i IDLListMonad s (NonEmpty Index -> NonEmpty Index)
-> IDLListMonad s (NonEmpty Index)
-> IDLListMonad s (NonEmpty Index)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Index -> IDLListMonad s (NonEmpty Index)
forall s. Index -> IDLListMonad s (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 -> IDLListMonad s ()
insertAfter :: Index -> Index -> IDLListMonad s ()
insertAfter Index
i Index
j = do MVector s Cell
v  <- (IDLList s -> MVector s Cell) -> IDLListMonad s (MVector s Cell)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks IDLList s -> MVector s Cell
forall s. IDLList s -> MVector s Cell
llist
                     Maybe Index
mr <- Index -> IDLListMonad s (Maybe Index)
forall s. Index -> IDLListMonad s (Maybe Index)
getNext Index
i
                     MVector (PrimState (IDLListMonad s)) Cell
-> Index -> (Cell -> Cell) -> IDLListMonad s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Index -> (a -> a) -> m ()
modify  MVector s Cell
MVector (PrimState (IDLListMonad s)) Cell
v Index
i  ((Cell -> Cell) -> IDLListMonad s ())
-> (Cell -> Cell) -> IDLListMonad s ()
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 (IDLListMonad s)) Cell
-> Index -> (Cell -> Cell) -> IDLListMonad s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Index -> (a -> a) -> m ()
modify  MVector s Cell
MVector (PrimState (IDLListMonad s)) Cell
v Index
j  ((Cell -> Cell) -> IDLListMonad s ())
-> (Cell -> Cell) -> IDLListMonad s ()
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 (IDLListMonad s)) Cell
-> Maybe Index -> (Cell -> Cell) -> IDLListMonad s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Maybe Index -> (a -> a) -> m ()
mModify MVector s Cell
MVector (PrimState (IDLListMonad s)) Cell
v Maybe Index
mr ((Cell -> Cell) -> IDLListMonad s ())
-> (Cell -> Cell) -> IDLListMonad s ()
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 -> IDLListMonad s ()
insertBefore :: Index -> Index -> IDLListMonad s ()
insertBefore Index
i Index
h = do MVector s Cell
v <- (IDLList s -> MVector s Cell) -> IDLListMonad s (MVector s Cell)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks IDLList s -> MVector s Cell
forall s. IDLList s -> MVector s Cell
llist
                      Maybe Index
ml <- Index -> IDLListMonad s (Maybe Index)
forall s. Index -> IDLListMonad s (Maybe Index)
getPrev Index
i
                      MVector (PrimState (IDLListMonad s)) Cell
-> Maybe Index -> (Cell -> Cell) -> IDLListMonad s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Maybe Index -> (a -> a) -> m ()
mModify MVector s Cell
MVector (PrimState (IDLListMonad s)) Cell
v Maybe Index
ml ((Cell -> Cell) -> IDLListMonad s ())
-> (Cell -> Cell) -> IDLListMonad s ()
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 (IDLListMonad s)) Cell
-> Index -> (Cell -> Cell) -> IDLListMonad s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Index -> (a -> a) -> m ()
modify  MVector s Cell
MVector (PrimState (IDLListMonad s)) Cell
v Index
h  ((Cell -> Cell) -> IDLListMonad s ())
-> (Cell -> Cell) -> IDLListMonad s ()
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 (IDLListMonad s)) Cell
-> Index -> (Cell -> Cell) -> IDLListMonad s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Index -> (a -> a) -> m ()
modify  MVector s Cell
MVector (PrimState (IDLListMonad s)) Cell
v Index
i  ((Cell -> Cell) -> IDLListMonad s ())
-> (Cell -> Cell) -> IDLListMonad s ()
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.
delete   :: Index -> IDLListMonad s ()
delete :: Index -> IDLListMonad s ()
delete Index
j = do MVector s Cell
v <- (IDLList s -> MVector s Cell) -> IDLListMonad s (MVector s Cell)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks IDLList s -> MVector s Cell
forall s. IDLList s -> MVector s Cell
llist
              Maybe Index
ml <- Index -> IDLListMonad s (Maybe Index)
forall s. Index -> IDLListMonad s (Maybe Index)
getPrev Index
j
              Maybe Index
mr <- Index -> IDLListMonad s (Maybe Index)
forall s. Index -> IDLListMonad s (Maybe Index)
getNext Index
j
              MVector (PrimState (IDLListMonad s)) Cell
-> Index -> (Cell -> Cell) -> IDLListMonad s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Index -> (a -> a) -> m ()
modify  MVector s Cell
MVector (PrimState (IDLListMonad s)) Cell
v Index
j  ((Cell -> Cell) -> IDLListMonad s ())
-> (Cell -> Cell) -> IDLListMonad s ()
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 (IDLListMonad s)) Cell
-> Maybe Index -> (Cell -> Cell) -> IDLListMonad s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Maybe Index -> (a -> a) -> m ()
mModify MVector s Cell
MVector (PrimState (IDLListMonad s)) Cell
v Maybe Index
ml ((Cell -> Cell) -> IDLListMonad s ())
-> (Cell -> Cell) -> IDLListMonad s ()
forall a b. (a -> b) -> a -> b
$ \Cell
c -> Cell
c { next :: Maybe Index
next = Maybe Index
mr }
              MVector (PrimState (IDLListMonad s)) Cell
-> Maybe Index -> (Cell -> Cell) -> IDLListMonad s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Maybe Index -> (a -> a) -> m ()
mModify MVector s Cell
MVector (PrimState (IDLListMonad s)) Cell
v Maybe Index
mr ((Cell -> Cell) -> IDLListMonad s ())
-> (Cell -> Cell) -> IDLListMonad s ()
forall a b. (a -> b) -> a -> b
$ \Cell
c -> Cell
c { prev :: Maybe Index
prev = Maybe Index
ml }

----------------------------------------
-- * 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 :: IDLListMonad s (V.Vector Cell)
dump :: IDLListMonad s (Vector Cell)
dump = do IDLList MVector s Cell
cs <- IDLListMonad s (IDLList s)
forall r (m :: * -> *). MonadReader r m => m r
ask
          MVector (PrimState (IDLListMonad s)) Cell
-> IDLListMonad s (Vector Cell)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
V.freeze MVector s Cell
MVector (PrimState (IDLListMonad s)) Cell
cs