module SimpleParser.Stack
  ( Stack (..)
  , emptyStack
  , pushStack
  , topStack
  , bottomStack
  ) where

import Data.Sequence (Seq (..))

-- | A stack supporting O(1) push, top, and bottom.
-- Behind the newtype, a "push" onto the stack is implemented as "snoc", therefore
-- fold/traverse goes from bottom of stack (most generic label) to top (most specific label).
newtype Stack a = Stack
  { Stack a -> Seq a
unStack :: Seq a
  } deriving (Stack a -> Stack a -> Bool
(Stack a -> Stack a -> Bool)
-> (Stack a -> Stack a -> Bool) -> Eq (Stack a)
forall a. Eq a => Stack a -> Stack a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Stack a -> Stack a -> Bool
$c/= :: forall a. Eq a => Stack a -> Stack a -> Bool
== :: Stack a -> Stack a -> Bool
$c== :: forall a. Eq a => Stack a -> Stack a -> Bool
Eq, Int -> Stack a -> ShowS
[Stack a] -> ShowS
Stack a -> String
(Int -> Stack a -> ShowS)
-> (Stack a -> String) -> ([Stack a] -> ShowS) -> Show (Stack a)
forall a. Show a => Int -> Stack a -> ShowS
forall a. Show a => [Stack a] -> ShowS
forall a. Show a => Stack a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Stack a] -> ShowS
$cshowList :: forall a. Show a => [Stack a] -> ShowS
show :: Stack a -> String
$cshow :: forall a. Show a => Stack a -> String
showsPrec :: Int -> Stack a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Stack a -> ShowS
Show, a -> Stack b -> Stack a
(a -> b) -> Stack a -> Stack b
(forall a b. (a -> b) -> Stack a -> Stack b)
-> (forall a b. a -> Stack b -> Stack a) -> Functor Stack
forall a b. a -> Stack b -> Stack a
forall a b. (a -> b) -> Stack a -> Stack b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Stack b -> Stack a
$c<$ :: forall a b. a -> Stack b -> Stack a
fmap :: (a -> b) -> Stack a -> Stack b
$cfmap :: forall a b. (a -> b) -> Stack a -> Stack b
Functor, a -> Stack a -> Bool
Stack m -> m
Stack a -> [a]
Stack a -> Bool
Stack a -> Int
Stack a -> a
Stack a -> a
Stack a -> a
Stack a -> a
(a -> m) -> Stack a -> m
(a -> m) -> Stack a -> m
(a -> b -> b) -> b -> Stack a -> b
(a -> b -> b) -> b -> Stack a -> b
(b -> a -> b) -> b -> Stack a -> b
(b -> a -> b) -> b -> Stack a -> b
(a -> a -> a) -> Stack a -> a
(a -> a -> a) -> Stack a -> a
(forall m. Monoid m => Stack m -> m)
-> (forall m a. Monoid m => (a -> m) -> Stack a -> m)
-> (forall m a. Monoid m => (a -> m) -> Stack a -> m)
-> (forall a b. (a -> b -> b) -> b -> Stack a -> b)
-> (forall a b. (a -> b -> b) -> b -> Stack a -> b)
-> (forall b a. (b -> a -> b) -> b -> Stack a -> b)
-> (forall b a. (b -> a -> b) -> b -> Stack a -> b)
-> (forall a. (a -> a -> a) -> Stack a -> a)
-> (forall a. (a -> a -> a) -> Stack a -> a)
-> (forall a. Stack a -> [a])
-> (forall a. Stack a -> Bool)
-> (forall a. Stack a -> Int)
-> (forall a. Eq a => a -> Stack a -> Bool)
-> (forall a. Ord a => Stack a -> a)
-> (forall a. Ord a => Stack a -> a)
-> (forall a. Num a => Stack a -> a)
-> (forall a. Num a => Stack a -> a)
-> Foldable Stack
forall a. Eq a => a -> Stack a -> Bool
forall a. Num a => Stack a -> a
forall a. Ord a => Stack a -> a
forall m. Monoid m => Stack m -> m
forall a. Stack a -> Bool
forall a. Stack a -> Int
forall a. Stack a -> [a]
forall a. (a -> a -> a) -> Stack a -> a
forall m a. Monoid m => (a -> m) -> Stack a -> m
forall b a. (b -> a -> b) -> b -> Stack a -> b
forall a b. (a -> b -> b) -> b -> Stack a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Stack a -> a
$cproduct :: forall a. Num a => Stack a -> a
sum :: Stack a -> a
$csum :: forall a. Num a => Stack a -> a
minimum :: Stack a -> a
$cminimum :: forall a. Ord a => Stack a -> a
maximum :: Stack a -> a
$cmaximum :: forall a. Ord a => Stack a -> a
elem :: a -> Stack a -> Bool
$celem :: forall a. Eq a => a -> Stack a -> Bool
length :: Stack a -> Int
$clength :: forall a. Stack a -> Int
null :: Stack a -> Bool
$cnull :: forall a. Stack a -> Bool
toList :: Stack a -> [a]
$ctoList :: forall a. Stack a -> [a]
foldl1 :: (a -> a -> a) -> Stack a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Stack a -> a
foldr1 :: (a -> a -> a) -> Stack a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Stack a -> a
foldl' :: (b -> a -> b) -> b -> Stack a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Stack a -> b
foldl :: (b -> a -> b) -> b -> Stack a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Stack a -> b
foldr' :: (a -> b -> b) -> b -> Stack a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Stack a -> b
foldr :: (a -> b -> b) -> b -> Stack a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Stack a -> b
foldMap' :: (a -> m) -> Stack a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Stack a -> m
foldMap :: (a -> m) -> Stack a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Stack a -> m
fold :: Stack m -> m
$cfold :: forall m. Monoid m => Stack m -> m
Foldable, Functor Stack
Foldable Stack
Functor Stack
-> Foldable Stack
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Stack a -> f (Stack b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Stack (f a) -> f (Stack a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Stack a -> m (Stack b))
-> (forall (m :: * -> *) a. Monad m => Stack (m a) -> m (Stack a))
-> Traversable Stack
(a -> f b) -> Stack a -> f (Stack b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Stack (m a) -> m (Stack a)
forall (f :: * -> *) a. Applicative f => Stack (f a) -> f (Stack a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Stack a -> m (Stack b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Stack a -> f (Stack b)
sequence :: Stack (m a) -> m (Stack a)
$csequence :: forall (m :: * -> *) a. Monad m => Stack (m a) -> m (Stack a)
mapM :: (a -> m b) -> Stack a -> m (Stack b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Stack a -> m (Stack b)
sequenceA :: Stack (f a) -> f (Stack a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Stack (f a) -> f (Stack a)
traverse :: (a -> f b) -> Stack a -> f (Stack b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Stack a -> f (Stack b)
$cp2Traversable :: Foldable Stack
$cp1Traversable :: Functor Stack
Traversable)

-- | Easy constructor for the empty stack
emptyStack :: Stack a
emptyStack :: Stack a
emptyStack = Seq a -> Stack a
forall a. Seq a -> Stack a
Stack Seq a
forall a. Seq a
Empty

-- | Pushes a an element onto a 'Stack'
pushStack :: a -> Stack a -> Stack a
pushStack :: a -> Stack a -> Stack a
pushStack a
a = Seq a -> Stack a
forall a. Seq a -> Stack a
Stack (Seq a -> Stack a) -> (Stack a -> Seq a) -> Stack a -> Stack a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
:|> a
a) (Seq a -> Seq a) -> (Stack a -> Seq a) -> Stack a -> Seq a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack a -> Seq a
forall a. Stack a -> Seq a
unStack

-- | Returns the top element of the stack (most recently pushed).
topStack :: Stack a -> Maybe a
topStack :: Stack a -> Maybe a
topStack (Stack Seq a
s) =
  case Seq a
s of
    Seq a
Empty -> Maybe a
forall a. Maybe a
Nothing
    Seq a
_ :|> a
a -> a -> Maybe a
forall a. a -> Maybe a
Just a
a

-- | Returns the bottom element of the stack (least recently pushed).
bottomStack :: Stack a -> Maybe a
bottomStack :: Stack a -> Maybe a
bottomStack (Stack Seq a
s) =
  case Seq a
s of
    Seq a
Empty -> Maybe a
forall a. Maybe a
Nothing
    a
a :<| Seq a
_ -> a -> Maybe a
forall a. a -> Maybe a
Just a
a