module AOC.Common.DLLC where
-- module AOC.Common.DLLC (
--   ) where

-- import           Data.Mutable
import           Control.Monad.Primitive
import           Data.Foldable
import           Control.Monad
import           Data.Void
import           Control.Monad.Trans.Class
import           Data.List.NonEmpty      (NonEmpty(..))
import           Data.Primitive.MutVar
import qualified Data.List.NonEmpty      as NE
import qualified Data.Conduino as C
import qualified Data.Conduino.Combinators as C

data Node s a = Node { forall s a. Node s a -> MutVar s (Node s a)
nLeft :: MutVar s (Node s a), forall s a. Node s a -> a
nItem :: a, forall s a. Node s a -> MutVar s (Node s a)
nRight :: MutVar s (Node s a) }
  deriving Node s a -> Node s a -> Bool
(Node s a -> Node s a -> Bool)
-> (Node s a -> Node s a -> Bool) -> Eq (Node s a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall s a. Eq a => Node s a -> Node s a -> Bool
/= :: Node s a -> Node s a -> Bool
$c/= :: forall s a. Eq a => Node s a -> Node s a -> Bool
== :: Node s a -> Node s a -> Bool
$c== :: forall s a. Eq a => Node s a -> Node s a -> Bool
Eq

newtype List s a = List { forall s a. List s a -> MutVar s (MutVar s (Node s a))
getList :: MutVar s (MutVar s (Node s a)) }
  deriving List s a -> List s a -> Bool
(List s a -> List s a -> Bool)
-> (List s a -> List s a -> Bool) -> Eq (List s a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall s a. List s a -> List s a -> Bool
/= :: List s a -> List s a -> Bool
$c/= :: forall s a. List s a -> List s a -> Bool
== :: List s a -> List s a -> Bool
$c== :: forall s a. List s a -> List s a -> Bool
Eq

-- data List s a = List (MutVar s (List s a)) (Ref s a) (MutVar s (List s a))

cloneTop :: (PrimMonad m, PrimState m ~ s) => List s a -> m (List s a)
cloneTop :: forall (m :: * -> *) s a.
(PrimMonad m, PrimState m ~ s) =>
List s a -> m (List s a)
cloneTop (List MutVar s (MutVar s (Node s a))
x) = MutVar s (MutVar s (Node s a)) -> List s a
forall s a. MutVar s (MutVar s (Node s a)) -> List s a
List (MutVar s (MutVar s (Node s a)) -> List s a)
-> m (MutVar s (MutVar s (Node s a))) -> m (List s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
    MutVar s (Node s a) -> m (MutVar s (MutVar s (Node s a)))
forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MutVar (PrimState m) a)
newMutVar (MutVar s (Node s a) -> m (MutVar s (MutVar s (Node s a))))
-> m (MutVar s (Node s a)) -> m (MutVar s (MutVar s (Node s a)))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Node s a -> m (MutVar s (Node s a))
forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MutVar (PrimState m) a)
newMutVar (Node s a -> m (MutVar s (Node s a)))
-> m (Node s a) -> m (MutVar s (Node s a))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MutVar s (Node s a) -> m (Node s a)
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar (MutVar s (Node s a) -> m (Node s a))
-> m (MutVar s (Node s a)) -> m (Node s a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MutVar (PrimState m) (MutVar s (Node s a))
-> m (MutVar s (Node s a))
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar s (MutVar s (Node s a))
MutVar (PrimState m) (MutVar s (Node s a))
x

singleton
    :: (PrimMonad m, PrimState m ~ s)
    => a
    -> m (List s a)
singleton :: forall (m :: * -> *) s a.
(PrimMonad m, PrimState m ~ s) =>
a -> m (List s a)
singleton a
x = do
    MutVar s (Node s a)
n0 <- Node s a -> m (MutVar (PrimState m) (Node s a))
forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MutVar (PrimState m) a)
newMutVar (Node s a -> m (MutVar (PrimState m) (Node s a)))
-> Node s a -> m (MutVar (PrimState m) (Node s a))
forall a b. (a -> b) -> a -> b
$ Node s a
forall a. HasCallStack => a
undefined
    MutVar (PrimState m) (Node s a) -> Node s a -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> a -> m ()
writeMutVar MutVar s (Node s a)
MutVar (PrimState m) (Node s a)
n0 (Node s a -> m ()) -> Node s a -> m ()
forall a b. (a -> b) -> a -> b
$ MutVar s (Node s a) -> a -> MutVar s (Node s a) -> Node s a
forall s a.
MutVar s (Node s a) -> a -> MutVar s (Node s a) -> Node s a
Node MutVar s (Node s a)
n0 a
x MutVar s (Node s a)
n0
    MutVar s (MutVar s (Node s a)) -> List s a
forall s a. MutVar s (MutVar s (Node s a)) -> List s a
List (MutVar s (MutVar s (Node s a)) -> List s a)
-> m (MutVar s (MutVar s (Node s a))) -> m (List s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutVar s (Node s a)
-> m (MutVar (PrimState m) (MutVar s (Node s a)))
forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MutVar (PrimState m) a)
newMutVar MutVar s (Node s a)
n0

fromList :: (PrimMonad m, PrimState m ~ s) => NonEmpty a -> m (List s a)
fromList :: forall (m :: * -> *) s a.
(PrimMonad m, PrimState m ~ s) =>
NonEmpty a -> m (List s a)
fromList (a
x :| [a]
xs) = do
    List s a
l0 <- a -> m (List s a)
forall (m :: * -> *) s a.
(PrimMonad m, PrimState m ~ s) =>
a -> m (List s a)
singleton a
x
    (a -> m ()) -> [a] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (a -> List s a -> m ()
forall (m :: * -> *) s a.
(PrimMonad m, PrimState m ~ s) =>
a -> List s a -> m ()
`insertRight` List s a
l0) ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
xs)
    pure List s a
l0

sourceRight
    :: (PrimMonad m, PrimState m ~ s)
    => List s a
    -> C.Pipe i a u m ()
sourceRight :: forall (m :: * -> *) s a i u.
(PrimMonad m, PrimState m ~ s) =>
List s a -> Pipe i a u m ()
sourceRight List s a
lst = do
    MutVar s (Node s a)
