Ticket #3331: A.hs

File A.hs, 987 bytes (added by igloo, 6 years ago)
Line 
1
2{-# LANGUAGE MultiParamTypeClasses      #-}
3{-# LANGUAGE FunctionalDependencies     #-}
4{-# LANGUAGE FlexibleInstances          #-}
5{-# LANGUAGE RankNTypes                 #-}
6{-# LANGUAGE TypeOperators              #-}
7
8module A (runQueue, zenQ, zdeQ) where
9
10import Data.Word
11
12type QSt e = Word -> [e] -> [e]
13
14newtype Q e a = Q { unQ :: (a -> QSt e) -> QSt e }
15
16instance Monad (Q e) where
17  return a  = Q (\k -> k a)
18  m >>= f   = Q (\k -> unQ m (\a -> unQ (f a) k))
19
20-- | Enqueues an element to the queue
21zenQ :: e -> Q e ()
22zenQ e = Q (\k n q -> e : (k () $! n+1) q)
23
24-- | Dequeues an element,  returns 'Nothing' if the queue is empty.
25zdeQ :: Q e (Maybe e)
26zdeQ   = Q delta
27  where
28    delta k n q
29       | n <= 0    = k Nothing n q
30       | otherwise = case q of
31                      [] -> error "Control.Monad.Queue.Allison.deQ: empty list"
32                      (e:q') -> (k (Just e) $! n-1) q'
33
34runQueue :: Q e a -> [e]
35runQueue m = q
36  where
37    q = unQ m (\_ _ _ -> []) 0 q
38