ring-buffer.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}

import Data.Bits (toIntegralSized)
import Data.Function ((&))
import Data.Kind (Type)
import Data.Monoid (Sum (..))
import Data.Proxy (Proxy (..))
import Data.Sequence (Seq (..))
import Data.Sequence qualified as Seq
import GHC.TypeLits (KnownNat, Natural, natVal)
import Prelude hiding (length)

-- Actually this would be better with an array and modular arithmetic lol

type Ring :: Natural -> Type -> Type
newtype Ring n a = Ring (Seq a)
  deriving stock (Show)
  deriving newtype (Foldable)

empty :: forall n a. KnownNat n => Ring n a
empty = Ring Seq.empty

length :: forall n a. KnownNat n => Ring n a -> Int
length (Ring seq) = Seq.length seq

capacity :: forall n a. KnownNat n => Ring n a -> Int
capacity _ =
  case toIntegralSized (natVal (Proxy @n)) of
    Nothing -> error "too big"
    Just n -> n

push :: forall n a. KnownNat n => a -> Ring n a -> Ring n a
push x xs =
  if length xs < capacity xs
    then let Ring seq = xs in Ring (seq :|> x)
    else let Ring (_ :<| seq) = xs in Ring (seq :|> x)

main :: IO ()
main = do
  let ring =
          empty @3
        & push 1
        & push 2
        & push 3
        & push 4
  print ring -- Ring (fromList [2,3,4])
  print $ foldMap Sum ring -- Sum {getSum = 9}