module Test.Credit.Deque.SimpleCat where

import Prelude hiding (head, tail, concat)
import Prettyprinter (Pretty)
import Control.Monad
import Control.Monad.Credit
import Test.Credit
import Test.Credit.Deque.Base
import qualified Test.Credit.Deque.Base as D
import qualified Test.Credit.Deque.Bankers as D

-- | "simple"
data SimpleCat a m
  = Shallow (D.BDeque a m)
  | Deep (D.BDeque a m) -- ^ (>= 2 elements)
         (Thunk m (Lazy m) (SimpleCat (D.BDeque a m) m))
         (D.BDeque a m) -- ^ (>= 2 elements)

dangerous :: D.BDeque a m -> Bool
dangerous :: forall a (m :: * -> *). BDeque a m -> Bool
dangerous BDeque a m
d = BDeque a m -> Int
forall a (m :: * -> *). BDeque a m -> Int
D.size BDeque a m
d Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2

cost :: Credit
cost :: Credit
cost = forall (q :: * -> (* -> *) -> *) a.
BoundedDeque q =>
Size -> DequeOp a -> Credit
qcost @(D.BDeque) Size
forall a. HasCallStack => a
undefined (Any -> DequeOp Any
forall a. a -> DequeOp a
Cons Any
forall a. HasCallStack => a
undefined) Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
+ Credit
3 Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
* forall (q :: * -> (* -> *) -> *) a.
BoundedDeque q =>
Size -> DequeOp a -> Credit
qcost @(D.BDeque) Size
forall a. HasCallStack => a
undefined DequeOp Any
forall a. DequeOp a
Uncons

danger :: D.BDeque a m -> Credit
danger :: forall a (m :: * -> *). BDeque a m -> Credit
danger BDeque a m
d = if BDeque a m -> Int
forall a (m :: * -> *). BDeque a m -> Int
D.size BDeque a m
d Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 then Credit
cost else Credit
0

deep :: MonadInherit m => D.BDeque a m -> Thunk m (Lazy m) (SimpleCat (D.BDeque a m) m) -> D.BDeque a m -> m (SimpleCat a m)
deep :: forall (m :: * -> *) a.
MonadInherit m =>
BDeque a m
-> Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
-> BDeque a m
-> m (SimpleCat a m)
deep BDeque a m
f Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m BDeque a m
r = do
  Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m Thunk m (Lazy m) (SimpleCat (BDeque a m) m) -> Credit -> m ()
forall (m :: * -> *) (t :: * -> *) a.
MonadCredit m =>
Thunk m t a -> Credit -> m ()
forall (t :: * -> *) a. Thunk m t a -> Credit -> m ()
`hasAtLeast` (BDeque a m -> Credit
forall a (m :: * -> *). BDeque a m -> Credit
danger BDeque a m
f Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
+ BDeque a m -> Credit
forall a (m :: * -> *). BDeque a m -> Credit
danger BDeque a m
r)
  SimpleCat a m -> m (SimpleCat a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SimpleCat a m -> m (SimpleCat a m))
-> SimpleCat a m -> m (SimpleCat a m)
forall a b. (a -> b) -> a -> b
$ BDeque a m
-> Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
-> BDeque a m
-> SimpleCat a m
forall a (m :: * -> *).
BDeque a m
-> Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
-> BDeque a m
-> SimpleCat a m
Deep BDeque a m
f Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m BDeque a m
r

isEmpty :: SimpleCat a m -> Bool
isEmpty :: forall a (m :: * -> *). SimpleCat a m -> Bool
isEmpty (Shallow BDeque a m
d) = BDeque a m -> Bool
forall a (m :: * -> *). BDeque a m -> Bool
D.isEmpty BDeque a m
d
isEmpty (Deep BDeque a m
_ Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
_ BDeque a m
_) = Bool
False

data DequeIs a m
  = Small (Maybe a)
  | Big (D.BDeque a m)

tooSmall :: MonadInherit m => D.BDeque a m -> m (DequeIs a m)
tooSmall :: forall (m :: * -> *) a.
MonadInherit m =>
BDeque a m -> m (DequeIs a m)
tooSmall BDeque a m
d = do
  Maybe (a, BDeque a m)
m1 <- BDeque a m -> m (Maybe (a, BDeque a m))
forall (m :: * -> *) a.
MonadInherit m =>
BDeque a m -> m (Maybe (a, BDeque a m))
forall (q :: * -> (* -> *) -> *) (m :: * -> *) a.
(Deque q, MonadInherit m) =>
q a m -> m (Maybe (a, q a m))
D.uncons BDeque a m
d
  case Maybe (a, BDeque a m)
m1 of
    Maybe (a, BDeque a m)
