-- | a simple heteregenous stack library
{-# LANGUAGE TypeOperators #-}
module Text.Boomerang.HStack
    ( (:-)(..)
    , arg, hdTraverse, hdMap, hhead, htail, pop
    ) where

infixr 8 :-
-- | A stack datatype. Just a better looking tuple.
data a :- b = a :- b deriving ((a :- b) -> (a :- b) -> Bool
((a :- b) -> (a :- b) -> Bool)
-> ((a :- b) -> (a :- b) -> Bool) -> Eq (a :- b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => (a :- b) -> (a :- b) -> Bool
/= :: (a :- b) -> (a :- b) -> Bool
$c/= :: forall a b. (Eq a, Eq b) => (a :- b) -> (a :- b) -> Bool
== :: (a :- b) -> (a :- b) -> Bool
$c== :: forall a b. (Eq a, Eq b) => (a :- b) -> (a :- b) -> Bool
Eq, Int -> (a :- b) -> ShowS
[a :- b] -> ShowS
(a :- b) -> String
(Int -> (a :- b) -> ShowS)
-> ((a :- b) -> String) -> ([a :- b] -> ShowS) -> Show (a :- b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> (a :- b) -> ShowS
forall a b. (Show a, Show b) => [a :- b] -> ShowS
forall a b. (Show a, Show b) => (a :- b) -> String
showList :: [a :- b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [a :- b] -> ShowS
show :: (a :- b) -> String
$cshow :: forall a b. (Show a, Show b) => (a :- b) -> String
showsPrec :: Int -> (a :- b) -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> (a :- b) -> ShowS
Show)

-- | Stack destructor.
pop :: (a -> b -> r) -> (a :- b) -> r
pop :: (a -> b -> r) -> (a :- b) -> r
pop a -> b -> r
f (a
a :- b
b) = a -> b -> r
f a
a b
b

-- | Get the top of the stack.
hhead :: (a :- b) -> a
hhead :: (a :- b) -> a
hhead (a
a :- b
_) = a
a

-- | Get the stack with the top popped.
htail :: (a :- b) -> b
htail :: (a :- b) -> b
htail (a
_ :- b
b) = b
b

-- | Applicative traversal over the top of the stack.
hdTraverse :: Functor f => (a -> f b) -> a :- t -> f (b :- t)
hdTraverse :: (a -> f b) -> (a :- t) -> f (b :- t)
hdTraverse a -> f b
f (a
a :- t
t) = (b -> b :- t) -> f b -> f (b :- t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b -> t -> b :- t
forall a b. a -> b -> a :- b
:- t
t) (a -> f b
f a
a)

arg :: (ty -> r -> s) -> (a -> ty) -> (a :- r) -> s
arg :: (ty -> r -> s) -> (a -> ty) -> (a :- r) -> s
arg ty -> r -> s
c a -> ty
f = (a -> r -> s) -> (a :- r) -> s
forall a b r. (a -> b -> r) -> (a :- b) -> r
pop (ty -> r -> s
c (ty -> r -> s) -> (a -> ty) -> a -> r -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ty
f)

-- | Map over the top of the stack.
hdMap :: (a1 -> a2) -> (a1 :- b) -> (a2 :- b)
hdMap :: (a1 -> a2) -> (a1 :- b) -> a2 :- b
hdMap = (a2 -> b -> a2 :- b) -> (a1 -> a2) -> (a1 :- b) -> a2 :- b
forall ty r s a. (ty -> r -> s) -> (a -> ty) -> (a :- r) -> s
arg a2 -> b -> a2 :- b
forall a b. a -> b -> a :- b
(:-)