{-# LANGUAGE DerivingStrategies, RecordWildCards #-}
{-|
Module      : Parsley.Internal.Common.Queue.Impl
Description : Implementation of a queue which can be rewound.
License     : BSD-3-Clause
Maintainer  : Jamie Willis
Stability   : experimental

Implementation of a FIFO queue structure, with amortized operations that also supports a rewinding
operation backed by a LIFO stack.

@since 1.5.0.0
-}
module Parsley.Internal.Common.RewindQueue.Impl (module Parsley.Internal.Common.RewindQueue.Impl) where

import Prelude hiding (null, foldr)
import Data.List (foldl')
import Parsley.Internal.Common.Queue.Impl as Queue (Queue(..), toList)

import qualified Parsley.Internal.Common.Queue.Impl as Queue (
    empty, enqueue, enqueueAll, dequeue, null, size, foldr
  )

{-|
Concrete FIFO Queue, with amortized constant operations.

Also keeps history of dequeued values, which can be undone
in a LIFO manner.

@since 1.5.0.0
-}
data RewindQueue a = RewindQueue {
    RewindQueue a -> Queue a
queue :: Queue a,
    RewindQueue a -> [a]
undo :: [a],
    RewindQueue a -> Int
undosz :: Int
  } deriving stock (RewindQueue a -> RewindQueue a -> Bool
(RewindQueue a -> RewindQueue a -> Bool)
-> (RewindQueue a -> RewindQueue a -> Bool) -> Eq (RewindQueue a)
forall a. Eq a => RewindQueue a -> RewindQueue a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RewindQueue a -> RewindQueue a -> Bool
$c/= :: forall a. Eq a => RewindQueue a -> RewindQueue a -> Bool
== :: RewindQueue a -> RewindQueue a -> Bool
$c== :: forall a. Eq a => RewindQueue a -> RewindQueue a -> Bool
Eq, Int -> RewindQueue a -> ShowS
[RewindQueue a] -> ShowS
RewindQueue a -> String
(Int -> RewindQueue a -> ShowS)
-> (RewindQueue a -> String)
-> ([RewindQueue a] -> ShowS)
-> Show (RewindQueue a)
forall a. Show a => Int -> RewindQueue a -> ShowS
forall a. Show a => [RewindQueue a] -> ShowS
forall a. Show a => RewindQueue a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RewindQueue a] -> ShowS
$cshowList :: forall a. Show a => [RewindQueue a] -> ShowS
show :: RewindQueue a -> String
$cshow :: forall a. Show a => RewindQueue a -> String
showsPrec :: Int -> RewindQueue a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> RewindQueue a -> ShowS
Show)

{-|
Construct an empty queue.

@since 1.5.0.0
-}
empty :: RewindQueue a
empty :: RewindQueue a
empty = Queue a -> [a] -> Int -> RewindQueue a
forall a. Queue a -> [a] -> Int -> RewindQueue a
RewindQueue Queue a
forall a. Queue a
Queue.empty [] Int
0

{-|
Adds an element onto the end of the queue.

@since 1.5.0.0
-}
enqueue :: a -> RewindQueue a -> RewindQueue a
enqueue :: a -> RewindQueue a -> RewindQueue a
enqueue a
x RewindQueue a
q = RewindQueue a
q { queue :: Queue a
queue = a -> Queue a -> Queue a
forall a. a -> Queue a -> Queue a
Queue.enqueue a
x (RewindQueue a -> Queue a
forall a. RewindQueue a -> Queue a
queue RewindQueue a
q) }

{-|
Adds each of the elements onto the queue, from left-to-right.

@since 1.5.0.0
-}
enqueueAll :: [a] -> RewindQueue a -> RewindQueue a
enqueueAll :: [a] -> RewindQueue a -> RewindQueue a
enqueueAll [a]
xs RewindQueue a
q = RewindQueue a
q { queue :: Queue a
queue = [a] -> Queue a -> Queue a
forall a. [a] -> Queue a -> Queue a
Queue.enqueueAll [a]
xs (RewindQueue a -> Queue a
forall a. RewindQueue a -> Queue a
queue RewindQueue a
q) }

{-|
Removes an element from the front of the queue.

@since 1.5.0.0
-}
dequeue :: RewindQueue a -> (a, RewindQueue a)
dequeue :: RewindQueue a -> (a, RewindQueue a)
dequeue RewindQueue{Int
[a]
Queue a
undosz :: Int
undo :: [a]
queue :: Queue a
undosz :: forall a. RewindQueue a -> Int
undo :: forall a. RewindQueue a -> [a]
queue :: forall a. RewindQueue a -> Queue a
..} =
  let (a
x, Queue a
queue') = Queue a -> (a, Queue a)
forall a. Queue a -> (a, Queue a)
Queue.dequeue Queue a
queue
  in (a
x, RewindQueue :: forall a. Queue a -> [a] -> Int -> RewindQueue a
RewindQueue { queue :: Queue a
queue = Queue a
queue', undo :: [a]
undo = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
undo, undosz :: Int
undosz = Int
undosz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 })

{-|
Undoes the last \(n\) `dequeue` operations but /only/ if there are that many
available undos. Otherwise, it will throw an error.

@since 1.5.0.0
-}
rewind :: Int -> RewindQueue a -> RewindQueue a
rewind :: Int -> RewindQueue a -> RewindQueue a
rewind Int
n RewindQueue{Int
[a]
Queue a
undosz :: Int
undo :: [a]
queue :: Queue a
undosz :: forall a. RewindQueue a -> Int
undo :: forall a. RewindQueue a -> [a]
queue :: forall a. RewindQueue a -> Queue a
..}
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
undosz = let ([a]
rs, [a]
undo') = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [a]
undo
                  in RewindQueue :: forall a. Queue a -> [a] -> Int -> RewindQueue a
RewindQueue { queue :: Queue a
queue = Queue a
queue { outsz :: Int
outsz = Queue a -> Int
forall a. Queue a -> Int
outsz Queue a
queue Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [a]
rs,
                                                   outs :: [a]
outs = ([a] -> a -> [a]) -> [a] -> [a] -> [a]
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((a -> [a] -> [a]) -> [a] -> a -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) (Queue a -> [a]
forall a. Queue a -> [a]
outs Queue a
queue) [a]
rs },
                                   undo :: [a]
undo = [a]
undo',
                                   undosz :: Int
undosz = Int
undosz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n }
  | Bool
otherwise   = String -> RewindQueue a
forall a. HasCallStack => String -> a
error (String -> RewindQueue a) -> String -> RewindQueue a
forall a b. (a -> b) -> a -> b
$ String
"Cannot rewind more than " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
undosz String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" elements, but tried " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n

{-|
Is the queue empty?

@since 1.5.0.0
-}
null :: RewindQueue a -> Bool
null :: RewindQueue a -> Bool
null = Queue a -> Bool
forall a. Queue a -> Bool
Queue.null (Queue a -> Bool)
-> (RewindQueue a -> Queue a) -> RewindQueue a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RewindQueue a -> Queue a
forall a. RewindQueue a -> Queue a
queue

{-|
Returns how many elements are in the queue.

@since 1.5.0.0
-}
size :: RewindQueue a -> Int
size :: RewindQueue a -> Int
size = Queue a -> Int
forall a. Queue a -> Int
Queue.size (Queue a -> Int)
-> (RewindQueue a -> Queue a) -> RewindQueue a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RewindQueue a -> Queue a
forall a. RewindQueue a -> Queue a
queue

{-|
Folds the values in the queue. Undo history is not included.

@since 1.5.0.0
-}
foldr :: (a -> b -> b) -> b -> RewindQueue a -> b
foldr :: (a -> b -> b) -> b -> RewindQueue a -> b
foldr a -> b -> b
f b
k = (a -> b -> b) -> b -> Queue a -> b
forall a b. (a -> b -> b) -> b -> Queue a -> b
Queue.foldr a -> b -> b
f b
k (Queue a -> b) -> (RewindQueue a -> Queue a) -> RewindQueue a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RewindQueue a -> Queue a
forall a. RewindQueue a -> Queue a
queue

{-|
Converts this queue into a list. Undo history is discarded.

@since 1.5.0.0
-}
toList :: RewindQueue a -> [a]
toList :: RewindQueue a -> [a]
toList = Queue a -> [a]
forall a. Queue a -> [a]
Queue.toList (Queue a -> [a])
-> (RewindQueue a -> Queue a) -> RewindQueue a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RewindQueue a -> Queue a
forall a. RewindQueue a -> Queue a
queue