Nothing -> DequeIs a m -> m (DequeIs a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DequeIs a m -> m (DequeIs a m)) -> DequeIs a m -> m (DequeIs a m)
forall a b. (a -> b) -> a -> b
$ Maybe a -> DequeIs a m
forall a (m :: * -> *). Maybe a -> DequeIs a m
Small Maybe a
forall a. Maybe a
Nothing
    Just (a
x, BDeque a m
d') -> do
      Maybe (a, BDeque a m)
m2 <- BDeque a m -> m (Maybe (a, BDeque a m))
forall (m :: * -> *) a.
MonadInherit m =>
BDeque a m -> m (Maybe (a, BDeque a m))
forall (q :: * -> (* -> *) -> *) (m :: * -> *) a.
(Deque q, MonadInherit m) =>
q a m -> m (Maybe (a, q a m))
D.uncons BDeque a m
d'
      case Maybe (a, BDeque a m)
m2 of
        Maybe (a, BDeque a m)
Nothing -> DequeIs a m -> m (DequeIs a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DequeIs a m -> m (DequeIs a m)) -> DequeIs a m -> m (DequeIs a m)
forall a b. (a -> b) -> a -> b
$ Maybe a -> DequeIs a m
forall a (m :: * -> *). Maybe a -> DequeIs a m
Small (a -> Maybe a
forall a. a -> Maybe a
Just a
x)
        Just (a, BDeque a m)
_ -> DequeIs a m -> m (DequeIs a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DequeIs a m -> m (DequeIs a m)) -> DequeIs a m -> m (DequeIs a m)
forall a b. (a -> b) -> a -> b
$ BDeque a m -> DequeIs a m
forall a (m :: * -> *). BDeque a m -> DequeIs a m
Big BDeque a m
d

dappendL :: MonadInherit m => Maybe a -> D.BDeque a m -> m (D.BDeque a m)
dappendL :: forall (m :: * -> *) a.
MonadInherit m =>
Maybe a -> BDeque a m -> m (BDeque a m)
dappendL Maybe a
Nothing BDeque a m
d2 = BDeque a m -> m (BDeque a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BDeque a m
d2
dappendL (Just a
x) BDeque a m
d2 = a -> BDeque a m -> m (BDeque a m)
forall (m :: * -> *) a.
MonadInherit m =>
a -> BDeque a m -> m (BDeque a m)
forall (q :: * -> (* -> *) -> *) (m :: * -> *) a.
(Deque q, MonadInherit m) =>
a -> q a m -> m (q a m)
D.cons a
x BDeque a m
d2

dappendR :: MonadInherit m => D.BDeque a m -> Maybe a -> m (D.BDeque a m)
dappendR :: forall (m :: * -> *) a.
MonadInherit m =>
BDeque a m -> Maybe a -> m (BDeque a m)
dappendR BDeque a m
d1 Maybe a
Nothing = BDeque a m -> m (BDeque a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BDeque a m
d1
dappendR BDeque a m
d1 (Just a
x) = BDeque a m -> a -> m (BDeque a m)
forall (m :: * -> *) a.
MonadInherit m =>
BDeque a m -> a -> m (BDeque a m)
forall (q :: * -> (* -> *) -> *) (m :: * -> *) a.
(Deque q, MonadInherit m) =>
q a m -> a -> m (q a m)
D.snoc BDeque a m
d1 a
x

uncons' :: MonadInherit m => SimpleCat a m -> m (Maybe (a, Thunk m (Lazy m) (SimpleCat a m)))
uncons' :: forall (m :: * -> *) a.
MonadInherit m =>
SimpleCat a m -> m (Maybe (a, Thunk m (Lazy m) (SimpleCat a m)))
uncons' (Shallow BDeque a m
d) = m ()
forall (m :: * -> *). MonadCount m => m ()
tick m ()
-> m (Maybe (a, Thunk m (Lazy m) (SimpleCat a m)))
-> m (Maybe (a, Thunk m (Lazy m) (SimpleCat a m)))
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> do
  Maybe (a, BDeque a m)
m <- BDeque a m -> m (Maybe (a, BDeque a m))
forall (m :: * -> *) a.
MonadInherit m =>
BDeque a m -> m (Maybe (a, BDeque a m))
forall (q :: * -> (* -> *) -> *) (m :: * -> *) a.
(Deque q, MonadInherit m) =>
q a m -> m (Maybe (a, q a m))
D.uncons BDeque a m
d
  case Maybe (a, BDeque a m)
m of
    Maybe (a, BDeque a m)
Nothing -> Maybe (a, Thunk m (Lazy m) (SimpleCat a m))
-> m (Maybe (a, Thunk m (Lazy m) (SimpleCat a m)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (a, Thunk m (Lazy m) (SimpleCat a m))
forall a. Maybe a
Nothing
    Just (a
x, BDeque a m
d') -> (Thunk m (Lazy m) (SimpleCat a m)
 -> Maybe (a, Thunk m (Lazy m) (SimpleCat a m)))
-> m (Thunk m (Lazy m) (SimpleCat a m))
-> m (Maybe (a, Thunk m (Lazy m) (SimpleCat a m)))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a, Thunk m (Lazy m) (SimpleCat a m))
-> Maybe (a, Thunk m (Lazy m) (SimpleCat a m))
forall a. a -> Maybe a
Just ((a, Thunk m (Lazy m) (SimpleCat a m))
 -> Maybe (a, Thunk m (Lazy m) (SimpleCat a m)))
-> (Thunk m (Lazy m) (SimpleCat a m)
    -> (a, Thunk m (Lazy m) (SimpleCat a m)))
-> Thunk m (Lazy m) (SimpleCat a m)
-> Maybe (a, Thunk m (Lazy m) (SimpleCat a m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
x,)) (m (Thunk m (Lazy m) (SimpleCat a m))
 -> m (Maybe (a, Thunk m (Lazy m) (SimpleCat a m))))
-> m (Thunk m (Lazy m) (SimpleCat a m))
-> m (Maybe (a, Thunk m (Lazy m) (SimpleCat a m)))
forall a b. (a -> b) -> a -> b
$ Lazy m (SimpleCat a m) -> m (Thunk m (Lazy m) (SimpleCat a m))
forall (m :: * -> *) (t :: * -> *) a.
MonadLazy m =>
t a -> m (Thunk m t a)
forall (t :: * -> *) a. t a -> m (Thunk m t a)
delay (Lazy m (SimpleCat a m) -> m (Thunk m (Lazy m) (SimpleCat a m)))
-> Lazy m (SimpleCat a m) -> m (Thunk m (Lazy m) (SimpleCat a m))
forall a b. (a -> b) -> a -> b
$ m (SimpleCat a m) -> Lazy m (SimpleCat a m)
forall {k} (m :: k -> *) (a :: k). m a -> Lazy m a
Lazy (m (SimpleCat a m) -> Lazy m (SimpleCat a m))
-> m (SimpleCat a m) -> Lazy m (SimpleCat a m)
forall a b. (a -> b) -> a -> b
$ do
      SimpleCat a m -> m (SimpleCat a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SimpleCat a m -> m (SimpleCat a m))
-> SimpleCat a m -> m (SimpleCat a m)
forall a b. (a -> b) -> a -> b
$ BDeque a m -> SimpleCat a m
forall a (m :: * -> *). BDeque a m -> SimpleCat a m
Shallow BDeque a m
d'
uncons' (Deep BDeque a m
f Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m BDeque a m
r) = m ()
forall (m :: * -> *). MonadCount m => m ()
tick m ()
-> m (Maybe (a, Thunk m (Lazy m) (SimpleCat a m)))
-> m (Maybe (a, Thunk m (Lazy m) (SimpleCat a m)))
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> do
  Maybe (a, BDeque a m)
f' <- BDeque a m -> m (Maybe (a, BDeque a m))
forall (m :: * -> *) a.
MonadInherit m =>
BDeque a m -> m (Maybe (a, BDeque a m))
forall (q :: * -> (* -> *) -> *) (m :: * -> *) a.
(Deque q, MonadInherit m) =>
q a m -> m (Maybe (a, q a m))
D.uncons BDeque a m
f
  case Maybe (a, BDeque a m)
f' of
    Maybe (a, BDeque a m)
Nothing -> Maybe (a, Thunk m (Lazy m) (SimpleCat a m))
-> m (Maybe (a, Thunk m (Lazy m) (SimpleCat a m)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (a, Thunk m (Lazy m) (SimpleCat a m))
forall a. Maybe a
Nothing
    Just (a
x, BDeque a m
f') -> (Thunk m (Lazy m) (SimpleCat a m)
 -> Maybe (a, Thunk m (Lazy m) (SimpleCat a m)))
-> m (Thunk m (Lazy m) (SimpleCat a m))
-> m (Maybe (a, Thunk m (Lazy m) (SimpleCat a m)))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a, Thunk m (Lazy m) (SimpleCat a m))
-> Maybe (a, Thunk m (Lazy m) (SimpleCat a m))
forall a. a -> Maybe a
Just ((a, Thunk m (Lazy m) (SimpleCat a m))
 -> Maybe (a, Thunk m (Lazy m) (SimpleCat a m)))
-> (Thunk m (Lazy m) (SimpleCat a m)
    -> (a, Thunk m (Lazy m) (SimpleCat a m)))
-> Thunk m (Lazy m) (SimpleCat a m)
-> Maybe (a, Thunk m (Lazy m) (SimpleCat a m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
x,)) (m (Thunk m (Lazy m) (SimpleCat a m))
 -> m (Maybe (a, Thunk m (Lazy m) (SimpleCat a m))))
-> m (Thunk m (Lazy m) (SimpleCat a m))
-> m (Maybe (a, Thunk m (Lazy m) (SimpleCat a m)))
forall a b. (a -> b) -> a -> b
$ Lazy m (SimpleCat a m) -> m (Thunk m (Lazy m) (SimpleCat a m))
forall (m :: * -> *) (t :: * -> *) a.
MonadLazy m =>
t a -> m (Thunk m t a)
forall (t :: * -> *) a. t a -> m (Thunk m t a)
delay (Lazy m (SimpleCat a m) -> m (Thunk m (Lazy m) (SimpleCat a m)))
-> Lazy m (SimpleCat a m) -> m (Thunk m (Lazy m) (SimpleCat a m))
forall a b. (a -> b) -> a -> b
$ m (SimpleCat a m) -> Lazy m (SimpleCat a m)
forall {k} (m :: k -> *) (a :: k). m a -> Lazy m a
Lazy (m (SimpleCat a m) -> Lazy m (SimpleCat a m))
-> m (SimpleCat a m) -> Lazy m (SimpleCat a m)
forall a b. (a -> b) -> a -> b
$ do
      DequeIs a m
dis <- BDeque a m -> m (DequeIs a m)
forall (m :: * -> *) a.
MonadInherit m =>
BDeque a m -> m (DequeIs a m)
tooSmall BDeque a m
f'
      case DequeIs a m
dis of
        Big BDeque a m
f' -> do
          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (BDeque a m -> Bool
forall a (m :: * -> *). BDeque a m -> Bool
dangerous BDeque a m
f') (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m Thunk m (Lazy m) (SimpleCat (BDeque a m) m) -> Credit -> m ()
forall (m :: * -> *) (t :: * -> *) a.
MonadCredit m =>
Thunk m t a -> Credit -> m ()
forall (t :: * -> *) a. Thunk m t a -> Credit -> m ()
`creditWith` Credit
cost
          BDeque a m
-> Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
-> BDeque a m
-> m (SimpleCat a m)
forall (m :: * -> *) a.
MonadInherit m =>
BDeque a m
-> Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
-> BDeque a m
-> m (SimpleCat a m)
deep BDeque a m
f' Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m BDeque a m
r
        Small Maybe a
y -> do
          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (BDeque a m -> Bool
forall a (m :: * -> *). BDeque a m -> Bool
dangerous BDeque a m
r) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m Thunk m (Lazy m) (SimpleCat (BDeque a m) m) -> Credit -> m ()
forall (m :: * -> *) (t :: * -> *) a.
MonadCredit m =>
Thunk m t a -> Credit -> m ()
forall (t :: * -> *) a. Thunk m t a -> Credit -> m ()
`creditWith` Credit
cost
          Maybe (BDeque a m, Thunk m (Lazy m) (SimpleCat (BDeque a m) m))
m' <- SimpleCat (BDeque a m) m
-> m (Maybe
        (BDeque a m, Thunk m (Lazy m) (SimpleCat (BDeque a m) m)))
forall (m :: * -> *) a.
MonadInherit m =>
SimpleCat a m -> m (Maybe (a, Thunk m (Lazy m) (SimpleCat a m)))
uncons' (SimpleCat (BDeque a m) m
 -> m (Maybe
         (BDeque a m, Thunk m (Lazy m) (SimpleCat (BDeque a m) m))))
-> m (SimpleCat (BDeque a m) m)
-> m (Maybe
        (BDeque a m, Thunk m (Lazy m) (SimpleCat (BDeque a m) m)))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
-> m (SimpleCat (BDeque a m) m)
forall (m :: * -> *) (t :: * -> *) a.
(MonadLazy m, HasStep t m) =>
Thunk m t a -> m a
forall (t :: * -> *) a. HasStep t m => Thunk m t a -> m a
force Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m
          case Maybe (BDeque a m, Thunk m (Lazy m) (SimpleCat (BDeque a m) m))
m' of
            Maybe (BDeque a m, Thunk m (Lazy m) (SimpleCat (BDeque a m) m))
Nothing -> BDeque a m -> SimpleCat a m
forall a (m :: * -> *). BDeque a m -> SimpleCat a m
Shallow (BDeque a m -> SimpleCat a m)
-> m (BDeque a m) -> m (SimpleCat a m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a -> BDeque a m -> m (BDeque a m)
forall (m :: * -> *) a.
MonadInherit m =>
Maybe a -> BDeque a m -> m (BDeque a m)
dappendL Maybe a
y BDeque a m
r
            Just (BDeque a m
h, Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
t) -> do
              Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (BDeque a m -> Bool
forall a (m :: * -> *). BDeque a m -> Bool
dangerous BDeque a m
r) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
t Thunk m (Lazy m) (SimpleCat (BDeque a m) m) -> Credit -> m ()
forall (m :: * -> *) (t :: * -> *) a.
MonadCredit m =>
Thunk m t a -> Credit -> m ()
forall (t :: * -> *) a. Thunk m t a -> Credit -> m ()
`creditWith` Credit
cost
              Maybe a -> BDeque a m -> m (BDeque a m)
forall (m :: * -> *) a.
MonadInherit m =>
Maybe a -> BDeque a m -> m (BDeque a m)
dappendL Maybe a
y BDeque a m
h m (BDeque a m)
-> (BDeque a m -> m (SimpleCat a m)) -> m (SimpleCat a m)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \BDeque a m
h -> BDeque a m
-> Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
-> BDeque a m
-> m (SimpleCat a m)
forall (m :: * -> *) a.
MonadInherit m =>
BDeque a m
-> Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
-> BDeque a m
-> m (SimpleCat a m)
deep BDeque a m
h Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
t BDeque a m
r

unsnoc' :: MonadInherit m => SimpleCat a m -> m (Maybe (Thunk m (Lazy m) (SimpleCat a m), a))
unsnoc' :: forall (m :: * -> *) a.
MonadInherit m =>
SimpleCat a m -> m (Maybe (Thunk m (Lazy m) (SimpleCat a m), a))
unsnoc' (Shallow BDeque a m
d) = m ()
forall (m :: * -> *). MonadCount m => m ()
tick m ()
-> m (Maybe (Thunk m (Lazy m) (SimpleCat a m), a))
-> m (Maybe (Thunk m (Lazy m) (SimpleCat a m), a))
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> do
  Maybe (BDeque a m, a)
m <- BDeque a m -> m (Maybe (BDeque a m, a))
forall (m :: * -> *) a.
MonadInherit m =>
BDeque a m -> m (Maybe (BDeque a m, a))
forall (q :: * -> (* -> *) -> *) (m :: * -> *) a.
(Deque q, MonadInherit m) =>
q a m -> m (Maybe (q a m, a))
D.unsnoc BDeque a m
d
  case Maybe (BDeque a m, a)
m of
    Maybe (BDeque a m, a)
Nothing -> Maybe (Thunk m (Lazy m) (SimpleCat a m), a)
-> m (Maybe (Thunk m (Lazy m) (SimpleCat a m), a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Thunk m (Lazy m) (SimpleCat a m), a)
forall a. Maybe a
Nothing
    Just (BDeque a m
d', a
x) -> (Thunk m (Lazy m) (SimpleCat a m)
 -> Maybe (Thunk m (Lazy m) (SimpleCat a m), a))
-> m (Thunk m (Lazy m) (SimpleCat a m))
-> m (Maybe (Thunk m (Lazy m) (SimpleCat a m), a))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Thunk m (Lazy m) (SimpleCat a m), a)
-> Maybe (Thunk m (Lazy m) (SimpleCat a m), a)
forall a. a -> Maybe a
Just ((Thunk m (Lazy m) (SimpleCat a m), a)
 -> Maybe (Thunk m (Lazy m) (SimpleCat a m), a))
-> (Thunk m (Lazy m) (SimpleCat a m)
    -> (Thunk m (Lazy m) (SimpleCat a m), a))
-> Thunk m (Lazy m) (SimpleCat a m)
-> Maybe (Thunk m (Lazy m) (SimpleCat a m), a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,a
x)) (m (Thunk m (Lazy m) (SimpleCat a m))
 -> m (Maybe (Thunk m (Lazy m) (SimpleCat a m), a)))
-> m (Thunk m (Lazy m) (SimpleCat a m))
-> m (Maybe (Thunk m (Lazy m) (SimpleCat a m), a))
forall a b. (a -> b) -> a -> b
$ Lazy m (SimpleCat a m) -> m (Thunk m (Lazy m) (SimpleCat a m))
forall (m :: * -> *) (t :: * -> *) a.
MonadLazy m =>
t a -> m (Thunk m t a)
forall (t :: * -> *) a. t a -> m (Thunk m t a)
delay (Lazy m (SimpleCat a m) -> m (Thunk m (Lazy m) (SimpleCat a m)))
-> Lazy m (SimpleCat a m) -> m (Thunk m (Lazy m) (SimpleCat a m))
forall a b. (a -> b) -> a -> b
$ m (SimpleCat a m) -> Lazy m (SimpleCat a m)
forall {k} (m :: k -> *) (a :: k). m a -> Lazy m a
Lazy (m (SimpleCat a m) -> Lazy m (SimpleCat a m))
-> m (SimpleCat a m) -> Lazy m (SimpleCat a m)
forall a b. (a -> b) -> a -> b
$ do
      SimpleCat a m -> m (SimpleCat a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SimpleCat a m -> m (SimpleCat a m))
-> SimpleCat a m -> m (SimpleCat a m)
forall a b. (a -> b) -> a -> b
$ BDeque a m -> SimpleCat a m
forall a (m :: * -> *). BDeque a m -> SimpleCat a m
Shallow BDeque a m
d'
unsnoc' (Deep BDeque a m
f Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m BDeque a m
r) = m ()
forall (m :: * -> *). MonadCount m => m ()
tick m ()
-> m (Maybe (Thunk m (Lazy m) (SimpleCat a m), a))
-> m (Maybe (Thunk m (Lazy m) (SimpleCat a m), a))
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> do
  Maybe (BDeque a m, a)
r' <- BDeque a m -> m (Maybe (BDeque a m, a))
forall (m :: * -> *) a.
MonadInherit m =>
BDeque a m -> m (Maybe (BDeque a m, a))
forall (q :: * -> (* -> *) -> *) (m :: * -> *) a.
(Deque q, MonadInherit m) =>
q a m -> m (Maybe (q a m, a))
D.unsnoc BDeque a m
r
  case Maybe (BDeque a m, a)
r' of
    Maybe (BDeque a m, a)
Nothing -> Maybe (Thunk m (Lazy m) (SimpleCat a m), a)
-> m (Maybe (Thunk m (Lazy m) (SimpleCat a m), a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Thunk m (Lazy m) (SimpleCat a m), a)
forall a. Maybe a
Nothing
    Just (BDeque a m
r', a
x) -> (Thunk m (Lazy m) (SimpleCat a m)
 -> Maybe (Thunk m (Lazy m) (SimpleCat a m), a))
-> m (Thunk m (Lazy m) (SimpleCat a m))
-> m (Maybe (Thunk m (Lazy m) (SimpleCat a m), a))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Thunk m (Lazy m) (SimpleCat a m), a)
-> Maybe (Thunk m (Lazy m) (SimpleCat a m), a)
forall a. a -> Maybe a
Just ((Thunk m (Lazy m) (SimpleCat a m), a)
 -> Maybe (Thunk m (Lazy m) (SimpleCat a m), a))
-> (Thunk m (Lazy m) (SimpleCat a m)
    -> (Thunk m (Lazy m) (SimpleCat a m), a))
-> Thunk m (Lazy m) (SimpleCat a m)
-> Maybe (Thunk m (Lazy m) (SimpleCat a m), a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,a
x)) (m (Thunk m (Lazy m) (SimpleCat a m))
 -> m (Maybe (Thunk m (Lazy m) (SimpleCat a m), a)))
