{-# 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, poke ) {-| 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 { queue :: Queue a, undo :: [a], undosz :: Int } deriving stock (Eq, Show) {-| Construct an empty queue. @since 1.5.0.0 -} empty :: RewindQueue a empty = RewindQueue Queue.empty [] 0 {-| Adds an element onto the end of the queue. @since 1.5.0.0 -} enqueue :: a -> RewindQueue a -> RewindQueue a enqueue x q = q { queue = Queue.enqueue x (queue 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 xs q = q { queue = Queue.enqueueAll xs (queue q) } {-| Removes an element from the front of the queue. @since 1.5.0.0 -} dequeue :: RewindQueue a -> (a, RewindQueue a) dequeue RewindQueue{..} = let (x, queue') = Queue.dequeue queue in (x, RewindQueue { queue = queue', undo = x : undo, undosz = undosz + 1 }) {-| modifies the head of the queue, without removal. Returns the old head @since 2.1.0.0 -} poke :: (a -> a) -> RewindQueue a -> (a, RewindQueue a) poke f q = let (x, queue') = Queue.poke f (queue q) in (x, q { queue = queue' }) {-| 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 n RewindQueue{..} | n <= undosz = let (rs, undo') = splitAt n undo in RewindQueue { queue = queue { outsz = outsz queue + length rs, outs = foldl' (flip (:)) (outs queue) rs }, undo = undo', undosz = undosz - n } | otherwise = error $ "Cannot rewind more than " ++ show undosz ++ " elements, but tried " ++ show n {-| Is the queue empty? @since 1.5.0.0 -} null :: RewindQueue a -> Bool null = Queue.null . queue {-| Returns how many elements are in the queue. @since 1.5.0.0 -} size :: RewindQueue a -> Int size = Queue.size . 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 f k = Queue.foldr f k . queue {-| Converts this queue into a list. Undo history is discarded. @since 1.5.0.0 -} toList :: RewindQueue a -> [a] toList = Queue.toList . queue