packages feed

diohsc-0.1.1: BStack.hs

-- This file is part of Diohsc
-- Copyright (C) 2020 Martin Bays <mbays@sdf.org>
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of version 3 of the GNU General Public License as
-- published by the Free Software Foundation, or any later version.
--
-- You should have received a copy of the GNU General Public License
-- along with this program.  If not, see http://www.gnu.org/licenses/.

-- |Simple dirty bounded stack based on Data.Sequence
module BStack where

import Prelude hiding (truncate)
import Data.Sequence (Seq(..)) -- , (:<|), (:|>))
import qualified Data.Sequence as S
import qualified Data.Foldable as F

data BStack a = BStack (Seq a) Int

fromList :: [a] -> BStack a
fromList as = BStack (S.fromList as) $ length as

empty :: BStack a
empty = BStack Empty 0

toList :: BStack a -> [a]
toList (BStack as _) = F.toList as

push :: Int -> a -> BStack a -> BStack a
push l a s@(BStack as n)
    | l <= 0 = empty
    | n < l = BStack (a :<| as) $ n + 1
    | n > l = push l a $ truncate l s
    | Empty <- as = BStack (S.singleton a) 1
    | (as' :|> _) <- as = BStack (a :<| as') n

truncate :: Int -> BStack a -> BStack a
truncate l s@(BStack as n)
    | l >= n = s
    | otherwise = BStack (S.take l as) l