-> m (Thunk m (Lazy m) (SimpleCat a m))
-> m (Maybe (Thunk m (Lazy m) (SimpleCat a m), a))
forall a b. (a -> b) -> a -> b
$ Lazy m (SimpleCat a m) -> m (Thunk m (Lazy m) (SimpleCat a m))
forall (m :: * -> *) (t :: * -> *) a.
MonadLazy m =>
t a -> m (Thunk m t a)
forall (t :: * -> *) a. t a -> m (Thunk m t a)
delay (Lazy m (SimpleCat a m) -> m (Thunk m (Lazy m) (SimpleCat a m)))
-> Lazy m (SimpleCat a m) -> m (Thunk m (Lazy m) (SimpleCat a m))
forall a b. (a -> b) -> a -> b
$ m (SimpleCat a m) -> Lazy m (SimpleCat a m)
forall {k} (m :: k -> *) (a :: k). m a -> Lazy m a
Lazy (m (SimpleCat a m) -> Lazy m (SimpleCat a m))
-> m (SimpleCat a m) -> Lazy m (SimpleCat a m)
forall a b. (a -> b) -> a -> b
$ do
      DequeIs a m
dis <- BDeque a m -> m (DequeIs a m)
forall (m :: * -> *) a.
MonadInherit m =>
BDeque a m -> m (DequeIs a m)
tooSmall BDeque a m
r'
      case DequeIs a m
