Fifo.hs

module Fifo (Fifo, push, shift, evalFifo) where

-- A simple corecursive queue monad

-- the queue of elements
-- * _front and _back refer to different points along the same list
-- * _front moves towards the end of the list (as elements are removed)
-- * _back moves towards the front of the list (as elements are included)
-- * _size is the number of elements after _front that are available at this
--   point in time
data Queue a = MkQueue { _front :: [a], _back :: [a], _size :: Int }

-- a modified state monad, for the queue
newtype Fifo a x = MkFifo { unFifo :: Queue a-> (x, Queue a) }

-- when we evaluate a fifo, we run the same list through twice
-- * once, starting as [], it runs the the computation *backwards*, 
--   building the queue of elements
-- * once that's done, we feed it back into the computation to be
--   run forwards, so its contents may be consumed by the computation
evalFifo :: Fifo a x -> x
evalFifo (MkFifo g) = x
  where (x, MkQueue _ b _) = g $ MkQueue b [] 0

instance Monad (Fifo a) where
  return x          = MkFifo $ \q -> (x,q)
  (MkFifo g) >>= h  = MkFifo $ \(MkQueue frontT backT sizeT) ->
    -- pass the _front list forwards and the _back list backwards
    let (x, MkQueue frontG backG sizeG) = g $ MkQueue frontT backH sizeT
        (y, MkQueue frontH backH sizeH) = h x `unFifo` MkQueue frontG backT sizeG
    in (y, MkQueue frontH backG sizeH)
    
-- put a new element in the fifo
push :: a -> Fifo a ()
push a = MkFifo $ \(MkQueue f b n) -> let n' = n+1 in ((), MkQueue f (a:b) n')

-- grab an element from the fifo (if there's one available now)
shift :: Fifo a (Maybe a)
shift = MkFifo $ \q -> case q of
  MkQueue _ _ 0     -> (Nothing, q)
  MkQueue (a:f) b n -> (Just a, MkQueue f b (n-1))