queue (empty) → 0.1.1.2

raw patch · 7 files changed

+288/−0 lines, 7 filesdep +basedep +stmsetup-changed

Dependencies added: base, stm

Files

• LICENSE +28/−0
• Setup.lhs +5/−0
• queue.cabal +39/−0
• src/Data/Queue.hs +44/−0
• src/Data/Queue/Classes.hs +60/−0
• src/Data/Queue/Instances.hs +42/−0
• src/Data/Queue/Instances/STM.hs +70/−0

@@ -0,0 +1,28 @@+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,5 @@+#!/usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain+

@@ -0,0 +1,39 @@+name:                   queue+version:                0.1.1.2+stability:              provisional+license:                BSD3+license-file:           LICENSE++cabal-version:          >= 1.2+build-type:             Simple++author:                 James Cook <mokus@deepbondi.net>+maintainer:             James Cook <mokus@deepbondi.net>+homepage:               http://darcs.deepbondi.net/queue++category:               Data+synopsis:               Abstraction typeclasses for queue-like things.+description:            A collection of abstract interfaces to mutable+                        queue-like things.+                        +                        Note that I named this module before I realized that+                        there was a module of the same name in (base<3).  I+                        am open to suggestions for a new name.++Flag useSTM+  Description:          Include instances for STM types+  Default:              True++Library+  hs-source-dirs:       src+  exposed-modules:      Data.Queue+                        Data.Queue.Classes+                        Data.Queue.Instances+  build-depends:        base+  +  extensions:           CPP+  +  if flag(useSTM)+    build-depends:      stm+    other-modules:      Data.Queue.Instances.STM+    cpp-options:        -DuseSTM