dis of
        Big BDeque a m
r' -> do
          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (BDeque a m -> Bool
forall a (m :: * -> *). BDeque a m -> Bool
dangerous BDeque a m
r') (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m Thunk m (Lazy m) (SimpleCat (BDeque a m) m) -> Credit -> m ()
forall (m :: * -> *) (t :: * -> *) a.
MonadCredit m =>
Thunk m t a -> Credit -> m ()
forall (t :: * -> *) a. Thunk m t a -> Credit -> m ()
`creditWith` Credit
cost
          BDeque a m
-> Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
-> BDeque a m
-> m (SimpleCat a m)
forall (m :: * -> *) a.
MonadInherit m =>
BDeque a m
-> Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
-> BDeque a m
-> m (SimpleCat a m)
deep BDeque a m
f Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m BDeque a m
r'
        Small Maybe a
y -> do
          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (BDeque a m -> Bool
forall a (m :: * -> *). BDeque a m -> Bool
dangerous BDeque a m
f) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m Thunk m (Lazy m) (SimpleCat (BDeque a m) m) -> Credit -> m ()
forall (m :: * -> *) (t :: * -> *) a.
MonadCredit m =>
Thunk m t a -> Credit -> m ()
forall (t :: * -> *) a. Thunk m t a -> Credit -> m ()
`creditWith` Credit
cost
          Maybe (Thunk m (Lazy m) (SimpleCat (BDeque a m) m), BDeque a m)
m' <- SimpleCat (BDeque a m) m
-> m (Maybe
        (Thunk m (Lazy m) (SimpleCat (BDeque a m) m), BDeque a m))
forall (m :: * -> *) a.
MonadInherit m =>
SimpleCat a m -> m (Maybe (Thunk m (Lazy m) (SimpleCat a m), a))
unsnoc' (SimpleCat (BDeque a m) m
 -> m (Maybe
         (Thunk m (Lazy m) (SimpleCat (BDeque a m) m), BDeque a m)))
-> m (SimpleCat (BDeque a m) m)
-> m (Maybe
        (Thunk m (Lazy m) (SimpleCat (BDeque a m) m), BDeque a m))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
-> m (SimpleCat (BDeque a m) m)
forall (m :: * -> *) (t :: * -> *) a.
(MonadLazy m, HasStep t m) =>
Thunk m t a -> m a
forall (t :: * -> *) a. HasStep t m => Thunk m t a -> m a
force Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m
          case Maybe (Thunk m (Lazy m) (SimpleCat (BDeque a m) m), BDeque a m)
m' of
            Maybe (Thunk m (Lazy m) (SimpleCat (BDeque a m) m), BDeque a m)
Nothing -> BDeque a m -> SimpleCat a m
forall a (m :: * -> *). BDeque a m -> SimpleCat a m
Shallow (BDeque a m -> SimpleCat a m)
-> m (BDeque a m) -> m (SimpleCat a m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BDeque a m -> Maybe a -> m (BDeque a m)
forall (m :: * -> *) a.
MonadInherit m =>
BDeque a m -> Maybe a -> m (BDeque a m)
dappendR BDeque a m
f Maybe a
y
            Just (Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
t, BDeque a m
h) -> do
              Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (BDeque a m -> Bool
forall a (m :: * -> *). BDeque a m -> Bool
dangerous BDeque a m
f) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
t Thunk m (Lazy m) (SimpleCat (BDeque a m) m) -> Credit -> m ()
forall (m :: * -> *) (t :: * -> *) a.
MonadCredit m =>
Thunk m t a -> Credit -> m ()
forall (t :: * -> *) a. Thunk m t a -> Credit -> m ()
`creditWith` Credit
cost
              BDeque a m
-> Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
-> BDeque a m
-> m (SimpleCat a m)
forall (m :: * -> *) a.
MonadInherit m =>
BDeque a m
-> Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
-> BDeque a m
-> m (SimpleCat a m)
deep BDeque a m
f Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
t (BDeque a m -> m (SimpleCat a m))
-> m (BDeque a m) -> m (SimpleCat a m)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BDeque a m -> Maybe a -> m (BDeque a m)
forall (m :: * -> *) a.
MonadInherit m =>
BDeque a m -> Maybe a -> m (BDeque a m)
dappendR BDeque a m
h Maybe a
y

concat' :: MonadInherit m => SimpleCat a m -> SimpleCat a m -> m (SimpleCat a m)
concat' :: forall (m :: * -> *) a.
MonadInherit m =>
SimpleCat a m -> SimpleCat a m -> m (SimpleCat a m)
concat' (Shallow BDeque a m
d1) (Shallow BDeque a m
d2) = m ()
forall (m :: * -> *). MonadCount m => m ()
tick m () -> m (SimpleCat a m) -> m (SimpleCat a m)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> do
  DequeIs a m
