BStack.hs

   1 -- This file is part of Diohsc
   2 -- Copyright (C) 2020 Martin Bays <mbays@sdf.org>
   3 --
   4 -- This program is free software: you can redistribute it and/or modify
   5 -- it under the terms of version 3 of the GNU General Public License as
   6 -- published by the Free Software Foundation, or any later version.
   7 --
   8 -- You should have received a copy of the GNU General Public License
   9 -- along with this program.  If not, see http://www.gnu.org/licenses/.
  10
  11 -- |Simple dirty bounded stack based on Data.Sequence
  12
  13 {-# LANGUAGE Safe #-}
  14
  15 module BStack where
  16
  17 import qualified Data.Foldable as F
  18 import           Data.Sequence (Seq (..))
  19 import qualified Data.Sequence as S
  20 import           Prelude       hiding (truncate)
  21
  22 data BStack a = BStack (Seq a) Int
  23
  24 fromList :: [a] -> BStack a
  25 fromList as = BStack (S.fromList as) $ length as
  26
  27 empty :: BStack a
  28 empty = BStack Empty 0
  29
  30 toList :: BStack a -> [a]
  31 toList (BStack as _) = F.toList as
  32
  33 push :: Int -> a -> BStack a -> BStack a
  34 push l a s@(BStack as n)
  35     | l <= 0 = empty
  36     | n < l = BStack (a :<| as) $ n + 1
  37     | n > l = push l a $ truncate l s
  38     | Empty <- as = BStack (S.singleton a) 1
  39     | (as' :|> _) <- as = BStack (a :<| as') n
  40
  41 truncate :: Int -> BStack a -> BStack a
  42 truncate l s@(BStack as n)
  43     | l >= n = s
  44     | otherwise = BStack (S.take l as) l