r0 <- m (MutVar s (Node s a)) -> Pipe i a u m (MutVar s (Node s a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (MutVar s (Node s a)) -> Pipe i a u m (MutVar s (Node s a)))
-> m (MutVar s (Node s a)) -> Pipe i a u m (MutVar s (Node s a))
forall a b. (a -> b) -> a -> b
$ MutVar (PrimState m) (MutVar s (Node s a))
-> m (MutVar s (Node s a))
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar (List s a -> MutVar s (MutVar s (Node s a))
forall s a. List s a -> MutVar s (MutVar s (Node s a))
getList List s a
lst)
    Node s a
n0 <- m (Node s a) -> Pipe i a u m (Node s a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Node s a) -> Pipe i a u m (Node s a))
-> m (Node s a) -> Pipe i a u m (Node s a)
forall a b. (a -> b) -> a -> b
$ MutVar (PrimState m) (Node s a) -> m (Node s a)
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar s (Node s a)
MutVar (PrimState m) (Node s a)
r0
    a -> Pipe i a u m ()
forall o i u (m :: * -> *). o -> Pipe i o u m ()
C.yield (Node s a -> a
forall s a. Node s a -> a
nItem Node s a
n0)
    MutVar (PrimState m) (Node (PrimState m) a)
-> MutVar (PrimState m) (Node (PrimState m) a) -> Pipe i a u m ()
forall {m :: * -> *} {a} {i} {u}.
PrimMonad m =>
MutVar (PrimState m) (Node (PrimState m) a)
-> MutVar (PrimState m) (Node (PrimState m) a) -> Pipe i a u m ()
go1 MutVar s (Node s a)
MutVar (PrimState m) (Node (PrimState m) a)
r0 (Node s a -> MutVar s (Node s a)
forall s a. Node s a -> MutVar s (Node s a)
nRight Node s a
n0)
  where
    go1 :: MutVar (PrimState m) (Node (PrimState m) a)
-> MutVar (PrimState m) (Node (PrimState m) a) -> Pipe i a u m ()
go1 MutVar (PrimState m) (Node (PrimState m) a)
r0 = MutVar (PrimState m) (Node (PrimState m) a) -> Pipe i a u m ()
go
      where
        go :: MutVar (PrimState m) (Node (PrimState m) a) -> Pipe i a u m ()
go MutVar (PrimState m) (Node (PrimState m) a)
r
          | MutVar (PrimState m) (Node (PrimState m) a)
r MutVar (PrimState m) (Node (PrimState m) a)
-> MutVar (PrimState m) (Node (PrimState m) a) -> Bool
forall a. Eq a => a -> a -> Bool
== MutVar (PrimState m) (Node (PrimState m) a)
r0   = () -> Pipe i a u m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          | Bool
otherwise = do
              Node (PrimState m) a