dis1 <- BDeque a m -> m (DequeIs a m)
forall (m :: * -> *) a.
MonadInherit m =>
BDeque a m -> m (DequeIs a m)
tooSmall BDeque a m
d1
  case DequeIs a m
dis1 of
    Small Maybe a
y -> BDeque a m -> SimpleCat a m
forall a (m :: * -> *). BDeque a m -> SimpleCat a m
Shallow (BDeque a m -> SimpleCat a m)
-> m (BDeque a m) -> m (SimpleCat a m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a -> BDeque a m -> m (BDeque a m)
forall (m :: * -> *) a.
MonadInherit m =>
Maybe a -> BDeque a m -> m (BDeque a m)
dappendL Maybe a
y BDeque a m
d2
    Big BDeque a m
d1 -> do
      DequeIs a m
dis2 <- BDeque a m -> m (DequeIs a m)
forall (m :: * -> *) a.
MonadInherit m =>
BDeque a m -> m (DequeIs a m)
tooSmall BDeque a m
d2
      case DequeIs a m
dis2 of
        Small Maybe a
y -> BDeque a m -> SimpleCat a m
forall a (m :: * -> *). BDeque a m -> SimpleCat a m
Shallow (BDeque a m -> SimpleCat a m)
-> m (BDeque a m) -> m (SimpleCat a m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BDeque a m -> Maybe a -> m (BDeque a m)
forall (m :: * -> *) a.
MonadInherit m =>
BDeque a m -> Maybe a -> m (BDeque a m)
dappendR BDeque a m
d1 Maybe a
y
        Big BDeque a m
d2 -> do
          Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m <- Lazy m (SimpleCat (BDeque a m) m)
-> m (Thunk m (Lazy m) (SimpleCat (BDeque a m) m))
forall (m :: * -> *) (t :: * -> *) a.
MonadLazy m =>
t a -> m (Thunk m t a)
forall (t :: * -> *) a. t a -> m (Thunk m t a)
delay (Lazy m (SimpleCat (BDeque a m) m)
 -> m (Thunk m (Lazy m) (SimpleCat (BDeque a m) m)))
-> Lazy m (SimpleCat (BDeque a m) m)
-> m (Thunk m (Lazy m) (SimpleCat (BDeque a m) m))
forall a b. (a -> b) -> a -> b
$ m (SimpleCat (BDeque a m) m) -> Lazy m (SimpleCat (BDeque a m) m)
forall {k} (m :: k -> *) (a :: k). m a -> Lazy m a
Lazy m (SimpleCat (BDeque a m) m)
forall (m :: * -> *) a. MonadInherit m => m (SimpleCat a m)
forall (q :: * -> (* -> *) -> *) (m :: * -> *) a.
(Deque q, MonadInherit m) =>
m (q a m)
empty
          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (BDeque a m -> Bool
forall a (m :: * -> *). BDeque a m -> Bool
dangerous BDeque a m
d1) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m Thunk m (Lazy m) (SimpleCat (BDeque a m) m) -> Credit -> m ()
forall (m :: * -> *) (t :: * -> *) a.
MonadCredit m =>
Thunk m t a -> Credit -> m ()
forall (t :: * -> *) a. Thunk m t a -> Credit -> m ()
`creditWith` Credit
cost
          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (BDeque a m -> Bool
forall a (m :: * -> *). BDeque a m -> Bool
dangerous BDeque a m
d2) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m Thunk m (Lazy m) (SimpleCat (BDeque a m) m) -> Credit -> m ()
forall (m :: * -> *) (t :: * -> *) a.
MonadCredit m =>
Thunk m t a -> Credit -> m ()
forall (t :: * -> *) a. Thunk m t a -> Credit -> m ()
`creditWith` Credit
cost
          BDeque a m
-> Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
-> BDeque a m
-> m (SimpleCat a m)
forall (m :: * -> *) a.
MonadInherit m =>
BDeque a m
-> Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
-> BDeque a m
-> m (SimpleCat a m)
deep BDeque a m
d1 Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m BDeque a m
d2
concat' (Shallow BDeque a m
d1) (Deep BDeque a m
f Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m BDeque a m
r) = m ()
forall (m :: * -> *). MonadCount m => m ()
tick m () -> m (SimpleCat a m) -> m (SimpleCat a m)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> do
  DequeIs a m
dis1 <- BDeque a m -> m (DequeIs a m)
forall (m :: * -> *) a.
MonadInherit m =>
BDeque a m -> m (DequeIs a m)
tooSmall BDeque a m
d1
  case DequeIs a m
dis1 of
    Small Maybe a
y -> Maybe a -> BDeque a m -> m (BDeque a m)
forall (m :: * -> *) a.
MonadInherit m =>
Maybe a -> BDeque a m -> m (BDeque a m)
dappendL Maybe a
y BDeque a m
f m (BDeque a m)
-> (BDeque a m -> m (SimpleCat a m)) -> m (SimpleCat a m)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \BDeque a m
f -> BDeque a m
-> Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
-> BDeque a m
-> m (SimpleCat a m)
forall (m :: * -> *) a.
MonadInherit m =>
BDeque a m
-> Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
-> BDeque a m
-> m (SimpleCat a m)
deep BDeque a m
f Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m BDeque a m
r
    Big BDeque a m
d -> do
      Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m Thunk m (Lazy m) (SimpleCat (BDeque a m) m) -> Credit -> m ()
forall (m :: * -> *) (t :: * -> *) a.
MonadCredit m =>
Thunk m t a -> Credit -> m ()
forall (t :: * -> *) a. Thunk m t a -> Credit -> m ()
`creditWith` Credit
cost
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (BDeque a m -> Bool
forall a (m :: * -> *). BDeque a m -> Bool
dangerous BDeque a m
r) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m Thunk m (Lazy m) (SimpleCat (BDeque a m) m) -> Credit -> m ()
forall (m :: * -> *) (t :: * -> *) a.
MonadCredit m =>
Thunk m t a -> Credit -> m ()
forall (t :: * -> *) a. Thunk m t a -> Credit -> m ()
`creditWith` Credit
cost
      Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m' <- Lazy m (SimpleCat (BDeque a m) m)
-> m (Thunk m (Lazy m) (SimpleCat (BDeque a m) m))
forall (m :: * -> *) (t :: * -> *) a.
MonadLazy m =>
t a -> m (Thunk m t a)
forall (t :: * -> *) a. t a -> m (Thunk m t a)
delay (Lazy m (SimpleCat (BDeque a m) m)
 -> m (Thunk m (Lazy m) (SimpleCat (BDeque a m) m)))
-> Lazy m (SimpleCat (BDeque a m) m)
-> m (Thunk m (Lazy m) (SimpleCat (BDeque a m) m))
forall a b. (a -> b) -> a -> b
$ m (SimpleCat (BDeque a m) m) -> Lazy m (SimpleCat (BDeque a m) m)
forall {k} (m :: k -> *) (a :: k). m a -> Lazy m a
Lazy (m (SimpleCat (BDeque a m) m) -> Lazy m (SimpleCat (BDeque a m) m))
-> m (SimpleCat (BDeque a m) m)
-> Lazy m (SimpleCat (BDeque a m) m)
forall a b. (a -> b) -> a -> b
$ BDeque a m
-> SimpleCat (BDeque a m) m -> m (SimpleCat (BDeque a m) m)
forall (m :: * -> *) a.
MonadInherit m =>
a -> SimpleCat a m -> m (SimpleCat a m)
forall (q :: * -> (* -> *) -> *) (m :: * -> *) a.
(Deque q, MonadInherit m) =>
a -> q a m -> m (q a m)
cons BDeque a m
f (SimpleCat (BDeque a m) m -> m (SimpleCat (BDeque a m) m))
-> m (SimpleCat (BDeque a m) m) -> m (SimpleCat (BDeque a m) m)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
-> m (SimpleCat (BDeque a m) m)
forall (m :: * -> *) (t :: * -> *) a.
(MonadLazy m, HasStep t m) =>
Thunk m t a -> m a
forall (t :: * -> *) a. HasStep t m => Thunk m t a -> m a
force Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (BDeque a m -> Bool
forall a (m :: * -> *). BDeque a m -> Bool
dangerous BDeque a m
d) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m' Thunk m (Lazy m) (SimpleCat (BDeque a m) m) -> Credit -> m ()
forall (m :: * -> *) (t :: * -> *) a.
MonadCredit m =>
Thunk m t a -> Credit -> m ()
forall (t :: * -> *) a. Thunk m t a -> Credit -> m ()
`creditWith` Credit
cost
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (BDeque a m -> Bool
forall a (m :: * -> *). BDeque a m -> Bool
dangerous BDeque a m
r) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m' Thunk m (Lazy m) (SimpleCat (BDeque a m) m) -> Credit -> m ()
forall (m :: * -> *) (t :: * -> *) a.
MonadCredit m =>
Thunk m t a -> Credit -> m ()
forall (t :: * -> *) a. Thunk m t a -> Credit -> m ()
`creditWith` Credit
cost
      BDeque a m
-> Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
-> BDeque a m
-> m (SimpleCat a m)
forall (m :: * -> *) a.
MonadInherit m =>
BDeque a m
-> Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
-> BDeque a m
-> m (SimpleCat a m)
deep BDeque a m
d Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m' BDeque a m
r
concat' (Deep BDeque a m
f Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m BDeque a m
r) (Shallow BDeque a m
d2) = m ()
forall (m :: * -> *). MonadCount m => m ()
tick m () -> m (SimpleCat a m) -> m (SimpleCat a m)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> do
  DequeIs a m