@@ -0,0 +1,44 @@+{-+ -      ``Data/Queue.hs''+ -      (c) 2008 Cook, J. MR  SSD, Inc.+ -+ -}+{-# LANGUAGE +        MultiParamTypeClasses,+        FlexibleInstances,+        UndecidableInstances+  #-}++module Data.Queue+        ( NewFifo (..)+        , DefaultFifo+        +        , Enqueue (..)+        , Dequeue (..)+        , DequeueWhere (..)+        , PeekQueue (..)+        , QueueSize (..)+        +        , module Data.Queue.Instances+        +        , RQueue, mkRQueue+        , WQueue, mkWQueue+        +        ) where++import Data.Queue.Classes+import Data.Queue.Instances++-- |'RQueue' : read-only newtype wrapper for arbitrary queues+newtype RQueue q = RQ q+mkRQueue :: q -> RQueue q+mkRQueue = RQ+instance Dequeue q m a => Dequeue (RQueue q) m a where+        dequeue (RQ q) = dequeue q++-- |'WQueue' : write-only newtype wrapper for arbitrary queues+newtype WQueue q = WQ q+mkWQueue :: q -> WQueue q+mkWQueue = WQ+instance Enqueue q m a => Enqueue (WQueue q) m a where+        enqueue (WQ q) = enqueue q

@@ -0,0 +1,60 @@+{-+ -      ``Data/Queue/Classes''+ -      (c) 2008 Cook, J. MR  SSD, Inc.+ -}+{-# LANGUAGE+        MultiParamTypeClasses,+        FunctionalDependencies+  #-}++module Data.Queue.Classes where++-- |Construct a new FIFO queue.  I don't know whether or not I really want+--  the 'a' parameter.  It might go away sometime, so beware ;-).+class Monad m => NewFifo q m where+        newFifo :: m q++-- |A type class carrying an altered set of functional dependencies used to+--  constrain queues when the type of the queue never escapes far enough for+--  a more deliberate choice to be made.+class Monad m => DefaultFifo q m a | q -> a, m a -> q++-- |Construct a new FIFO of a type suitable for carrying the supplied thing.+--  Does not actually do anything with the thing supplied.+newDefaultFifoFor :: (DefaultFifo q m a, NewFifo q m) => a -> m q+newDefaultFifoFor _thing = newFifo++class Monad m => Enqueue q m a | q -> a where+        -- |Put an item into a queue.  May block while trying to do so.+        --  No constraint is placed on the behavior of the queue except that+        --  every item put in "really ought to" come out sometime before+        --  'dequeue' returns a 'Nothing'.+        enqueue :: q -> a -> m ()+class Monad m => Dequeue q m a | q -> a where+        -- |Pull an item out of a queue.  Should not block.  No ordering+        --  constraints are implied other than that any item that went into+        --  the queue "really ought to" come out before 'dequeue' returns+        --  'Nothing'.+        dequeue :: q -> m (Maybe a)++class Monad m => DequeueWhere q m a | q -> a where+        -- |Pull an item matching the given predicate out of a queue.+        dequeueWhere :: q -> (a -> Bool) -> m (Maybe a)++class Monad m => PeekQueue q m a | q -> a where+        -- |return the whole contents of the queue (if possible) without +        --  altering the queue's contents.  Obviously in cases where this+        --  can't be done lazily this can be a very expensive operation.+        peekQueue :: q -> m [a]+        +        -- |peek a specified number of items off the queue.  The default+        --  implementation is hideously wasteful in cases where peekQueue is+        --  not able to get the contents lazily.+        peekQueueTaking :: Int -> q -> m [a]+        peekQueueTaking n q = do+            xs <- peekQueue q+            return (take n xs)++class Monad m => QueueSize q m where+        -- |return the number of elements in the queue+        queueSize :: q -> m Int

@@ -0,0 +1,42 @@+{-+ -      ``Data/Queue/Instances''+ -      (c) 2008 Cook, J. MR  SSD, Inc.+ -}+{-# LANGUAGE+        MultiParamTypeClasses,+        FlexibleInstances,+        CPP+  #-}++module Data.Queue.Instances+        ( Chan+        , MVar+        +#ifdef useSTM+        , module Data.Queue.Instances.STM+#endif+        +        ) where++import Data.Queue.Classes++#ifdef useSTM+import Data.Queue.Instances.STM+#endif++import Control.Concurrent++-- Chan : write only, because there's no atomic nonblocking read (that I know of)+instance NewFifo (Chan a) IO where+        newFifo = newChan+instance Enqueue (Chan a) IO a where+        enqueue = writeChan++-- MVar : one-item queue in IO monad+instance NewFifo (MVar a) IO where+        newFifo = newEmptyMVar+instance Enqueue (MVar a) IO a where+        enqueue = putMVar+instance Dequeue (MVar a) IO a where+        dequeue = tryTakeMVar+

@@ -0,0 +1,70 @@+{-+ -      ``Data/Queue/Instances/STM''+ -      (c) 2008 Cook, J. MR  SSD, Inc.+ -}+{-# LANGUAGE+        MultiParamTypeClasses,+        FlexibleInstances+  #-}++module Data.Queue.Instances.STM+        ( STM+        +        , TChan+        , TMVar+        +        , atomically+        +        ) where++import Data.Queue.Classes++import Control.Concurrent.STM++-- TChan : full-featured FIFO in STM and IO monads; peekQueue is quite costly though+instance DefaultFifo (TChan a) STM a+instance NewFifo (TChan a) STM where+        newFifo = newTChan+instance Enqueue (TChan a) STM a where+        enqueue = writeTChan+instance Dequeue (TChan a) STM a where+        dequeue ch = fmap Just (readTChan ch) `orElse` return Nothing+instance PeekQueue (TChan a) STM a where+        peekQueue ch = do+                let     dequeueAll :: Dequeue q m a => q -> m [a]+                        dequeueAll q = do+                                item <- dequeue q+                                case item of+                                        Nothing -> return []+                                        Just h -> do+                                                t <- dequeueAll q+                                                return (h:t)+                +                xs <- dequeueAll ch+                mapM_ (enqueue ch) xs+                return xs++instance DefaultFifo (TChan a) IO a+instance NewFifo (TChan a) IO where+        newFifo = newTChanIO+instance Enqueue (TChan a) IO a where+        enqueue ch = atomically . enqueue ch+instance Dequeue (TChan a) IO a where+        dequeue = atomically . dequeue+instance PeekQueue (TChan a) IO a where+        peekQueue = atomically . peekQueue++-- TMVar : one-item queue in STM and IO monads+instance NewFifo (TMVar a) STM where+        newFifo = newEmptyTMVar+instance Enqueue (TMVar a) STM a where+        enqueue = putTMVar+instance Dequeue (TMVar a) STM a where+        dequeue = tryTakeTMVar++instance NewFifo (TMVar a) IO where+        newFifo = newEmptyTMVarIO+instance Enqueue (TMVar a) IO a where+        enqueue ch = atomically . enqueue ch+instance Dequeue (TMVar a) IO a where+        dequeue = atomically . dequeue