A circular buffer, WIP, from the AOC cutting room floor

Circ.hs

{-# LANGUAGE DeriveFunctor #-}

module Circ (
    Circ
  , empty
  , singleton
  , length
  , null
  , delete
  , rotateR
  , rotateL
  , rotateNR
  , rotateNL
  , fromList
  , toList
) where

import Prelude hiding (length, null)
import qualified Prelude as P

data Circ a
  = Empty
  | Circ a [a] [a]
  deriving (Show, Eq, Ord, Functor)

{-# INLINE empty #-}
empty :: Circ a
empty = Empty

{-# INLINE singleton #-}
singleton :: a -> Circ a
singleton x = Circ x [] []

{-# INLINE length #-}
length :: Circ a -> Int
length Empty = 0
length (Circ _ ls rs) = 1 + P.length ls + P.length rs

{-# INLINE null #-}
null :: Circ a -> Bool
null Empty = True
null _ = False

-- focus moves to the right
{-# INLINE delete #-}
delete Empty = Empty
delete (Circ _ [] []) = Empty
delete (Circ x ls (r0:rs)) = Circ r0 ls rs
delete (Circ x ls []) = delete (Circ x [] (reverse ls))

rotateR :: Circ a -> Circ a
rotateR Empty = Empty
rotateR (Circ x [] []) = Circ x [] []
rotateR (Circ x ls (r0:rs)) = Circ r0 (x:ls) rs
rotateR (Circ x ls []) = rotateR (Circ x [] (reverse ls))

rotateL :: Circ a -> Circ a
rotateL Empty = Empty
rotateL (Circ x [] []) = Circ x [] []
rotateL (Circ x (l0:ls) rs) = Circ l0 ls (x:rs)
rotateL (Circ x [] rs) = rotateL (Circ x (reverse rs) [])

{-# INLINE rotateNR #-}
rotateNR :: Int -> Circ a -> Circ a
rotateNR n = (!! n) . iterate rotateR 

{-# INLINE rotateNL #-}
rotateNL :: Int -> Circ a -> Circ a
rotateNL n = (!! n) . iterate rotateL 

{-# INLINE fromList #-}
fromList :: [a] -> Circ a
fromList [] = Empty
fromList (x:xs) = Circ x [] xs

{-# INLINE toList #-}
toList :: Circ a -> [a]
toList (Circ x l r) = (x:r) <> reverse l