dis2 <- BDeque a m -> m (DequeIs a m)
forall (m :: * -> *) a.
MonadInherit m =>
BDeque a m -> m (DequeIs a m)
tooSmall BDeque a m
d2
  case DequeIs a m
dis2 of
    Small Maybe a
y -> BDeque a m
-> Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
-> BDeque a m
-> m (SimpleCat a m)
forall (m :: * -> *) a.
MonadInherit m =>
BDeque a m
-> Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
-> BDeque a m
-> m (SimpleCat a m)
deep BDeque a m
f Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m (BDeque a m -> m (SimpleCat a m))
-> m (BDeque a m) -> m (SimpleCat a m)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BDeque a m -> Maybe a -> m (BDeque a m)
forall (m :: * -> *) a.
MonadInherit m =>
BDeque a m -> Maybe a -> m (BDeque a m)
dappendR BDeque a m
r Maybe a
y
    Big BDeque a m
d -> do
      Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m Thunk m (Lazy m) (SimpleCat (BDeque a m) m) -> Credit -> m ()
forall (m :: * -> *) (t :: * -> *) a.
MonadCredit m =>
Thunk m t a -> Credit -> m ()
forall (t :: * -> *) a. Thunk m t a -> Credit -> m ()
`creditWith` Credit
cost
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (BDeque a m -> Bool
forall a (m :: * -> *). BDeque a m -> Bool
dangerous BDeque a m
f) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m Thunk m (Lazy m) (SimpleCat (BDeque a m) m) -> Credit -> m ()
forall (m :: * -> *) (t :: * -> *) a.
MonadCredit m =>
Thunk m t a -> Credit -> m ()
forall (t :: * -> *) a. Thunk m t a -> Credit -> m ()
`creditWith` Credit
cost
      Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m' <- Lazy m (SimpleCat (BDeque a m) m)
-> m (Thunk m (Lazy m) (SimpleCat (BDeque a m) m))
forall (m :: * -> *) (t :: * -> *) a.
MonadLazy m =>
t a -> m (Thunk m t a)
forall (t :: * -> *) a. t a -> m (Thunk m t a)
delay (Lazy m (SimpleCat (BDeque a m) m)
 -> m (Thunk m (Lazy m) (SimpleCat (BDeque a m) m)))
-> Lazy m (SimpleCat (BDeque a m) m)
-> m (Thunk m (Lazy m) (SimpleCat (BDeque a m) m))
forall a b. (a -> b) -> a -> b
$ m (SimpleCat (BDeque a m) m) -> Lazy m (SimpleCat (BDeque a m) m)
forall {k} (m :: k -> *) (a :: k). m a -> Lazy m a
Lazy (m (SimpleCat (BDeque a m) m) -> Lazy m (SimpleCat (BDeque a m) m))
-> m (SimpleCat (BDeque a m) m)
-> Lazy m (SimpleCat (BDeque a m) m)
forall a b. (a -> b) -> a -> b
$ (SimpleCat (BDeque a m) m
 -> BDeque a m -> m (SimpleCat (BDeque a m) m))
-> BDeque a m
-> SimpleCat (BDeque a m) m
-> m (SimpleCat (BDeque a m) m)
forall a b c. (a -> b -> c) -> b -> a -> c
flip SimpleCat (BDeque a m) m
-> BDeque a m -> m (SimpleCat (BDeque a m) m)
forall (m :: * -> *) a.
MonadInherit m =>
SimpleCat a m -> a -> m (SimpleCat a m)
forall (q :: * -> (* -> *) -> *) (m :: * -> *) a.
(Deque q, MonadInherit m) =>
q a m -> a -> m (q a m)
snoc BDeque a m
r (SimpleCat (BDeque a m) m -> m (SimpleCat (BDeque a m) m))
-> m (SimpleCat (BDeque a m) m) -> m (SimpleCat (BDeque a m) m)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
-> m (SimpleCat (BDeque a m) m)
forall (m :: * -> *) (t :: * -> *) a.
(MonadLazy m, HasStep t m) =>
Thunk m t a -> m a
forall (t :: * -> *) a. HasStep t m => Thunk m t a -> m a
force Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (BDeque a m -> Bool
forall a (m :: * -> *). BDeque a m -> Bool
dangerous BDeque a m
d) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m' Thunk m (Lazy m) (SimpleCat (BDeque a m) m) -> Credit -> m ()
forall (m :: * -> *) (t :: * -> *) a.
MonadCredit m =>
Thunk m t a -> Credit -> m ()
forall (t :: * -> *) a. Thunk m t a -> Credit -> m ()
`creditWith` Credit
cost
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (BDeque a m -> Bool
forall a (m :: * -> *). BDeque a m -> Bool
dangerous BDeque a m
f) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m' Thunk m (Lazy m) (SimpleCat (BDeque a m) m) -> Credit -> m ()
forall (m :: * -> *) (t :: * -> *) a.
MonadCredit m =>
Thunk m t a -> Credit -> m ()
forall (t :: * -> *) a. Thunk m t a -> Credit -> m ()
`creditWith` Credit
cost
      BDeque a m
-> Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
-> BDeque a m
-> m (SimpleCat a m)
forall (m :: * -> *) a.
MonadInherit m =>
BDeque a m
-> Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
-> BDeque a m
-> m (SimpleCat a m)
deep BDeque a m
f Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m' BDeque a m
d
concat' (Deep BDeque a m
f1 Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m1 BDeque a m
r1) (Deep BDeque a m
f2 Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m2 BDeque a m
r2) = m ()
forall (m :: * -> *). MonadCount m => m ()
tick m () -> m (SimpleCat a m) -> m (SimpleCat a m)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> do
  Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m <- Lazy m (SimpleCat (BDeque a m) m)
-> m (Thunk m (Lazy m) (SimpleCat (BDeque a m) m))
forall (m :: * -> *) (t :: * -> *) a.
MonadLazy m =>
t a -> m (Thunk m t a)
forall (t :: * -> *) a. t a -> m (Thunk m t a)
delay (Lazy m (SimpleCat (BDeque a m) m)
 -> m (Thunk m (Lazy m) (SimpleCat (BDeque a m) m)))
