{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}

-- |
-- Module      :  Data.Stack.Circular
-- Description :  Circular stacks of fixed size
-- Copyright   :  (c) 2021 Dominik Schrempf
-- License     :  GPL-3.0-or-later
--
-- Maintainer  :  dominik.schrempf@gmail.com
-- Stability   :  unstable
-- Portability :  portable
--
-- Creation date: Thu Jun 18 10:00:28 2020.
--
-- Construction of mutable circular stacks is done with 'replicate' and subsequent
-- 'push'es, or with 'fromVector'.
--
-- When denoting the asymptotic runtime of functions, @n@ refers to the circular
-- stack size.
module Data.Stack.Circular
  ( -- * Mutable circular stacks
    MStack,

    -- ** Construction and conversion
    replicate,
    fromVector,
    fromVectorWithIndex,
    toVector,
    take,

    -- ** Accessors
    size,
    get,
    pop,
    push,

    -- ** Monadic folds
    foldM,
    foldKM,

    -- * Immutable circular stacks
    Stack,
    thaw,
    freeze,
  )
where

import Control.Monad.Primitive
import Data.Aeson
import Data.Aeson.TH
import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Generic.Mutable as VM
import Prelude hiding (foldl, product, replicate, sum, take)

-- | Mutable circular stacks with fixed size are just mutable vectors with a
-- pointer to the last element.
data MStack v s a = MStack
  { MStack v s a -> Mutable v s a
_mVector :: VG.Mutable v s a,
    MStack v s a -> Int
_mIndex :: !Int
  }

-- | A circular stack of given size with the same element replicated.
--
-- Call 'error' if the maximum size is zero or negative.
--
-- O(n).
replicate :: (VG.Vector v a, PrimMonad m) => Int -> a -> m (MStack v (PrimState m) a)
replicate :: Int -> a -> m (MStack v (PrimState m) a)
replicate Int
n a
x
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = [Char] -> m (MStack v (PrimState m) a)
forall a. HasCallStack => [Char] -> a
error [Char]
"empty: maximum size must be one or larger"
  | Bool
otherwise = do
      Mutable v (PrimState m) a
