{-# LANGUAGE GeneralizedNewtypeDeriving, TypeOperators #-} -- Module : Data.PVar.Queue -- Copyright : (c) Jake McArthur 2009 -- License : ISC -- -- Maintainer : Jake.McArthur@gmail.com -- Stability : experimental -- Portability : portable {-| A procrastinating queue. You can populate the back of the queue in IO and read the front of the queue in pure code. The front of an empty, un'close'd queue is @_|_@. I think it fits the definition of referentially transparent, but it's still an abomination. It's possible to do some really stupid things with one of these 'Queue's. If you read the source, this serves as an example of using "Data.PVar.Structure". Here's a simple example of using a 'Queue': > import Prelude hiding (sum) > import Data.Foldable (sum) > > main :: IO () > main = do > (back, front) <- newQueue -- Create a new queue. > mapM_ (push back) [0..9] -- Push some values to the back of the queue. > print $ peek front -- Safe to do since we know something has been written > close back -- Close the queue. > print $ sum front -- Safe to do since the queue is finalized The output of the above program is: > Just 0 > 45 Is this useful? Who knows? It was a fun exercise. -} module Data.PVar.Queue (Queue (), QueueBack (), newQueue, push, close, pop, peek) where import Control.Applicative import Control.Monad import Control.Concurrent.MVar import Data.Foldable import Data.Maybe import Data.Monoid import Data.Traversable import Data.PVar.Structure infixr 9 :$ type a :$ b = a b -- | A pure queue. newtype Queue a = QF [a] deriving ( Functor , Applicative , Monad , MonadPlus , Alternative , Foldable , Traversable , Eq , Ord , Monoid) -- | The impure back of a pure queue. newtype QueueBack a = QB (MVar :$ Maybe :$ PStructure [Value a]) deriving Eq -- | Create both ends of a procrastinating queue. newQueue :: IO (QueueBack a, Queue a) newQueue = do (pvs, vs) <- newStruc qb <- newMVar $ Just pvs return (QB qb, QF $ map getValue vs) -- | Push to the back of an open 'QueueBack'. If the 'QueueBack' has -- been closed, returns 'False'. push :: QueueBack a -> a -> IO Bool push (QB mpvsRef) x = modifyMVar mpvsRef writeVal where writeVal Nothing = return (Nothing, False) writeVal (Just pvs) = do Just (ph, pt) <- writeStruc pvs ConsC writeStruc ph x return (Just pt, True) -- | Close a 'QueueBack'. This finalizes the 'Queue' and means that it -- is safe to evaluate all the way to the end. close :: QueueBack a -> IO () close (QB mpvsRef) = modifyMVar_ mpvsRef writeVal where writeVal Nothing = return Nothing writeVal (Just pvs) = do writeStruc pvs NilC return Nothing -- | Get the value at the front of a 'Queue'. Returns 'False' if we -- are at the end of a 'close'd 'Queue'. peek :: Queue a -> Maybe a peek = listToMaybe . toList -- | Get the value at the front of a 'Queue' and return the remainder -- of the 'Queue'. Returns 'False' if we are at the end of a -- 'close'd 'Queue'. pop :: Queue a -> Maybe (Queue a, a) pop (QF []) = Nothing pop (QF (x:xs)) = Just (QF xs, x)