module Data.RollStack
(
RollStack
, isEmpty
, top
, Data.RollStack.empty
, Data.RollStack.singleton
, push
, pop
, roll
, Data.RollStack.fromList
, Data.RollStack.toList
) where
import Data.Foldable as Foldable
import Data.Maybe
import Data.Sequence as Seq
import Prelude hiding (foldl, foldr)
newtype RollStack a
= Stack (Seq a)
instance (Show a) => Show (RollStack a) where
show (Stack xs) = show xs
instance (Eq a) => Eq (RollStack a) where
(Stack xs) == (Stack ys) = xs == ys
instance (Ord a) => Ord (RollStack a) where
compare (Stack xs) (Stack ys) = compare xs ys
instance Functor RollStack where
fmap f (Stack xs) = Stack $ fmap f xs
instance Foldable RollStack where
fold (Stack xs) = fold xs
foldMap f (Stack xs) = foldMap f xs
foldr f z (Stack xs) = foldr f z xs
foldl f z (Stack xs) = foldl f z xs
isEmpty :: RollStack a -> Bool
isEmpty = isNothing . top
top :: RollStack a -> Maybe a
top stack = fst `fmap` pop stack
empty :: RollStack a
empty = Stack Seq.empty
singleton :: a -> RollStack a
singleton = Stack . Seq.singleton
push :: a -> RollStack a -> RollStack a
push x (Stack xs) = Stack (x <| xs)
pop :: RollStack a -> Maybe (a, RollStack a)
pop (Stack xs) = case viewl xs of
EmptyL -> fail "empty RollStack"
y :< ys -> return (y, Stack ys)
roll :: Int
-> Int
-> RollStack a
-> RollStack a
roll rolls depth unmodified@(Stack xs)
| depth < 0 = error $ "negative depth in Data.RollStack.roll: " ++ show depth
| rolls == 0 || depth == 0 = unmodified
| otherwise = let
(xs1, xs2) = Seq.splitAt depth xs
(xs1a, xs1b) = Seq.splitAt (rolls `mod` depth) xs1
in
Stack (xs1b >< xs1a >< xs2)
fromList :: [a] -> RollStack a
fromList = Stack . Seq.fromList
toList :: RollStack a -> [a]
toList (Stack xs) = Foldable.toList xs