v <- Int -> a -> m (Mutable v (PrimState m) a)
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
Int -> a -> m (v (PrimState m) a)
VM.replicate Int
n a
x
      MStack v (PrimState m) a -> m (MStack v (PrimState m) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (MStack v (PrimState m) a -> m (MStack v (PrimState m) a))
-> MStack v (PrimState m) a -> m (MStack v (PrimState m) a)
forall a b. (a -> b) -> a -> b
$ Mutable v (PrimState m) a -> Int -> MStack v (PrimState m) a
forall (v :: * -> *) s a. Mutable v s a -> Int -> MStack v s a
MStack Mutable v (PrimState m) a
v Int
0

-- | Convert a vector to a circular stack with size being equal to the length of
-- the vector. The first element of the vector is the oldest element of the
-- stack, the last element of the vector is the youngest element of the stack.
--
-- The vector must be non-empty.
--
-- O(n).
fromVector :: (VG.Vector v a, PrimMonad m) => v a -> m (MStack v (PrimState m) a)
fromVector :: v a -> m (MStack v (PrimState m) a)
fromVector v a
v
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = [Char] -> m (MStack v (PrimState m) a)
forall a. HasCallStack => [Char] -> a
error [Char]
"fromVector: empty vector"
  | Bool
otherwise = do
      Mutable v (PrimState m) a
mv <- v a -> m (Mutable v (PrimState m) a)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
v a -> m (Mutable v (PrimState m) a)
VG.thaw v a
v
      MStack v (PrimState m) a -> m (MStack v (PrimState m) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (MStack v (PrimState m) a -> m (MStack v (PrimState m) a))
-> MStack v (PrimState m) a -> m (MStack v (PrimState m) a)
forall a b. (a -> b) -> a -> b
$ Mutable v (PrimState m) a -> Int -> MStack v (PrimState m) a
forall (v :: * -> *) s a. Mutable v s a -> Int -> MStack v s a
MStack Mutable v (PrimState m) a
mv (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  where
    n :: Int
n = v a -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length v a
v

-- | Convert a vector to a circular stack with size being equal to the length of
-- the vector. The element of the vector at the given index is the youngest
-- element of the stack, the next element of the vector is the oldest element of
-- the stack.
--
-- The vector must be non-empty.
--
-- O(n).
fromVectorWithIndex :: (VG.Vector v a, PrimMonad m) => Int -> v a -> m (MStack v (PrimState m) a)
fromVectorWithIndex :: Int -> v a -> m (MStack v (PrimState m) a)
fromVectorWithIndex Int
i v a
v = do
  MStack v (PrimState m) a
ms <- v a -> m (MStack v (PrimState m) a)
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
v a -> m (MStack v (PrimState m) a)
fromVector v a
v
  MStack v (PrimState m) a -> m (MStack v (PrimState m) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (MStack v (PrimState m) a -> m (MStack v (PrimState m) a))
-> MStack v (PrimState m) a -> m (MStack v (PrimState m) a)
forall a b. (a -> b) -> a -> b
$ MStack v (PrimState m) a
ms {_mIndex :: Int
_mIndex = Int
i}

-- | Convert a circular stack to a vector. The first element of the returned
-- vector is the oldest element of the stack, the last element of the returned
-- vector is the youngest element of the stack.
--
-- O(n).
toVector :: (VG.Vector v a, PrimMonad m) => MStack v (PrimState m) a -> m (v a)
toVector :: MStack v (PrimState m) a -> m (v a)
toVector (MStack Mutable v (PrimState m) a
v Int
i) = do
  v a
l <- Mutable v (PrimState m) a -> m (v a)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
VG.freeze (Mutable v (PrimState m) a -> m (v a))
-> Mutable v (PrimState m) a -> m (v a)
forall a b. (a -> b) -> a -> b
$ Int -> Mutable v (PrimState m) a -> Mutable v (PrimState m) a
forall (v :: * -> * -> *) a s. MVector v a => Int -> v s a -> v s a
VM.unsafeDrop Int
i' Mutable v (PrimState m) a
v
  v a
r <- Mutable v (PrimState m) a -> m (v a)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
VG.freeze (Mutable v (PrimState m) a -> m (v a))
-> Mutable v (PrimState m) a -> m (v a)
forall a b. (a -> b) -> a -> b
$ Int -> Mutable v (PrimState m) a -> Mutable v (PrimState m) a
forall (v :: * -> * -> *) a s. MVector v a => Int -> v s a -> v s a
VM.unsafeTake Int
i' Mutable v (PrimState m) a
v
  v a -> m (v a)
forall (m :: * -> *) a. Monad m => a -> m a
return (v a -> m (v a)) -> v a -> m (v a)
forall a b. (a -> b) -> a -> b
$ v a
l v a -> v a -> v a
forall (v :: * -> *) a. Vector v a => v a -> v a -> v a
VG.++ v a
r
  where
    i' :: Int
i' = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

-- | Convert the last k elements of a circular stack to a vector. The first
-- element of the returned vector is the oldest element of the stack, the last
-- element of the returned vector is the youngest element of the stack.
--
-- The size of the stack must be larger than k.
--
-- O(k).
take :: (VG.Vector v a, PrimMonad m) => Int -> MStack v (PrimState m) a -> m (v a)
take :: Int -> MStack v (PrimState m) a -> m (v a)
take Int
k (MStack Mutable v (PrimState m) a
v Int
i)
  | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [Char] -> m (v a)
forall a. HasCallStack => [Char] -> a
error [Char]
"toVectorN: negative k"
  | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n = [Char] -> m (v a)
forall a. HasCallStack => [Char] -> a
error [Char]
"toVectorN: circular stack too small"
  | Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = v a -> m (v a)
forall (m :: * -> *) a. Monad m => a -> m a
return v a
forall (v :: * -> *) a. Vector v a => v a
VG.empty
  -- We know now that k is in [1, n] and check if all k elements can be taken in
  -- one go.
  | Int
i0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = Mutable v (PrimState m) a -> m (v a)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
VG.freeze (Mutable v (PrimState m) a -> m (v a))
-> Mutable v (PrimState m) a -> m (v a)
forall a b. (a -> b) -> a -> b
$ Int
-> Int -> Mutable v (PrimState m) a -> Mutable v (PrimState m) a
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
VM.unsafeSlice Int
i0 Int
k Mutable v (PrimState m) a
v
  -- Now we now that i0 is negative.
  | Bool
otherwise = do
      -- The length of r is i'.
      v a
r <- Mutable v (PrimState m) a -> m (v a)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
VG.freeze (Mutable v (PrimState m) a -> m (v a))
-> Mutable v (PrimState m) a -> m (v a)
forall a b. (a -> b) -> a -> b
$ Int -> Mutable v (PrimState m) a -> Mutable v (PrimState m) a
forall (v :: * -> * -> *) a s. MVector v a => Int -> v s a -> v s a
VM.unsafeTake Int
i' Mutable v (PrimState m) a
v
      -- The length of l has to be k-i'. So we have to drop n-(k-i')=n+i0.
      v a
l <- Mutable v (PrimState m) a -> m (v a)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
VG.freeze (Mutable v (PrimState m) a -> m (v a))
-> Mutable v (PrimState m) a -> m (v a)
forall a b. (a -> b) -> a -> b
$ Int -> Mutable v (PrimState m) a -> Mutable v (PrimState m) a
forall (v :: * -> * -> *) a s. MVector v a => Int -> v s a -> v s a
VM.unsafeDrop (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i0) Mutable v (PrimState m) a
v
      v a -> m (v a)
forall (m :: * -> *) a. Monad m => a -> m a
return (v a -> m (v a)) -> v a -> m (v a)
forall a b. (a -> b) -> a -> b
$ v a
l v a -> v a -> v a
forall (v :: * -> *) a. Vector v a => v a -> v a -> v a
VG.++ v a
r
  where
    n :: Int
n = Mutable v (PrimState m) a -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
VM.length Mutable v (PrimState m) a
v
    i' :: Int
i' = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    -- The starting index. Can be negative.
    i0 :: Int
i0 = Int
i' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k

-- | Size of the stack.
size :: VG.Vector v a => MStack v s a -> Int
size :: MStack v s a -> Int
size = Mutable v s a -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
VM.length (Mutable v s a -> Int)
-> (MStack v s a -> Mutable v s a) -> MStack v s a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MStack v s a -> Mutable v s a
forall (v :: * -> *) s a. MStack v s a -> Mutable v s a
_mVector

-- | Get the last element without changing the stack.
--
-- O(1).
get :: (VG.Vector v a, PrimMonad m) => MStack v (PrimState m) a -> m a
get :: MStack v (PrimState m) a -> m a
get (MStack Mutable v (PrimState m) a
v Int
i) = Mutable v (PrimState m) a -> Int -> m a
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
VM.unsafeRead Mutable v (PrimState m) a
v Int
i
{-# INLINE get #-}

-- Select the previous older element without changing the stack.
previous :: VG.Vector v a => MStack v s a -> MStack v s a
previous :: MStack v s a -> MStack v s a
previous (MStack Mutable v s a
v Int
i) = Mutable v s a -> Int -> MStack v s a
forall (v :: * -> *) s a. Mutable v s a -> Int -> MStack v s a
MStack Mutable v s a
v Int
i'
  where
    j :: Int
j = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    i' :: Int
i' = if Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Mutable v s a -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
VM.length Mutable v s a
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 else Int
j

-- | Pop the youngest element from the stack and put the focus on the previous
-- element.
--
-- Be careful:
--
-- The stack is always full! Popping returns the last element and moves the
-- index to the second-last element, but the element is not truly removed from
-- the stack. It is only put to the end of the queue.
--
-- Hence, `pop` always succeeds, even if there are actually no more elements on
-- the stack (similar to walking backwards in a circle).
--
-- O(1).
pop :: (VG.Vector v a, PrimMonad m) => MStack v (PrimState m) a -> m (a, MStack v (PrimState m) a)
pop :: MStack v (PrimState m) a -> m (a, MStack v (PrimState m) a)
pop MStack v (PrimState m) a
x = do
  a
val <- MStack v (PrimState m) a -> m a
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
MStack v (PrimState m) a -> m a
get MStack v (PrimState m) a
x
  (a, MStack v (PrimState m) a) -> m (a, MStack v (PrimState m) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
val, MStack v (PrimState m) a -> MStack v (PrimState m) a
forall (v :: * -> *) a s.
Vector v a =>
MStack v s a -> MStack v s a
previous MStack v (PrimState m) a
x)

-- Replace the youngest element.
put :: (VG.Vector v a, PrimMonad m) => a -> MStack v (PrimState m) a -> m (MStack v (PrimState m) a)
put :: a -> MStack v (PrimState m) a -> m (MStack v (PrimState m) a)
put a
x (MStack Mutable v (PrimState m) a
v Int
i) = Mutable v (PrimState m) a -> Int -> a -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
VM.unsafeWrite Mutable v (PrimState m) a
v Int
i a
x m ()
-> m (MStack v (PrimState m) a) -> m (MStack v (PrimState m) a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MStack v (PrimState m) a -> m (MStack v (PrimState m) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Mutable v (PrimState m) a -> Int -> MStack v (PrimState m) a
forall (v :: * -> *) s a. Mutable v s a -> Int -> MStack v s a
MStack Mutable v (PrimState m) a
v Int
i)

-- Select the next younger element without changing the stack.
next :: VG.Vector v a => MStack v s a -> MStack v s a
next :: MStack v s a -> MStack v s a
next (MStack Mutable v s a
v Int
i) = Mutable v s a -> Int -> MStack v s a
forall (v :: * -> *) s a. Mutable v s a -> Int -> MStack v s a
MStack Mutable v s a
v Int
i'
  where
    i' :: Int
i' = (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Mutable v s a -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
VM.length Mutable v s a
v

-- | Push an element on the stack.
--
-- O(1).
push :: (VG.Vector v a, PrimMonad m) => a -> MStack v (PrimState m) a -> m (MStack v (PrimState m) a)
push :: a -> MStack v (PrimState m) a -> m (MStack v (PrimState m) a)
push a
x = a -> MStack v (PrimState m) a -> m (MStack v (PrimState m) a)
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
a -> MStack v (PrimState m) a -> m (MStack v (PrimState m) a)
put a
x (MStack v (PrimState m) a -> m (MStack v (PrimState m) a))
-> (MStack v (PrimState m) a -> MStack v (PrimState m) a)
-> MStack v (PrimState m) a
-> m (MStack v (PrimState m) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MStack v (PrimState m) a -> MStack v (PrimState m) a
forall (v :: * -> *) a s.
Vector v a =>
MStack v s a -> MStack v s a
next

-- | Monadic fold from young to old over all elements of the stack.
--
-- Please also see the documentation of 'pop'.
--
-- O(n).
foldM :: (VG.Vector v b, PrimMonad m) => (a -> b -> a) -> a -> MStack v (PrimState m) b -> m a
foldM :: (a -> b -> a) -> a -> MStack v (PrimState m) b -> m a
foldM a -> b -> a
f a
x MStack v (PrimState m) b
s = Int -> (a -> b -> a) -> a -> MStack v (PrimState m) b -> m a
forall (v :: * -> *) b (m :: * -> *) a.
(Vector v b, PrimMonad m) =>
Int -> (a -> b -> a) -> a -> MStack v (PrimState m) b -> m a
foldKM Int
n a -> b -> a
f a
x MStack v (PrimState m) b
s
  where
    n :: Int
n = Mutable v (PrimState m) b -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
VM.length (Mutable v (PrimState m) b -> Int)
-> Mutable v (PrimState m) b -> Int
forall a b. (a -> b) -> a -> b
$ MStack v (PrimState m) b -> Mutable v (PrimState m) b
forall (v :: * -> *) s a. MStack v s a -> Mutable v s a
_mVector MStack v (PrimState m) b
s

-- Monadic fold over k elements in a vector.
foldKV ::
  (VM.MVector v b, PrimMonad m) =>
  -- Number of elements to take.
  Int ->
  -- Current index.
  Int ->
  (a -> b -> a) ->
  a ->
  v (PrimState m) b ->
  m a
foldKV :: Int -> Int -> (a -> b -> a) -> a -> v (PrimState m) b -> m a
foldKV Int
0 Int
_ a -> b -> a
_ a
x v (PrimState m) b
_ = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
foldKV Int
k Int
i a -> b -> a
f a
x v (PrimState m) b
v = do
  a
x' <- a -> b -> a
f a
x (b -> a) -> m b -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> v (PrimState m) b -> Int -> m b
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
VM.unsafeRead v (PrimState m) b
v Int
i
  -- Assume that i-1 is non-negative.
  Int -> Int -> (a -> b -> a) -> a -> v (PrimState m) b -> m a
forall (v :: * -> * -> *) b (m :: * -> *) a.
(MVector v b, PrimMonad m) =>
Int -> Int -> (a -> b -> a) -> a -> v (PrimState m) b -> m a
foldKV (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) a -> b -> a
f a
x' v (PrimState m) b
v

-- | See 'foldM' but only over the @k@ youngest elements on the stack.
--
-- O(k).
foldKM :: (VG.Vector v b, PrimMonad m) => Int -> (a -> b -> a) -> a -> MStack v (PrimState m) b -> m a
foldKM :: Int -> (a -> b -> a) -> a -> MStack v (PrimState m) b -> m a
foldKM Int
k a -> b -> a
f a
x (MStack Mutable v (PrimState m) b
v Int
i)
  | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [Char] -> m a
forall a. HasCallStack => [Char] -> a
error [Char]
"foldKM: k is negative."
  | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n = [Char] -> m a
forall a. HasCallStack => [Char] -> a
error [Char]
"foldKM: k is larger than the stack size."
  -- We can do the fold in one go.
  | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i' = Int
-> Int -> (a -> b -> a) -> a -> Mutable v (PrimState m) b -> m a
forall (v :: * -> * -> *) b (m :: * -> *) a.
(MVector v b, PrimMonad m) =>
Int -> Int -> (a -> b -> a) -> a -> v (PrimState m) b -> m a
foldKV Int
k Int
i a -> b -> a
f a
x Mutable v (PrimState m) b
v
  -- Or not.
  | Bool
otherwise = do
      a
x' <- Int
-> Int -> (a -> b -> a) -> a -> Mutable v (PrimState m) b -> m a
forall (v :: * -> * -> *) b (m :: * -> *) a.
(MVector v b, PrimMonad m) =>
Int -> Int -> (a -> b -> a) -> a -> v (PrimState m) b -> m a
foldKV Int
i' Int
i a -> b -> a
f a
x Mutable v (PrimState m) b
v
      -- Continue from the end of the vector.
      Int
-> Int -> (a -> b -> a) -> a -> Mutable v (PrimState m) b -> m a
forall (v :: * -> * -> *) b (m :: * -> *) a.
(MVector v b, PrimMonad m) =>
Int -> Int -> (a -> b -> a) -> a -> v (PrimState m) b -> m a
foldKV (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i') (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) a -> b -> a
f a
x' Mutable v (PrimState m) b
v
  where
    n :: Int
n = Mutable v (PrimState m) b -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
VM.length Mutable v (PrimState m) b
v
    i' :: Int
i' = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

-- | Immutable circular stack; useful, for example, to save, or restore a
-- mutable circular stack.
data Stack v a = Stack
  { Stack v a -> v a
_iStack :: v a,
    Stack v a -> Int
_iIndex :: !Int
  }
  deriving (Stack v a -> Stack v a -> Bool
(Stack v a -> Stack v a -> Bool)
-> (Stack v a -> Stack v a -> Bool) -> Eq (Stack v a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (v :: * -> *) a. Eq (v a) => Stack v a -> Stack v a -> Bool
/= :: Stack v a -> Stack v a -> Bool
$c/= :: forall (v :: * -> *) a. Eq (v a) => Stack v a -> Stack v a -> Bool
== :: Stack v a -> Stack v a -> Bool
$c== :: forall (v :: * -> *) a. Eq (v a) => Stack v a -> Stack v a -> Bool
Eq, ReadPrec [Stack v a]
ReadPrec (Stack v a)
Int -> ReadS (Stack v a)
ReadS [Stack v a]
(Int -> ReadS (Stack v a))
-> ReadS [Stack v a]
-> ReadPrec (Stack v a)
-> ReadPrec [Stack v a]
-> Read (Stack v a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (v :: * -> *) a. Read (v a) => ReadPrec [Stack v a]
forall (v :: * -> *) a. Read (v a) => ReadPrec (Stack v a)
forall (v :: * -> *) a. Read (v a) => Int -> ReadS (Stack v a)
forall (v :: * -> *) a. Read (v a) => ReadS [Stack v a]
readListPrec :: ReadPrec [Stack v a]
$creadListPrec :: forall (v :: * -> *) a. Read (v a) => ReadPrec [Stack v a]
readPrec :: ReadPrec (Stack v a)
$creadPrec :: forall (v :: * -> *) a. Read (v a) => ReadPrec (Stack v a)
readList :: ReadS [Stack v a]
$creadList :: forall (v :: * -> *) a. Read (v a) => ReadS [Stack v a]
readsPrec :: Int -> ReadS (Stack v a)
$creadsPrec :: forall (v :: * -> *) a. Read (v a) => Int -> ReadS (Stack v a)
Read, Int -> Stack v a -> ShowS
[Stack v a] -> ShowS
Stack v a -> [Char]
(Int -> Stack v a -> ShowS)
-> (Stack v a -> [Char])
-> ([Stack v a] -> ShowS)
-> Show (Stack v a)
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
forall (v :: * -> *) a. Show (v a) => Int -> Stack v a -> ShowS
forall (v :: * -> *) a. Show (v a) => [Stack v a] -> ShowS
forall (v :: * -> *) a. Show (v a) => Stack v a -> [Char]
showList :: [Stack v a] -> ShowS
$cshowList :: forall (v :: * -> *) a. Show (v a) => [Stack v a] -> ShowS
show :: Stack v a -> [Char]
$cshow :: forall (v :: * -> *) a. Show (v a) => Stack v a -> [Char]
showsPrec :: Int -> Stack v a -> ShowS
$cshowsPrec :: forall (v :: * -> *) a. Show (v a) => Int -> Stack v a -> ShowS
Show)

-- This (per se useless) top level splice separates the module into two
-- declaration groups. This is required, because the expression slices below
-- (which are now in the second declaration group) can only refer to definitions
-- outside their own declaration group. See
-- https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/template_haskell.html.
$(return [])

instance (FromJSON (v a)) => FromJSON (Stack v a) where
  parseJSON :: Value -> Parser (Stack v a)
parseJSON = $(mkParseJSON defaultOptions ''Stack)

instance (ToJSON (v a)) => ToJSON (Stack v a) where
  toJSON :: Stack v a -> Value
toJSON = $(mkToJSON defaultOptions ''Stack)
  toEncoding :: Stack v a -> Encoding
toEncoding = $(mkToEncoding defaultOptions ''Stack)

-- | Conversion from immutable to mutable circular stack.
--
-- O(n).
thaw :: (VG.Vector v a, PrimMonad m) => Stack v a -> m (MStack v (PrimState m) a)
thaw :: Stack v a -> m (MStack v (PrimState m) a)
thaw (Stack v a
v Int
i) = do
  Mutable v (PrimState m) a
mv <- v a -> m (Mutable v (PrimState m) a)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
v a -> m (Mutable v (PrimState m) a)
VG.thaw v a
v
  MStack v (PrimState m) a -> m (MStack v (PrimState m) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (MStack v (PrimState m) a -> m (MStack v (PrimState m) a))
-> MStack v (PrimState m) a -> m (MStack v (PrimState m) a)
forall a b. (a -> b) -> a -> b
$ Mutable v (PrimState m) a -> Int -> MStack v (PrimState m) a
forall (v :: * -> *) s a. Mutable v s a -> Int -> MStack v s a
MStack Mutable v (PrimState m) a
mv Int
i

-- | Conversion from mutable to immutable circular stack.
--
-- O(n).
freeze :: (VG.Vector v a, PrimMonad m) => MStack v (PrimState m) a -> m (Stack v a)
freeze :: MStack v (PrimState m) a -> m (Stack v a)
freeze (MStack Mutable v (PrimState m) a
mv Int
i) = do
  v a
v <- Mutable v (PrimState m) a -> m (v a)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
VG.freeze Mutable v (PrimState m) a
mv
  Stack v a -> m (Stack v a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Stack v a -> m (Stack v a)) -> Stack v a -> m (Stack v a)
forall a b. (a -> b) -> a -> b
$ v a -> Int -> Stack v a
forall (v :: * -> *) a. v a -> Int -> Stack v a
Stack v a
v Int
i