n <- m (Node (PrimState m) a) -> Pipe i a u m (Node (PrimState m) a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Node (PrimState m) a) -> Pipe i a u m (Node (PrimState m) a))
-> m (Node (PrimState m) a) -> Pipe i a u m (Node (PrimState m) a)
forall a b. (a -> b) -> a -> b
$ MutVar (PrimState m) (Node (PrimState m) a)
-> m (Node (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar (PrimState m) (Node (PrimState m) a)
r
              a -> Pipe i a u m ()
forall o i u (m :: * -> *). o -> Pipe i o u m ()
C.yield (Node (PrimState m) a -> a
forall s a. Node s a -> a
nItem Node (PrimState m) a
n)
              MutVar (PrimState m) (Node (PrimState m) a) -> Pipe i a u m ()
go (Node (PrimState m) a -> MutVar (PrimState m) (Node (PrimState m) a)
forall s a. Node s a -> MutVar s (Node s a)
nRight Node (PrimState m) a
n)

sourceRightForever
    :: (PrimMonad m, PrimState m ~ s)
    => List s a
    -> C.Pipe i a u m r
sourceRightForever :: forall (m :: * -> *) s a i u r.
(PrimMonad m, PrimState m ~ s) =>
List s a -> Pipe i a u m r
sourceRightForever List s a
lst = do
    MutVar s (Node s a)
r0 <- m (MutVar s (Node s a)) -> Pipe i a u m (MutVar s (Node s a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (MutVar s (Node s a)) -> Pipe i a u m (MutVar s (Node s a)))
-> m (MutVar s (Node s a)) -> Pipe i a u m (MutVar s (Node s a))
forall a b. (a -> b) -> a -> b
$ MutVar (PrimState m) (MutVar s (Node s a))
-> m (MutVar s (Node s a))
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar (List s a -> MutVar s (MutVar s (Node s a))
forall s a. List s a -> MutVar s (MutVar s (Node s a))
getList List s a
lst)
    MutVar (PrimState m) (Node (PrimState m) a) -> Pipe i a u m r
forall {m :: * -> *} {a} {i} {u} {b}.
PrimMonad m =>
MutVar (PrimState m) (Node (PrimState m) a) -> Pipe i a u m b
go MutVar s (Node s a)
MutVar (PrimState m) (Node (PrimState m) a)
r0
  where
    go :: MutVar (PrimState m) (Node (PrimState m) a) -> Pipe i a u m b
go MutVar (PrimState m) (Node (PrimState m) a)
r = do
      Node (PrimState m) a
n <- m (Node (PrimState m) a) -> Pipe i a u m (Node (PrimState m) a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Node (PrimState m) a) -> Pipe i a u m (Node (PrimState m) a))
-> m (Node (PrimState m) a) -> Pipe i a u m (Node (PrimState m) a)
forall a b. (a -> b) -> a -> b
$ MutVar (PrimState m) (Node (PrimState m) a)
-> m (Node (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar (PrimState m) (Node (PrimState m) a)
r
      a -> Pipe i a u m ()
forall o i u (m :: * -> *). o -> Pipe i o u m ()
C.yield (Node (PrimState m) a -> a
forall s a. Node s a -> a
nItem Node (PrimState m) a
n)
      MutVar (PrimState m) (Node (PrimState m) a) -> Pipe i a u m b
go (Node (PrimState m) a -> MutVar (PrimState m) (Node (PrimState m) a)
forall s a. Node s a -> MutVar s (Node s a)
nRight Node (PrimState m) a
n)

sourceLeft
    :: (PrimMonad m, PrimState m ~ s)
    => List s a
    -> C.Pipe i a u m ()
sourceLeft :: forall (m :: * -> *) s a i u.
(PrimMonad m, PrimState m ~ s) =>
List s a -> Pipe i a u m ()
sourceLeft List s a
lst = do
    MutVar s (Node s a)
r0 <- m (MutVar s (Node s a)) -> Pipe i a u m (MutVar s (Node s a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (MutVar s (Node s a)) -> Pipe i a u m (MutVar s (Node s a)))
-> m (MutVar s (Node s a)) -> Pipe i a u m (MutVar s (Node s a))
forall a b. (a -> b) -> a -> b
$ MutVar (PrimState m) (MutVar s (Node s a))
-> m (MutVar s (Node s a))
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar (List s a -> MutVar s (MutVar s (Node s a))
forall s a. List s a -> MutVar s (MutVar s (Node s a))
getList List s a
lst)
    Node s a
n0 <- m (Node s a) -> Pipe i a u m (Node s a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Node s a) -> Pipe i a u m (Node s a))
-> m (Node s a) -> Pipe i a u m (Node s a)
forall a b. (a -> b) -> a -> b
$ MutVar (PrimState m) (Node s a) -> m (Node s a)
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar s (Node s a)
MutVar (PrimState m) (Node s a)
r0
    a -> Pipe i a u m ()
forall o i u (m :: * -> *). o -> Pipe i o u m ()
C.yield (Node s a -> a
forall s a. Node s a -> a
nItem Node s a
n0)
    MutVar (PrimState m) (Node (PrimState m) a)
-> MutVar (PrimState m) (Node (PrimState m) a) -> Pipe i a u m ()
forall {m :: * -> *} {a} {i} {u}.
PrimMonad m =>
MutVar (PrimState m) (Node (PrimState m) a)
-> MutVar (PrimState m) (Node (PrimState m) a) -> Pipe i a u m ()
go1 MutVar s (Node s a)
MutVar (PrimState m) (Node (PrimState m) a)
r0 (Node s a -> MutVar s (Node s a)
forall s a. Node s a -> MutVar s (Node s a)
nLeft Node s a
n0)
  where
    go1 :: MutVar (PrimState m) (Node (PrimState m) a)
-> MutVar (PrimState m) (Node (PrimState m) a) -> Pipe i a u m ()
go1 MutVar (PrimState m) (Node (PrimState m) a)
r0 = MutVar (PrimState m) (Node (PrimState m) a) -> Pipe i a u m ()
go
      where
        go :: MutVar (PrimState m) (Node (PrimState m) a) -> Pipe i a u m ()
go MutVar (PrimState m) (Node (PrimState m) a)
r
          | MutVar (PrimState m) (Node (PrimState m) a)
r MutVar (PrimState m) (Node (PrimState m) a)
-> MutVar (PrimState m) (Node (PrimState m) a) -> Bool
forall a. Eq a => a -> a -> Bool
== MutVar (PrimState m) (Node (PrimState m) a)
r0   = () -> Pipe i a u m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          | Bool
otherwise = do
              Node (PrimState m) a
n <- m (Node (PrimState m) a) -> Pipe i a u m (Node (PrimState m) a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Node (PrimState m) a) -> Pipe i a u m (Node (PrimState m) a))
-> m (Node (PrimState m) a) -> Pipe i a u m (Node (PrimState m) a)
forall a b. (a -> b) -> a -> b
$ MutVar (PrimState m) (Node (PrimState m) a)
-> m (Node (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar (PrimState m) (Node (PrimState m) a)
r
              a -> Pipe i a u m ()
forall o i u (m :: * -> *). o -> Pipe i o u m ()
C.yield (Node (PrimState m) a -> a
forall s a. Node s a -> a
nItem Node (PrimState m) a
n)
              MutVar (PrimState m) (Node (PrimState m) a) -> Pipe i a u m ()
go (Node (PrimState m) a -> MutVar (PrimState m) (Node (PrimState m) a)
forall s a. Node s a -> MutVar s (Node s a)
nLeft Node (PrimState m) a
n)

sourceLeftForever
    :: (PrimMonad m, PrimState m ~ s)
    => List s a
    -> C.Pipe i a u m r
sourceLeftForever :: forall (m :: * -> *) s a i u r.
(PrimMonad m, PrimState m ~ s) =>
List s a -> Pipe i a u m r
sourceLeftForever List s a
lst = do
    MutVar s (Node s a)
r0 <- m (MutVar s (Node s a)) -> Pipe i a u m (MutVar s (Node s a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (MutVar s (Node s a)) -> Pipe i a u m (MutVar s (Node s a)))
-> m (MutVar s (Node s a)) -> Pipe i a u m (MutVar s (Node s a))
forall a b. (a -> b) -> a -> b
$ MutVar (PrimState m) (MutVar s (Node s a))
-> m (MutVar s (Node s a))
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar (List s a -> MutVar s (MutVar s (Node s a))
forall s a. List s a -> MutVar s (MutVar s (Node s a))
getList List s a
lst)
    MutVar (PrimState m) (Node (PrimState m) a) -> Pipe i a u m r
forall {m :: * -> *} {a} {i} {u} {b}.
PrimMonad m =>
MutVar (PrimState m) (Node (PrimState m) a) -> Pipe i a u m b
go MutVar s (Node s a)
MutVar (PrimState m) (Node (PrimState m) a)
r0
  where
    go :: MutVar (PrimState m) (Node (PrimState m) a) -> Pipe i a u m b
go MutVar (PrimState m) (Node (PrimState m) a)
r = do
      Node (PrimState m) a
n <- m (Node (PrimState m) a) -> Pipe i a u m (Node (PrimState m) a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Node (PrimState m) a) -> Pipe i a u m (Node (PrimState m) a))
-> m (Node (PrimState m) a) -> Pipe i a u m (Node (PrimState m) a)
forall a b. (a -> b) -> a -> b
$ MutVar (PrimState m) (Node (PrimState m) a)
-> m (Node (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar (PrimState m) (Node (PrimState m) a)
r
      a -> Pipe i a u m ()
forall o i u (m :: * -> *). o -> Pipe i o u m ()
C.yield (Node (PrimState m) a -> a
forall s a. Node s a -> a
nItem Node (PrimState m) a
n)
      MutVar (PrimState m) (Node (PrimState m) a) -> Pipe i a u m b
go (Node (PrimState m) a -> MutVar (PrimState m) (Node (PrimState m) a)
forall s a. Node s a -> MutVar s (Node s a)
nLeft Node (PrimState m) a
n)

sourceZip
    :: (PrimMonad m, PrimState m ~ s)
    => List s a
    -> C.Pipe i (a, a) u m ()
sourceZip :: forall (m :: * -> *) s a i u.
(PrimMonad m, PrimState m ~ s) =>
List s a -> Pipe i (a, a) u m ()
sourceZip List s a
lst = do
    MutVar s (Node s a)
r0 <- m (MutVar s (Node s a)) -> Pipe i (a, a) u m (MutVar s (Node s a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (MutVar s (Node s a))
 -> Pipe i (a, a) u m (MutVar s (Node s a)))
-> m (MutVar s (Node s a))
-> Pipe i (a, a) u m (MutVar s (Node s a))
forall a b. (a -> b) -> a -> b
$ MutVar (PrimState m) (MutVar s (Node s a))
-> m (MutVar s (Node s a))
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar (List s a -> MutVar s (MutVar s (Node s a))
forall s a. List s a -> MutVar s (MutVar s (Node s a))
getList List s a
lst)
    Node s a
n0 <- m (Node s a) -> Pipe i (a, a) u m (Node s a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Node s a) -> Pipe i (a, a) u m (Node s a))
-> m (Node s a) -> Pipe i (a, a) u m (Node s a)
forall a b. (a -> b) -> a -> b
$ MutVar (PrimState m) (Node s a) -> m (Node s a)
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar s (Node s a)
MutVar (PrimState m) (Node s a)
r0
    MutVar (PrimState m) (Node (PrimState m) a)
-> MutVar (PrimState m) (Node (PrimState m) a)
-> MutVar (PrimState m) (Node (PrimState m) a)
-> Pipe i (a, a) u m ()
forall {m :: * -> *} {a} {a} {i} {u}.
PrimMonad m =>
MutVar (PrimState m) (Node (PrimState m) a)
-> MutVar (PrimState m) (Node (PrimState m) a)
-> MutVar (PrimState m) (Node (PrimState m) a)
-> Pipe i (a, a) u m ()
go1 MutVar s (Node s a)
MutVar (PrimState m) (Node (PrimState m) a)
r0 (Node s a -> MutVar s (Node s a)
forall s a. Node s a -> MutVar s (Node s a)
nLeft Node s a
n0) (Node s a -> MutVar s (Node s a)
forall s a. Node s a -> MutVar s (Node s a)
nRight Node s a
n0)
  where
    go1 :: MutVar (PrimState m) (Node (PrimState m) a)
-> MutVar (PrimState m) (Node (PrimState m) a)
-> MutVar (PrimState m) (Node (PrimState m) a)
-> Pipe i (a, a) u m ()
go1 MutVar (PrimState m) (Node (PrimState m) a)
r0 = MutVar (PrimState m) (Node (PrimState m) a)
-> MutVar (PrimState m) (Node (PrimState m) a)
-> Pipe i (a, a) u m ()
go
      where
        go :: MutVar (PrimState m) (Node (PrimState m) a)
-> MutVar (PrimState m) (Node (PrimState m) a)
-> Pipe i (a, a) u m ()
go MutVar (PrimState m) (Node (PrimState m) a)
rl MutVar (PrimState m) (Node (PrimState m) a)
rr
          | MutVar (PrimState m) (Node (PrimState m) a)
rl MutVar (PrimState m) (Node (PrimState m) a)
-> MutVar (PrimState m) (Node (PrimState m) a) -> Bool
forall a. Eq a => a -> a -> Bool
== MutVar (PrimState m) (Node (PrimState m) a)
r0  = () -> Pipe i (a, a) u m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          | Bool
otherwise = do
              Node (PrimState m) a
nl <- m (Node (PrimState m) a)
-> Pipe i (a, a) u m (Node (PrimState m) a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Node (PrimState m) a)
 -> Pipe i (a, a) u m (Node (PrimState m) a))
-> m (Node (PrimState m) a)
-> Pipe i (a, a) u m (Node (PrimState m) a)
forall a b. (a -> b) -> a -> b
$ MutVar (PrimState m) (Node (PrimState m) a)
-> m (Node (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar (PrimState m) (Node (PrimState m) a)
rl
              Node (PrimState m) a
nr <- m (Node (PrimState m) a)
-> Pipe i (a, a) u m (Node (PrimState m) a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Node (PrimState m) a)
 -> Pipe i (a, a) u m (Node (PrimState m) a))
-> m (Node (PrimState m) a)
-> Pipe i (a, a) u m (Node (PrimState m) a)
forall a b. (a -> b) -> a -> b
$ MutVar (PrimState m) (Node (PrimState m) a)
-> m (Node (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar (PrimState m) (Node (PrimState m) a)
rr
              (a, a) -> Pipe i (a, a) u m ()
forall o i u (m :: * -> *). o -> Pipe i o u m ()
C.yield (Node (PrimState m) a -> a
forall s a. Node s a -> a
nItem Node (PrimState m) a
nl, Node (PrimState m) a -> a
forall s a. Node s a -> a
nItem Node (PrimState m) a
nr)
              MutVar (PrimState m) (Node (PrimState m) a)
-> MutVar (PrimState m) (Node (PrimState m) a)
-> Pipe i (a, a) u m ()
go (Node (PrimState m) a -> MutVar (PrimState m) (Node (PrimState m) a)
forall s a. Node s a -> MutVar s (Node s a)
nLeft Node (PrimState m) a
nl) (Node (PrimState m) a -> MutVar (PrimState m) (Node (PrimState m) a)
forall s a. Node s a -> MutVar s (Node s a)
nRight Node (PrimState m) a
nr)


readOut
    :: (PrimMonad m, PrimState m ~ s)
    => List s a
    -> m [a]
readOut :: forall (m :: * -> *) s a.
(PrimMonad m, PrimState m ~ s) =>
List s a -> m [a]
readOut List s a
lst = Pipe () Void Any m [a] -> m [a]
forall (m :: * -> *) u a. Monad m => Pipe () Void u m a -> m a
C.runPipe (Pipe () Void Any m [a] -> m [a])
-> Pipe () Void Any m [a] -> m [a]
forall a b. (a -> b) -> a -> b
$ List s a -> Pipe () a Any m ()
forall (m :: * -> *) s a i u.
(PrimMonad m, PrimState m ~ s) =>
List s a -> Pipe i a u m ()
sourceRight List s a
lst
                     Pipe () a Any m ()
-> Pipe a Void () m [a] -> Pipe () Void Any m [a]
forall (m :: * -> *) a b u v c r.
Monad m =>
Pipe a b u m v -> Pipe b c v m r -> Pipe a c u m r
C..| Pipe a Void () m [a]
forall i o u (m :: * -> *). Pipe i o u m [i]
C.sinkList

readFocus :: (PrimMonad m, PrimState m ~ s) => List s a -> m a
readFocus :: forall (m :: * -> *) s a.
(PrimMonad m, PrimState m ~ s) =>
List s a -> m a
readFocus = (Node s a -> a) -> m (Node s a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Node s a -> a
forall s a. Node s a -> a
nItem (m (Node s a) -> m a)
-> (MutVar s (Node s a) -> m (Node s a))
-> MutVar s (Node s a)
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MutVar s (Node s a) -> m (Node s a)
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar (MutVar s (Node s a) -> m a)
-> (List s a -> m (MutVar s (Node s a))) -> List s a -> m a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< MutVar s (MutVar s (Node s a)) -> m (MutVar s (Node s a))
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar (MutVar s (MutVar s (Node s a)) -> m (MutVar s (Node s a)))
-> (List s a -> MutVar s (MutVar s (Node s a)))
-> List s a
-> m (MutVar s (Node s a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List s a -> MutVar s (MutVar s (Node s a))
forall s a. List s a -> MutVar s (MutVar s (Node s a))
getList

modifyFocus :: (PrimMonad m, PrimState m ~ s) => (a -> a) -> List s a -> m ()
modifyFocus :: forall (m :: * -> *) s a.
(PrimMonad m, PrimState m ~ s) =>
(a -> a) -> List s a -> m ()
modifyFocus a -> a
f List s a
lst = do
    MutVar s (Node s a)
r <- MutVar (PrimState m) (MutVar s (Node s a))
-> m (MutVar s (Node s a))
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar (List s a -> MutVar s (MutVar s (Node s a))
forall s a. List s a -> MutVar s (MutVar s (Node s a))
getList List s a
lst)
    MutVar (PrimState m) (Node s a) -> (Node s a -> Node s a) -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> (a -> a) -> m ()
modifyMutVar' MutVar s (Node s a)
MutVar (PrimState m) (Node s a)
r ((Node s a -> Node s a) -> m ()) -> (Node s a -> Node s a) -> m ()
forall a b. (a -> b) -> a -> b
$ \Node s a
n -> let !x :: a
x = a -> a
f (Node s a -> a
forall s a. Node s a -> a
nItem Node s a
n) in Node s a
n { nItem :: a
nItem = a
x }

readAt :: (PrimMonad m, PrimState m ~ s) => Int -> List s a -> m a
readAt :: forall (m :: * -> *) s a.
(PrimMonad m, PrimState m ~ s) =>
Int -> List s a -> m a
readAt Int
n List s a
lst = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
n Int
0 of
    Ordering
LT -> Pipe () Void Any m a -> m a
forall (m :: * -> *) u a. Monad m => Pipe () Void u m a -> m a
C.runPipe (Pipe () Void Any m a -> m a) -> Pipe () Void Any m a -> m a
forall a b. (a -> b) -> a -> b
$ List s a -> Pipe () a Any m Void
forall (m :: * -> *) s a i u r.
(PrimMonad m, PrimState m ~ s) =>
List s a -> Pipe i a u m r
sourceLeftForever List s a
lst
                 Pipe () a Any m Void
-> Pipe a Void Void m a -> Pipe () Void Any m a
forall (m :: * -> *) a b u v c r.
Monad m =>
Pipe a b u m v -> Pipe b c v m r -> Pipe a c u m r
C..| (Int -> Pipe a a Void m a -> Pipe a a Void m ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (Int -> Int
forall a. Num a => a -> a
abs Int
n) Pipe a a Void m a
forall i o (m :: * -> *). Pipe i o Void m i
C.awaitSurely Pipe a a Void m () -> Pipe a a Void m Void -> Pipe a a Void m Void
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (a -> a) -> Pipe a a Void m Void
forall i o u (m :: * -> *). (i -> o) -> Pipe i o u m u
C.map a -> a
forall a. a -> a
id)
                 Pipe a a Void m Void
-> Pipe a Void Void m a -> Pipe a Void Void m a
forall (m :: * -> *) a b u v c r.
Monad m =>
Pipe a b u m v -> Pipe b c v m r -> Pipe a c u m r
C..| Pipe a Void Void m a
forall i o (m :: * -> *). Pipe i o Void m i
C.awaitSurely
    Ordering
EQ -> List s a -> m a
forall (m :: * -> *) s a.
(PrimMonad m, PrimState m ~ s) =>
List s a -> m a
readFocus List s a
lst
    Ordering
GT -> Pipe () Void Any m a -> m a
forall (m :: * -> *) u a. Monad m => Pipe () Void u m a -> m a
C.runPipe (Pipe () Void Any m a -> m a) -> Pipe () Void Any m a -> m a
forall a b. (a -> b) -> a -> b
$ List s a -> Pipe () a Any m Void
forall (m :: * -> *) s a i u r.
(PrimMonad m, PrimState m ~ s) =>
List s a -> Pipe i a u m r
sourceRightForever List s a
lst
                 Pipe () a Any m Void
-> Pipe a Void Void m a -> Pipe () Void Any m a
forall (m :: * -> *) a b u v c r.
Monad m =>
Pipe a b u m v -> Pipe b c v m r -> Pipe a c u m r
C..| (Int -> Pipe a a Void m a -> Pipe a a Void m ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
n Pipe a a Void m a
forall i o (m :: * -> *). Pipe i o Void m i
C.awaitSurely Pipe a a Void m () -> Pipe a a Void m Void -> Pipe a a Void m Void
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (a -> a) -> Pipe a a Void m Void
forall i o u (m :: * -> *). (i -> o) -> Pipe i o u m u
C.map a -> a
forall a. a -> a
id)
                 Pipe a a Void m Void
-> Pipe a Void Void m a -> Pipe a Void Void m a
forall (m :: * -> *) a b u v c r.
Monad m =>
Pipe a b u m v -> Pipe b c v m r -> Pipe a c u m r
C..| Pipe a Void Void m a
forall i o (m :: * -> *). Pipe i o Void m i
C.awaitSurely

seek
    :: (PrimMonad m, PrimState m ~ s)
    => (a -> Bool)
    -> List s a
    -> m (Maybe Int)
seek :: forall (m :: * -> *) s a.
(PrimMonad m, PrimState m ~ s) =>
(a -> Bool) -> List s a -> m (Maybe Int)
seek a -> Bool
p List s a
lst = do
    MutVar s (Node s a)
r0 <- MutVar (PrimState m) (MutVar s (Node s a))
-> m (MutVar s (Node s a))
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar (List s a -> MutVar s (MutVar s (Node s a))
forall s a. List s a -> MutVar s (MutVar s (Node s a))
getList List s a
lst)
    Node s a
n0 <- MutVar (PrimState m) (Node s a) -> m (Node s a)
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar s (Node s a)
MutVar (PrimState m) (Node s a)
r0
    if a -> Bool
p (Node s a -> a
forall s a. Node s a -> a
nItem Node s a
n0)
      then Maybe Int -> m (Maybe Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0)
      else MutVar s (Node s a)
-> MutVar s (Node s a) -> MutVar s (Node s a) -> m (Maybe Int)
go1 MutVar s (Node s a)
r0 (Node s a -> MutVar s (Node s a)
forall s a. Node s a -> MutVar s (Node s a)
nLeft Node s a
n0) (Node s a -> MutVar s (Node s a)
forall s a. Node s a -> MutVar s (Node s a)
nRight Node s a
n0)
  where
    go1 :: MutVar s (Node s a)
-> MutVar s (Node s a) -> MutVar s (Node s a) -> m (Maybe Int)
go1 MutVar s (Node s a)
r0 = Int -> MutVar s (Node s a) -> MutVar s (Node s a) -> m (Maybe Int)
go Int
1
      where
        go :: Int -> MutVar s (Node s a) -> MutVar s (Node s a) -> m (Maybe Int)
go !Int
i MutVar s (Node s a)
rl MutVar s (Node s a)
rr
          | MutVar s (Node s a)
rl MutVar s (Node s a) -> MutVar s (Node s a) -> Bool
forall a. Eq a => a -> a -> Bool
== MutVar s (Node s a)
r0  = Maybe Int -> m (Maybe Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Int
forall a. Maybe a
Nothing
          | Bool
otherwise = do
              Node s a
nl <- MutVar (PrimState m) (Node s a) -> m (Node s a)
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar s (Node s a)
MutVar (PrimState m) (Node s a)
rl
              if a -> Bool
p (Node s a -> a
forall s a. Node s a -> a
nItem Node s a
nl)
                then Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Int
forall a. Num a => a -> a
negate Int
i) Maybe Int -> m () -> m (Maybe Int)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ MutVar (PrimState m) (MutVar s (Node s a))
-> MutVar s (Node s a) -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> a -> m ()
writeMutVar (List s a -> MutVar s (MutVar s (Node s a))
forall s a. List s a -> MutVar s (MutVar s (Node s a))
getList List s a
lst) MutVar s (Node s a)
rl
                else do
                  Node s a
nr <- MutVar (PrimState m) (Node s a) -> m (Node s a)
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar s (Node s a)
MutVar (PrimState m) (Node s a)
rr
                  if a -> Bool
p (Node s a -> a
forall s a. Node s a -> a
nItem Node s a
nr)
                    then Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i Maybe Int -> m () -> m (Maybe Int)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ MutVar (PrimState m) (MutVar s (Node s a))
-> MutVar s (Node s a) -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> a -> m ()
writeMutVar (List s a -> MutVar s (MutVar s (Node s a))
forall s a. List s a -> MutVar s (MutVar s (Node s a))
getList List s a
lst) MutVar s (Node s a)
rr
                    else Int -> MutVar s (Node s a) -> MutVar s (Node s a) -> m (Maybe Int)
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Node s a -> MutVar s (Node s a)
forall s a. Node s a -> MutVar s (Node s a)
nLeft Node s a
nl) (Node s a -> MutVar s (Node s a)
forall s a. Node s a -> MutVar s (Node s a)
nRight Node s a
nr)

    -- do
    -- r0 <- readMutVar (getList lst)
    -- n0 <- readMutVar r0
    -- (nItem n0:) <$> go1 r0 (nRight n0)
  -- where
    -- go1 r0 = go
    --   where
    --     go r
    --       | r == r0   = pure []
    --       | otherwise = do
    --           n <- readMutVar r
    --           (nItem n:) <$> go (nRight n)

-- insert to the right of focus
insertRight
    :: (PrimMonad m, PrimState m ~ s)
    => a
    -> List s a
    -> m ()
insertRight :: forall (m :: * -> *) s a.
(PrimMonad m, PrimState m ~ s) =>
a -> List s a -> m ()
insertRight a
x List s a
lst = do
    MutVar s (Node s a)
r0      <- MutVar (PrimState m) (MutVar s (Node s a))
-> m (MutVar s (Node s a))
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar (List s a -> MutVar s (MutVar s (Node s a))
forall s a. List s a -> MutVar s (MutVar s (Node s a))
getList List s a
lst)
    Node s a
n0      <- MutVar (PrimState m) (Node s a) -> m (Node s a)
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar s (Node s a)
MutVar (PrimState m) (Node s a)
r0
    MutVar s (Node s a)
newNode <- Node s a -> m (MutVar (PrimState m) (Node s a))
forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MutVar (PrimState m) a)
newMutVar (Node s a -> m (MutVar (PrimState m) (Node s a)))
-> Node s a -> m (MutVar (PrimState m) (Node s a))
forall a b. (a -> b) -> a -> b
$ MutVar s (Node s a) -> a -> MutVar s (Node s a) -> Node s a
forall s a.
MutVar s (Node s a) -> a -> MutVar s (Node s a) -> Node s a
Node MutVar s (Node s a)
r0 a
x (Node s a -> MutVar s (Node s a)
forall s a. Node s a -> MutVar s (Node s a)
nRight Node s a
n0)
    MutVar (PrimState m) (Node s a) -> Node s a -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> a -> m ()
writeMutVar MutVar s (Node s a)
MutVar (PrimState m) (Node s a)
r0 (Node s a -> m ()) -> Node s a -> m ()
forall a b. (a -> b) -> a -> b
$ Node s a
n0 { nRight :: MutVar s (Node s a)
nRight = MutVar s (Node s a)
newNode }
    MutVar (PrimState m) (Node s a) -> (Node s a -> Node s a) -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> (a -> a) -> m ()
modifyMutVar (Node s a -> MutVar s (Node s a)
forall s a. Node s a -> MutVar s (Node s a)
nRight Node s a
n0) ((Node s a -> Node s a) -> m ()) -> (Node s a -> Node s a) -> m ()
forall a b. (a -> b) -> a -> b
$ \Node s a
nr -> Node s a
nr { nLeft :: MutVar s (Node s a)
nLeft = MutVar s (Node s a)
newNode }

insertLeft
    :: (PrimMonad m, PrimState m ~ s)
    => a
    -> List s a
    -> m ()
insertLeft :: forall (m :: * -> *) s a.
(PrimMonad m, PrimState m ~ s) =>
a -> List s a -> m ()
insertLeft a
x List s a
lst = do
    MutVar s (Node s a)
r0      <- MutVar (PrimState m) (MutVar s (Node s a))
-> m (MutVar s (Node s a))
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar (List s a -> MutVar s (MutVar s (Node s a))
forall s a. List s a -> MutVar s (MutVar s (Node s a))
getList List s a
lst)
    Node s a
n0      <- MutVar (PrimState m) (Node s a) -> m (Node s a)
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar s (Node s a)
MutVar (PrimState m) (Node s a)
r0
    MutVar s (Node s a)
newNode <- Node s a -> m (MutVar (PrimState m) (Node s a))
forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MutVar (PrimState m) a)
newMutVar (Node s a -> m (MutVar (PrimState m) (Node s a)))
-> Node s a -> m (MutVar (PrimState m) (Node s a))
forall a b. (a -> b) -> a -> b
$ MutVar s (Node s a) -> a -> MutVar s (Node s a) -> Node s a
forall s a.
MutVar s (Node s a) -> a -> MutVar s (Node s a) -> Node s a
Node (Node s a -> MutVar s (Node s a)
forall s a. Node s a -> MutVar s (Node s a)
nLeft Node s a
n0) a
x MutVar s (Node s a)
r0
    MutVar (PrimState m) (Node s a) -> Node s a -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> a -> m ()
writeMutVar MutVar s (Node s a)
MutVar (PrimState m) (Node s a)
r0 (Node s a -> m ()) -> Node s a -> m ()
forall a b. (a -> b) -> a -> b
$ Node s a
n0 { nLeft :: MutVar s (Node s a)
nLeft = MutVar s (Node s a)
newNode }
    MutVar (PrimState m) (Node s a) -> (Node s a -> Node s a) -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> (a -> a) -> m ()
modifyMutVar (Node s a -> MutVar s (Node s a)
forall s a. Node s a -> MutVar s (Node s a)
nLeft Node s a
n0) ((Node s a -> Node s a) -> m ()) -> (Node s a -> Node s a) -> m ()
forall a b. (a -> b) -> a -> b
$ \Node s a
nl -> Node s a
nl { nRight :: MutVar s (Node s a)
nRight = MutVar s (Node s a)
newNode }

rotateRight
    :: (PrimMonad m, PrimState m ~ s)
    => List s a
    -> m ()
rotateRight :: forall (m :: * -> *) s a.
(PrimMonad m, PrimState m ~ s) =>
List s a -> m ()
rotateRight List s a
lst = do
    MutVar s (Node s a)
r0 <- MutVar (PrimState m) (MutVar s (Node s a))
-> m (MutVar s (Node s a))
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar (List s a -> MutVar s (MutVar s (Node s a))
forall s a. List s a -> MutVar s (MutVar s (Node s a))
getList List s a
lst)
    MutVar (PrimState m) (MutVar s (Node s a))
-> MutVar s (Node s a) -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> a -> m ()
writeMutVar (List s a -> MutVar s (MutVar s (Node s a))
forall s a. List s a -> MutVar s (MutVar s (Node s a))
getList List s a
lst) (MutVar s (Node s a) -> m ())
-> (Node s a -> MutVar s (Node s a)) -> Node s a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node s a -> MutVar s (Node s a)
forall s a. Node s a -> MutVar s (Node s a)
nRight (Node s a -> m ()) -> m (Node s a) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MutVar (PrimState m) (Node s a) -> m (Node s a)
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar s (Node s a)
MutVar (PrimState m) (Node s a)
r0

rotateLeft
    :: (PrimMonad m, PrimState m ~ s)
    => List s a
    -> m ()
rotateLeft :: forall (m :: * -> *) s a.
(PrimMonad m, PrimState m ~ s) =>
List s a -> m ()
rotateLeft List s a
lst = do
    MutVar s (Node s a)
r0 <- MutVar (PrimState m) (MutVar s (Node s a))
-> m (MutVar s (Node s a))
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar (List s a -> MutVar s (MutVar s (Node s a))
forall s a. List s a -> MutVar s (MutVar s (Node s a))
getList List s a
lst)
    MutVar (PrimState m) (MutVar s (Node s a))
-> MutVar s (Node s a) -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> a -> m ()
writeMutVar (List s a -> MutVar s (MutVar s (Node s a))
forall s a. List s a -> MutVar s (MutVar s (Node s a))
getList List s a
lst) (MutVar s (Node s a) -> m ())
-> (Node s a -> MutVar s (Node s a)) -> Node s a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node s a -> MutVar s (Node s a)
forall s a. Node s a -> MutVar s (Node s a)
nLeft (Node s a -> m ()) -> m (Node s a) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MutVar (PrimState m) (Node s a) -> m (Node s a)
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar s (Node s a)
MutVar (PrimState m) (Node s a)
r0

rotateN
    :: (PrimMonad m, PrimState m ~ s)
    => Int
    -> List s a
    -> m ()
rotateN :: forall (m :: * -> *) s a.
(PrimMonad m, PrimState m ~ s) =>
Int -> List s a -> m ()
rotateN Int
n List s a
lst = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
n Int
0 of
    Ordering
LT -> Int -> m () -> m ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (Int -> Int
forall a. Num a => a -> a
abs Int
n) (List s a -> m ()
forall (m :: * -> *) s a.
(PrimMonad m, PrimState m ~ s) =>
List s a -> m ()
rotateLeft List s a
lst)
    Ordering
EQ -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Ordering
GT -> Int -> m () -> m ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
n (List s a -> m ()
forall (m :: * -> *) s a.
(PrimMonad m, PrimState m ~ s) =>
List s a -> m ()
rotateRight List s a
lst)

popRight
    :: (PrimMonad m, PrimState m ~ s)
    => List s a
    -> m a
popRight :: forall (m :: * -> *) s a.
(PrimMonad m, PrimState m ~ s) =>
List s a -> m a
popRight List s a
lst = do
    MutVar s (Node s a)
r0 <- MutVar (PrimState m) (MutVar s (Node s a))
-> m (MutVar s (Node s a))
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar (List s a -> MutVar s (MutVar s (Node s a))
forall s a. List s a -> MutVar s (MutVar s (Node s a))
getList List s a
lst)
    Node s a
n0 <- MutVar (PrimState m) (Node s a) -> m (Node s a)
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar s (Node s a)
MutVar (PrimState m) (Node s a)
r0
    MutVar (PrimState m) (MutVar s (Node s a))
-> MutVar s (Node s a) -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> a -> m ()
writeMutVar (List s a -> MutVar s (MutVar s (Node s a))
forall s a. List s a -> MutVar s (MutVar s (Node s a))
getList List s a
lst) (Node s a -> MutVar s (Node s a)
forall s a. Node s a -> MutVar s (Node s a)
nRight Node s a
n0)
    MutVar (PrimState m) (Node s a) -> (Node s a -> Node s a) -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> (a -> a) -> m ()
modifyMutVar (Node s a -> MutVar s (Node s a)
forall s a. Node s a -> MutVar s (Node s a)
nRight Node s a
n0) ((Node s a -> Node s a) -> m ()) -> (Node s a -> Node s a) -> m ()
forall a b. (a -> b) -> a -> b
$ \Node s a
nr -> Node s a
nr { nLeft :: MutVar s (Node s a)
nLeft  = Node s a -> MutVar s (Node s a)
forall s a. Node s a -> MutVar s (Node s a)
nLeft Node s a
n0 }
    MutVar (PrimState m) (Node s a) -> (Node s a -> Node s a) -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> (a -> a) -> m ()
modifyMutVar (Node s a -> MutVar s (Node s a)
forall s a. Node s a -> MutVar s (Node s a)
nLeft  Node s a
n0) ((Node s a -> Node s a) -> m ()) -> (Node s a -> Node s a) -> m ()
forall a b. (a -> b) -> a -> b
$ \Node s a
nl -> Node s a
nl { nRight :: MutVar s (Node s a)
nRight = Node s a -> MutVar s (Node s a)
forall s a. Node s a -> MutVar s (Node s a)
nRight Node s a
n0 }
    pure $ Node s a -> a
forall s a. Node s a -> a
nItem Node s a
n0

popLeft
    :: (PrimMonad m, PrimState m ~ s)
    => List s a
    -> m a
popLeft :: forall (m :: * -> *) s a.
(PrimMonad m, PrimState m ~ s) =>
List s a -> m a
popLeft List s a
lst = do
    MutVar s (Node s a)
r0 <- MutVar (PrimState m) (MutVar s (Node s a))
-> m (MutVar s (Node s a))
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar (List s a -> MutVar s (MutVar s (Node s a))
forall s a. List s a -> MutVar s (MutVar s (Node s a))
getList List s a
lst)
    Node s a
n0 <- MutVar (PrimState m) (Node s a) -> m (Node s a)
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar s (Node s a)
MutVar (PrimState m) (Node s a)
r0
    MutVar (PrimState m) (MutVar s (Node s a))
-> MutVar s (Node s a) -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> a -> m ()
writeMutVar (List s a -> MutVar s (MutVar s (Node s a))
forall s a. List s a -> MutVar s (MutVar s (Node s a))
getList List s a
lst) (Node s a -> MutVar s (Node s a)
forall s a. Node s a -> MutVar s (Node s a)
nLeft Node s a
n0)
    MutVar (PrimState m) (Node s a) -> (Node s a -> Node s a) -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> (a -> a) -> m ()
modifyMutVar (Node s a -> MutVar s (Node s a)
forall s a. Node s a -> MutVar s (Node s a)
nLeft Node s a
n0) ((Node s a -> Node s a) -> m ()) -> (Node s a -> Node s a) -> m ()
forall a b. (a -> b) -> a -> b
$ \Node s a
nl -> Node s a
nl { nRight :: MutVar s (Node s a)
nRight  = Node s a -> MutVar s (Node s a)
forall s a. Node s a -> MutVar s (Node s a)
nRight Node s a
n0 }
    MutVar (PrimState m) (Node s a) -> (Node s a -> Node s a) -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> (a -> a) -> m ()
modifyMutVar (Node s a -> MutVar s (Node s a)
forall s a. Node s a -> MutVar s (Node s a)
nRight Node s a
n0) ((Node s a -> Node s a) -> m ()) -> (Node s a -> Node s a) -> m ()
forall a b. (a -> b) -> a -> b
$ \Node s a
nr -> Node s a
nr { nLeft :: MutVar s (Node s a)
nLeft = Node s a -> MutVar s (Node s a)
forall s a. Node s a -> MutVar s (Node s a)
nLeft Node s a
n0 }
    pure $ Node s a -> a
forall s a. Node s a -> a
nItem Node s a
n0




-- data Node s a = Node { nLeft :: MutVar s (Node s a), nItem :: a, nRight :: MutVar s (Node s a) }
--   deriving Eq

-- newtype List s a = List { getList :: MutVar s (MutVar s (Node s a)) }