module Matterhorn.Types.NonemptyStack
  ( NonemptyStack
  , newStack
  , push
  , pop
  , top
  , stackToList
  )
where

import Prelude ()
import Matterhorn.Prelude

-- | A stack that always has at least one value on it.
data NonemptyStack a =
    NonemptyStack { forall a. NonemptyStack a -> a
bottom :: !a
                  -- ^ The value at the bottom that can never be
                  -- removed.
                  , forall a. NonemptyStack a -> [a]
rest :: ![a]
                  -- ^ The rest of the stack, topmost element first.
                  }
                  deriving (Int -> NonemptyStack a -> ShowS
forall a. Show a => Int -> NonemptyStack a -> ShowS
forall a. Show a => [NonemptyStack a] -> ShowS
forall a. Show a => NonemptyStack a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NonemptyStack a] -> ShowS
$cshowList :: forall a. Show a => [NonemptyStack a] -> ShowS
show :: NonemptyStack a -> String
$cshow :: forall a. Show a => NonemptyStack a -> String
showsPrec :: Int -> NonemptyStack a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> NonemptyStack a -> ShowS
Show)

-- | Make a new stack with the specified value at the bottom.
newStack :: a -> NonemptyStack a
newStack :: forall a. a -> NonemptyStack a
newStack a
v = NonemptyStack { bottom :: a
bottom = a
v
                           , rest :: [a]
rest = []
                           }


-- | Return the stack as a list, topmost element first.
stackToList :: NonemptyStack a -> [a]
stackToList :: forall a. NonemptyStack a -> [a]
stackToList (NonemptyStack a
b [a]
as) = [a]
as forall a. Semigroup a => a -> a -> a
<> [a
b]

-- | Pop the top value from the stack. If a value could be popped,
-- return the new stack and the value that was popped. Otherwise return
-- the stack unmodified with @Nothing@ to indicate that nothing was
-- popped.
pop :: NonemptyStack a -> (NonemptyStack a, Maybe a)
pop :: forall a. NonemptyStack a -> (NonemptyStack a, Maybe a)
pop s :: NonemptyStack a
s@(NonemptyStack a
_ []) = (NonemptyStack a
s, forall a. Maybe a
Nothing)
pop s :: NonemptyStack a
s@(NonemptyStack a
_ (a
a:[a]
as)) = (NonemptyStack a
s { rest :: [a]
rest = [a]
as }, forall a. a -> Maybe a
Just a
a)

-- | Push the specified value on to the stack.
push :: a -> NonemptyStack a -> NonemptyStack a
push :: forall a. a -> NonemptyStack a -> NonemptyStack a
push a
v NonemptyStack a
s = NonemptyStack a
s { rest :: [a]
rest = a
v forall a. a -> [a] -> [a]
: forall a. NonemptyStack a -> [a]
rest NonemptyStack a
s }

-- | Return the value on the top of the stack. Always succeeds since the
-- stack is guaranteed to be non-empty.
top :: NonemptyStack a -> a
top :: forall a. NonemptyStack a -> a
top (NonemptyStack a
_ (a
a:[a]
_)) = a
a
top (NonemptyStack a
bot []) = a
bot