-> Lazy m (SimpleCat (BDeque a m) m)
-> m (Thunk m (Lazy m) (SimpleCat (BDeque a m) m))
forall a b. (a -> b) -> a -> b
$ m (SimpleCat (BDeque a m) m) -> Lazy m (SimpleCat (BDeque a m) m)
forall {k} (m :: k -> *) (a :: k). m a -> Lazy m a
Lazy (m (SimpleCat (BDeque a m) m) -> Lazy m (SimpleCat (BDeque a m) m))
-> m (SimpleCat (BDeque a m) m)
-> Lazy m (SimpleCat (BDeque a m) m)
forall a b. (a -> b) -> a -> b
$ do
    Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m1 Thunk m (Lazy m) (SimpleCat (BDeque a m) m) -> Credit -> m ()
forall (m :: * -> *) (t :: * -> *) a.
MonadCredit m =>
Thunk m t a -> Credit -> m ()
forall (t :: * -> *) a. Thunk m t a -> Credit -> m ()
`creditWith` (Credit
2 Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
* Credit
cost)
    SimpleCat (BDeque a m) m
m1' <- (SimpleCat (BDeque a m) m
 -> BDeque a m -> m (SimpleCat (BDeque a m) m))
-> BDeque a m
-> SimpleCat (BDeque a m) m
-> m (SimpleCat (BDeque a m) m)
forall a b c. (a -> b -> c) -> b -> a -> c
flip SimpleCat (BDeque a m) m
-> BDeque a m -> m (SimpleCat (BDeque a m) m)
forall (m :: * -> *) a.
MonadInherit m =>
SimpleCat a m -> a -> m (SimpleCat a m)
forall (q :: * -> (* -> *) -> *) (m :: * -> *) a.
(Deque q, MonadInherit m) =>
q a m -> a -> m (q a m)
snoc BDeque a m
r1 (SimpleCat (BDeque a m) m -> m (SimpleCat (BDeque a m) m))
-> m (SimpleCat (BDeque a m) m) -> m (SimpleCat (BDeque a m) m)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
-> m (SimpleCat (BDeque a m) m)
forall (m :: * -> *) (t :: * -> *) a.
(MonadLazy m, HasStep t m) =>
Thunk m t a -> m a
forall (t :: * -> *) a. HasStep t m => Thunk m t a -> m a
force Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m1
    Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m2 Thunk m (Lazy m) (SimpleCat (BDeque a m) m) -> Credit -> m ()
forall (m :: * -> *) (t :: * -> *) a.
MonadCredit m =>
Thunk m t a -> Credit -> m ()
forall (t :: * -> *) a. Thunk m t a -> Credit -> m ()
`creditWith` (Credit
2 Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
* Credit
cost)
    SimpleCat (BDeque a m) m
m2' <- BDeque a m
-> SimpleCat (BDeque a m) m -> m (SimpleCat (BDeque a m) m)
forall (m :: * -> *) a.
MonadInherit m =>
a -> SimpleCat a m -> m (SimpleCat a m)
forall (q :: * -> (* -> *) -> *) (m :: * -> *) a.
(Deque q, MonadInherit m) =>
a -> q a m -> m (q a m)
cons BDeque a m
f2 (SimpleCat (BDeque a m) m -> m (SimpleCat (BDeque a m) m))
-> m (SimpleCat (BDeque a m) m) -> m (SimpleCat (BDeque a m) m)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
-> m (SimpleCat (BDeque a m) m)
forall (m :: * -> *) (t :: * -> *) a.
(MonadLazy m, HasStep t m) =>
Thunk m t a -> m a
forall (t :: * -> *) a. HasStep t m => Thunk m t a -> m a
force Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m2
    SimpleCat (BDeque a m) m
-> SimpleCat (BDeque a m) m -> m (SimpleCat (BDeque a m) m)
forall (m :: * -> *) a.
MonadInherit m =>
SimpleCat a m -> SimpleCat a m -> m (SimpleCat a m)
concat' SimpleCat (BDeque a m) m
m1' SimpleCat (BDeque a m) m
m2'
  Thunk m (Lazy m) (SimpleCat (BDeque a m) m) -> m ()
forall (m :: * -> *) (t :: * -> *) a.
MonadInherit m =>
Thunk m t a -> m ()
forall (t :: * -> *) a. Thunk m t a -> m ()
creditAllTo Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m
  BDeque a m
-> Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
-> BDeque a m
-> m (SimpleCat a m)
forall (m :: * -> *) a.
MonadInherit m =>
BDeque a m
-> Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
-> BDeque a m
-> m (SimpleCat a m)
deep BDeque a m
f1 Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m BDeque a m
r2

instance Deque SimpleCat where
  empty :: forall (m :: * -> *) a. MonadInherit m => m (SimpleCat a m)
