{-# LANGUAGE CPP #-}
module Control.Concurrent.Chan.Unagi.NoBlocking.Types where

import Control.Applicative
import Control.Monad.Fix
import Control.Monad
import Data.Maybe

#if __GLASGOW_HASKELL__ >= 800
import Control.Monad.Fail
#endif
-- Mostly here to avoid unfortunate name clash with our internal Stream type


-- | An infinite stream of elements. 'tryReadNext' can be called any number of
-- times from multiple threads, and returns a value which moves monotonically
-- from 'Pending' to 'Next' if and when a head element becomes available. 
-- @isActive@ can be used to determine if the stream has expired.
newtype Stream a = Stream { Stream a -> IO (Next a)
tryReadNext :: IO (Next a) }

data Next a = Next a (Stream a) -- ^ The next head element along with the tail @Stream@.
            | Pending           -- ^ The next element is not yet in the queue; you can retry 'tryReadNext' until a @Next@ is returned.


-- | An @IO@ action that returns a particular enqueued element when and if it
-- becomes available. 
--
-- Each @Element@ corresponds to a particular enqueued element, i.e. a returned
-- @Element@ always offers the only means to access one particular enqueued
-- item. The value returned by @tryRead@ moves monotonically from @Nothing@
-- to @Just a@ when and if an element becomes available, and is idempotent at
-- that point.
--
-- So for instance:
--
-- @
--    (in, out) <- newChan
--    (el, _) <- tryReadChan out  -- READ FROM EMPTY CHAN
--    writeChan in "msg1"
--    writeChan in "msg2"
--    readChan out        -- RETURNS "msg2"
--    tryRead el          -- RETURNS "msg1" (which would otherwise be lost)
-- @
newtype Element a = Element { Element a -> IO (Maybe a)
tryRead :: IO (Maybe a) }

-- Instances cribbed from MaybeT, from transformers v0.4.2.0
instance Functor Element where
    fmap :: (a -> b) -> Element a -> Element b
fmap a -> b
f = IO (Maybe b) -> Element b
forall a. IO (Maybe a) -> Element a
Element (IO (Maybe b) -> Element b)
-> (Element a -> IO (Maybe b)) -> Element a -> Element b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe a -> Maybe b) -> IO (Maybe a) -> IO (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) (IO (Maybe a) -> IO (Maybe b))
-> (Element a -> IO (Maybe a)) -> Element a -> IO (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element a -> IO (Maybe a)
forall a. Element a -> IO (Maybe a)
tryRead

instance  Applicative Element where
    pure :: a -> Element a
pure = a -> Element a
forall (m :: * -> *) a. Monad m => a -> m a
return
    <*> :: Element (a -> b) -> Element a -> Element b
(<*>) = Element (a -> b) -> Element a -> Element b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
 
instance Alternative Element where
    empty :: Element a
empty = Element a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    <|> :: Element a -> Element a -> Element a
(<|>) = Element a -> Element a -> Element a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus

instance Monad Element where
    return :: a -> Element a
return = IO (Maybe a) -> Element a
forall a. IO (Maybe a) -> Element a
Element (IO (Maybe a) -> Element a)
-> (a -> IO (Maybe a)) -> a -> Element a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> IO (Maybe a)) -> (a -> Maybe a) -> a -> IO (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return
    Element a
x >>= :: Element a -> (a -> Element b) -> Element b
>>= a -> Element b
f = IO (Maybe b) -> Element b
forall a. IO (Maybe a) -> Element a
Element (IO (Maybe b) -> Element b) -> IO (Maybe b) -> Element b
forall a b. (a -> b) -> a -> b
$ do
        Maybe a
v <- Element a -> IO (Maybe a)
forall a. Element a -> IO (Maybe a)
tryRead Element a
x
        case Maybe a
v of
            Maybe a
Nothing -> Maybe b -> IO (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
forall a. Maybe a
Nothing
            Just a
y  -> Element b -> IO (Maybe b)
forall a. Element a -> IO (Maybe a)
tryRead (a -> Element b
f a
y)
#if __GLASGOW_HASKELL__ >= 800
instance MonadFail Element where
#endif
    fail :: String -> Element a
fail String
_ = IO (Maybe a) -> Element a
forall a. IO (Maybe a) -> Element a
Element (Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing)

instance MonadPlus Element where
    mzero :: Element a
mzero = IO (Maybe a) -> Element a
forall a. IO (Maybe a) -> Element a
Element (Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing)
    mplus :: Element a -> Element a -> Element a
mplus Element a
x Element a
y = IO (Maybe a) -> Element a
forall a. IO (Maybe a) -> Element a
Element (IO (Maybe a) -> Element a) -> IO (Maybe a) -> Element a
forall a b. (a -> b) -> a -> b
$ do
        Maybe a
v <- Element a -> IO (Maybe a)
forall a. Element a -> IO (Maybe a)
tryRead Element a
x
        case Maybe a
v of
            Maybe a
Nothing -> Element a -> IO (Maybe a)
forall a. Element a -> IO (Maybe a)
tryRead Element a
y
            Just a
_  -> Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
v

instance MonadFix Element where
    mfix :: (a -> Element a) -> Element a
mfix a -> Element a
f = IO (Maybe a) -> Element a
forall a. IO (Maybe a) -> Element a
Element ((Maybe a -> IO (Maybe a)) -> IO (Maybe a)
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (Element a -> IO (Maybe a)
forall a. Element a -> IO (Maybe a)
tryRead (Element a -> IO (Maybe a))
-> (Maybe a -> Element a) -> Maybe a -> IO (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Element a
f (a -> Element a) -> (Maybe a -> a) -> Maybe a -> Element a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
forall a. a
bomb))
      where bomb :: a
bomb = String -> a
forall a. HasCallStack => String -> a
error String
"mfix (Element): inner computation returned Nothing"