module Math.Haskellator.Internal.Utils.Stack (
      Stack
    , isEmpty
    , mapTop
    , pop
    , push
    , top
    ) where

-- | A simple stack implementation
newtype Stack a = Stack [a]

instance Functor Stack where
    fmap :: forall a b. (a -> b) -> Stack a -> Stack b
fmap a -> b
f (Stack [a]
xs) = [b] -> Stack b
forall a. [a] -> Stack a
Stack ([b] -> Stack b) -> [b] -> Stack b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f [a]
xs

instance Applicative Stack where
    pure :: forall a. a -> Stack a
pure a
x = [a] -> Stack a
forall a. [a] -> Stack a
Stack [a
x]
    Stack [a -> b]
fs <*> :: forall a b. Stack (a -> b) -> Stack a -> Stack b
<*> Stack [a]
xs = [b] -> Stack b
forall a. [a] -> Stack a
Stack ([b] -> Stack b) -> [b] -> Stack b
forall a b. (a -> b) -> a -> b
$ [a -> b]
fs [a -> b] -> [a] -> [b]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [a]
xs

instance Semigroup (Stack a) where
    Stack [a]
xs <> :: Stack a -> Stack a -> Stack a
<> Stack [a]
ys = [a] -> Stack a
forall a. [a] -> Stack a
Stack ([a] -> Stack a) -> [a] -> Stack a
forall a b. (a -> b) -> a -> b
$ [a]
xs [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a]
ys

instance Monoid (Stack a) where
    mempty :: Stack a
mempty = [a] -> Stack a
forall a. [a] -> Stack a
Stack []

instance Foldable Stack where
    foldr :: forall a b. (a -> b -> b) -> b -> Stack a -> b
foldr a -> b -> b
f b
z (Stack [a]
xs) = (a -> b -> b) -> b -> [a] -> b
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
z [a]
xs

-- | Map a function over the top element of the stack
mapTop :: (a -> a) -- ^ The function to map
       -> Stack a  -- ^ The stack to map over
       -> Stack a  -- ^ The new stack, with the top element mapped
mapTop :: forall a. (a -> a) -> Stack a -> Stack a
mapTop a -> a
f (Stack (a
x:[a]
xs)) = [a] -> Stack a
forall a. [a] -> Stack a
Stack (a -> a
f a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)
mapTop a -> a
_ Stack a
s              = Stack a
s

-- | Push an element onto the stack
push :: a       -- ^ The element to push
     -> Stack a -- ^ The stack to push onto
     -> Stack a -- ^ The new stack, containing the element
push :: forall a. a -> Stack a -> Stack a
push a
x (Stack [a]
xs) = [a] -> Stack a
forall a. [a] -> Stack a
Stack (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)

-- | Pop an element from the stack. If the stack is empty, an error is thrown.
pop :: Stack a      -- ^ The stack to pop from
    -> (a, Stack a) -- ^ The popped element and the stack without the element
pop :: forall a. Stack a -> (a, Stack a)
pop (Stack (a
x:[a]
xs)) = (a
x, [a] -> Stack a
forall a. [a] -> Stack a
Stack [a]
xs)
pop Stack a
_              = [Char] -> (a, Stack a)
forall a. HasCallStack => [Char] -> a
error [Char]
"empty stack"

-- | Get the top element of the stack. If the stack is empty, an error is thrown.
top :: Stack a -- ^ The stack to get the top element from
    -> a       -- ^ The top element
top :: forall a. Stack a -> a
top (Stack (a
x:[a]
_)) = a
x
top Stack a
_             = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"empty stack"

-- | Check if the stack is empty
isEmpty :: Stack a -- ^ The stack to check
        -> Bool    -- ^ 'True' if the stack is empty, 'False' otherwise
isEmpty :: forall a. Stack a -> Bool
isEmpty (Stack []) = Bool
True
isEmpty Stack a
_          = Bool
False