empty = BDeque a m -> SimpleCat a m
forall a (m :: * -> *). BDeque a m -> SimpleCat a m
Shallow (BDeque a m -> SimpleCat a m)
-> m (BDeque a m) -> m (SimpleCat a m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (BDeque a m)
forall (m :: * -> *) a. MonadInherit m => m (BDeque a m)
forall (q :: * -> (* -> *) -> *) (m :: * -> *) a.
(Deque q, MonadInherit m) =>
m (q a m)
D.empty
  cons :: forall (m :: * -> *) a.
MonadInherit m =>
a -> SimpleCat a m -> m (SimpleCat a m)
cons a
x (Shallow BDeque a m
d) = BDeque a m -> SimpleCat a m
forall a (m :: * -> *). BDeque a m -> SimpleCat a m
Shallow (BDeque a m -> SimpleCat a m)
-> m (BDeque a m) -> m (SimpleCat a m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> BDeque a m -> m (BDeque a m)
forall (m :: * -> *) a.
MonadInherit m =>
a -> BDeque a m -> m (BDeque a m)
forall (q :: * -> (* -> *) -> *) (m :: * -> *) a.
(Deque q, MonadInherit m) =>
a -> q a m -> m (q a m)
D.cons a
x BDeque a m
d
  cons a
x (Deep BDeque a m
f Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m BDeque a m
r) = do
    BDeque a m
f' <- a -> BDeque a m -> m (BDeque a m)
forall (m :: * -> *) a.
MonadInherit m =>
a -> BDeque a m -> m (BDeque a m)
forall (q :: * -> (* -> *) -> *) (m :: * -> *) a.
(Deque q, MonadInherit m) =>
a -> q a m -> m (q a m)
D.cons a
x BDeque a m
f
    BDeque a m
-> Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
-> BDeque a m
-> m (SimpleCat a m)
forall (m :: * -> *) a.
MonadInherit m =>
BDeque a m
-> Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
-> BDeque a m
-> m (SimpleCat a m)
deep BDeque a m
f' Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m BDeque a m
r
  snoc :: forall (m :: * -> *) a.
MonadInherit m =>
SimpleCat a m -> a -> m (SimpleCat a m)
snoc (Shallow BDeque a m
d) a
x = BDeque a m -> SimpleCat a m
forall a (m :: * -> *). BDeque a m -> SimpleCat a m
Shallow (BDeque a m -> SimpleCat a m)
-> m (BDeque a m) -> m (SimpleCat a m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BDeque a m -> a -> m (BDeque a m)
forall (m :: * -> *) a.
MonadInherit m =>
BDeque a m -> a -> m (BDeque a m)
forall (q :: * -> (* -> *) -> *) (m :: * -> *) a.
(Deque q, MonadInherit m) =>
q a m -> a -> m (q a m)
D.snoc BDeque a m
d a
x
  snoc (Deep BDeque a m
f Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m BDeque a m
r) a
x = BDeque a m
-> Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
-> BDeque a m
-> m (SimpleCat a m)
forall (m :: * -> *) a.
MonadInherit m =>
BDeque a m
-> Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
-> BDeque a m
-> m (SimpleCat a m)
deep BDeque a m
f Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m (BDeque a m -> m (SimpleCat a m))
-> m (BDeque a m) -> m (SimpleCat a m)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BDeque a m -> a -> m (BDeque a m)
forall (m :: * -> *) a.
MonadInherit m =>
BDeque a m -> a -> m (BDeque a m)
forall (q :: * -> (* -> *) -> *) (m :: * -> *) a.
(Deque q, MonadInherit m) =>
q a m -> a -> m (q a m)
D.snoc BDeque a m
r a
x
  uncons :: forall (m :: * -> *) a.
MonadInherit m =>
SimpleCat a m -> m (Maybe (a, SimpleCat a m))
uncons SimpleCat a m
d = do
    Maybe (a, Thunk m (Lazy m) (SimpleCat a m))
m <- SimpleCat a m -> m (Maybe (a, Thunk m (Lazy m) (SimpleCat a m)))
forall (m :: * -> *) a.
MonadInherit m =>
SimpleCat a m -> m (Maybe (a, Thunk m (Lazy m) (SimpleCat a m)))
uncons' SimpleCat a m
d
    case Maybe (a, Thunk m (Lazy m) (SimpleCat a m))
m of
      Maybe (a, Thunk m (Lazy m) (SimpleCat a m))
Nothing -> Maybe (a, SimpleCat a m) -> m (Maybe (a, SimpleCat a m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (a, SimpleCat a m)
forall a. Maybe a
Nothing
      Just (a
x, Thunk m (Lazy m) (SimpleCat a m)
t) -> do
        Thunk m (Lazy m) (SimpleCat a m)
t Thunk m (Lazy m) (SimpleCat a m) -> Credit -> m ()
forall (m :: * -> *) (t :: * -> *) a.
MonadCredit m =>
Thunk m t a -> Credit -> m ()
forall (t :: * -> *) a. Thunk m t a -> Credit -> m ()
`creditWith` (Credit
2 Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
* Credit
cost)
        (a, SimpleCat a m) -> Maybe (a, SimpleCat a m)
forall a. a -> Maybe a
Just ((a, SimpleCat a m) -> Maybe (a, SimpleCat a m))
-> (SimpleCat a m -> (a, SimpleCat a m))
-> SimpleCat a m
-> Maybe (a, SimpleCat a m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
x,) (SimpleCat a m -> Maybe (a, SimpleCat a m))
-> m (SimpleCat a m) -> m (Maybe (a, SimpleCat a m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Thunk m (Lazy m) (SimpleCat a m) -> m (SimpleCat a m)
forall (m :: * -> *) (t :: * -> *) a.
(MonadLazy m, HasStep t m) =>
Thunk m t a -> m a
forall (t :: * -> *) a. HasStep t m => Thunk m t a -> m a
force Thunk m (Lazy m) (SimpleCat a m)
t
  unsnoc :: forall (m :: * -> *) a.
MonadInherit m =>
SimpleCat a m -> m (Maybe (SimpleCat a m, a))
unsnoc SimpleCat a m
d = do
    Maybe (Thunk m (Lazy m) (SimpleCat a m), a)
m <- SimpleCat a m -> m (Maybe (Thunk m (Lazy m) (SimpleCat a m), a))
forall (m :: * -> *) a.
MonadInherit m =>
SimpleCat a m -> m (Maybe (Thunk m (Lazy m) (SimpleCat a m), a))
unsnoc' SimpleCat a m
d
    case Maybe (Thunk m (Lazy m) (SimpleCat a m), a)
m of
      Maybe (Thunk m (Lazy m) (SimpleCat a m), a)
Nothing -> Maybe (SimpleCat a m, a) -> m (Maybe (SimpleCat a m, a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (SimpleCat a m, a)
forall a. Maybe a
Nothing
      Just (Thunk m (Lazy m) (SimpleCat a m)
t, a
x) -> do
        Thunk m (Lazy m) (SimpleCat a m)
t Thunk m (Lazy m) (SimpleCat a m) -> Credit -> m ()
forall (m :: * -> *) (t :: * -> *) a.
MonadCredit m =>
Thunk m t a -> Credit -> m ()
forall (t :: * -> *) a. Thunk m t a -> Credit -> m ()
`creditWith` (Credit
2 Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
* Credit
cost)
        (SimpleCat a m, a) -> Maybe (SimpleCat a m, a)
forall a. a -> Maybe a
Just ((SimpleCat a m, a) -> Maybe (SimpleCat a m, a))
-> (SimpleCat a m -> (SimpleCat a m, a))
-> SimpleCat a m
-> Maybe (SimpleCat a m, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,a
x) (SimpleCat a m -> Maybe (SimpleCat a m, a))
-> m (SimpleCat a m) -> m (Maybe (SimpleCat a m, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Thunk m (Lazy m) (SimpleCat a m) -> m (SimpleCat a m)
forall (m :: * -> *) (t :: * -> *) a.
(MonadLazy m, HasStep t m) =>
Thunk m t a -> m a
forall (t :: * -> *) a. HasStep t m => Thunk m t a -> m a
force Thunk m (Lazy m) (SimpleCat a m)
t
  concat :: forall (m :: * -> *) a.
MonadInherit m =>
SimpleCat a m -> SimpleCat a m -> m (SimpleCat a m)
concat = SimpleCat a m -> SimpleCat a m -> m (SimpleCat a m)
forall (m :: * -> *) a.
MonadInherit m =>
SimpleCat a m -> SimpleCat a m -> m (SimpleCat a m)
concat'

instance BoundedDeque SimpleCat where
  qcost :: forall a. Size -> DequeOp a -> Credit
qcost Size
n (Cons a
x) = forall (q :: * -> (* -> *) -> *) a.
BoundedDeque q =>
Size -> DequeOp a -> Credit
qcost @(D.BDeque) Size
n (a -> DequeOp a
forall a. a -> DequeOp a
Cons a
x)
  qcost Size
n (Snoc a
x) = forall (q :: * -> (* -> *) -> *) a.
BoundedDeque q =>
Size -> DequeOp a -> Credit
qcost @(D.BDeque) Size
n (a -> DequeOp a
forall a. a -> DequeOp a
Snoc a
x)
  qcost Size
n DequeOp a
Uncons = Credit
1 Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
+ forall (q :: * -> (* -> *) -> *) a.
BoundedDeque q =>
Size -> DequeOp a -> Credit
qcost @(D.BDeque) Size
n DequeOp Any
forall a. DequeOp a
Uncons Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
+ Credit
2 Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
* Credit
cost
  qcost Size
n DequeOp a
Unsnoc = Credit
1 Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
+ forall (q :: * -> (* -> *) -> *) a.
BoundedDeque q =>
Size -> DequeOp a -> Credit
qcost @(D.BDeque) Size
n DequeOp Any
forall a. DequeOp a
Unsnoc Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
+ Credit
2 Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
* Credit
cost
  qcost Size
n DequeOp a
Concat = (Credit
1 Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
+ Credit
6 Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
* Credit
cost) Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
* Size -> Credit
log2 Size
n

instance (MonadMemory m, MemoryCell m a) => MemoryCell m (SimpleCat a m) where
  prettyCell :: SimpleCat a m -> m Memory
prettyCell (Shallow BDeque a m
d) = do
    Memory
d' <- BDeque a m -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell BDeque a m
d
    Memory -> m Memory
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Memory -> m Memory) -> Memory -> m Memory
forall a b. (a -> b) -> a -> b
$ String -> [Memory] -> Memory
mkMCell String
"Shallow" [Memory
d']
  prettyCell (Deep BDeque a m
f Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m BDeque a m
r) = do
    Memory
f' <- BDeque a m -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell BDeque a m
f
    Memory
m' <- Thunk m (Lazy m) (SimpleCat (BDeque a m) m) -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell Thunk m (Lazy m) (SimpleCat (BDeque a m) m)
m
    Memory
r' <- BDeque a m -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell BDeque a m
r
    Memory -> m Memory
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Memory -> m Memory) -> Memory -> m Memory
forall a b. (a -> b) -> a -> b
$ String -> [Memory] -> Memory
mkMCell String
"Deep" [Memory
f', Memory
m', Memory
r']

instance Pretty a => MemoryStructure (SimpleCat (PrettyCell a)) where
  prettyStructure :: forall (m :: * -> *).
MonadMemory m =>
SimpleCat (PrettyCell a) m -> m Memory
prettyStructure = SimpleCat (PrettyCell a) m -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell