{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}

-- |
-- Description: Simple Events
--
-- We implement the Source type and combinators for it.
module Util.Sources(
   Source,
      -- A Source x d represents something that stores a value of
      -- type x and sends change messages of type d.

      -- We instance CanAddSinks (Source x d) x d

   Client,
      -- A Client d is something that consumes change messages of type d.

   -- Producer side
   staticSource, -- :: x -> Source x d
      -- returns a source which never changes

   staticSourceIO, -- :: IO x -> Source x d
      -- returns a source which never changes but gets its initial value
      -- from an IO action.

   variableSource, -- :: x -> IO (Source x d,(x -> (x,[d])) -> IO ())
      -- returns a source which can change.  The supplied action
      -- changes it.

   variableGeneralSource,
      -- :: x -> IO (Source x d,Updater x d)
      -- Like variableSource, but allows the provider of new values to
      -- get out an extra value.  For this it is necessary to go
      -- via the Updater type.

   Updater,
   applyToUpdater, -- :: Updater x d -> (x -> (x,[d],extra)) -> IO extra

   -- Client side
   attachClient, -- :: Client d -> Source x d -> IO x

   -- Transformers
   map1,
      -- :: (x1 -> x2) -> Source x1 d -> Source x2 d

   map1IO,
      -- :: (x1 -> IO x2) -> Source x1 d -> Source x2 d

   map2,
      -- :: (d1 -> d2) -> Source x d1 -> Source x d2
   filter2,
      -- :: (d1 -> Maybe d2) -> Source x d1 -> Source x d2

   filter2IO,
      -- :: (d1 -> IO (Maybe d2)) -> Source x d1 -> Source x d2
      -- To be used with care, since the IO action ties up the source.

   foldSource,
      -- :: (x -> state) -> (state -> d1 -> (state,d2))
      --    -> Source x d1 -> Source (state,x) d2

   foldSourceIO,
      -- :: (x1 -> IO (state,x2)) -> (state -> d1 -> IO (state,d2))
      -- -> Source x1 d1 -> Source (state,x2) d2

   stepSource,
      -- :: (x -> d2) -> (d1 -> d2) -> Source x d1 -> Source x d2
      -- This modifies the source so that whenever we attempt to read from it,
      -- the current "x" value is BOTH returned AND converted to an instant
      -- update (via the first function).

   -- Combinators
   choose,
      -- :: Source x1 d1 -> Source x2 d2 -> Source (x1,x2) (Either d1 d2)
   seqSource,
      -- :: Source x1 x1 -> (x1 -> Source x2 x2) -> Source x2 x2
   flattenSource,
      -- :: Source x [d] -> Source x d
      -- A Source combinator which "flattens" lists of updates.

   -- Monadic Sources
   SimpleSource(..),
      -- newtype for Source x x
      -- Instance of Functor and Monad

   staticSimpleSource, -- :: x -> SimpleSource x

   staticSimpleSourceIO, -- :: IO x -> SimpleSource x

   -- We also instance CanAddSinks (SimpleSource x) x x.
   -- This is done via the following class
   HasSource(..),
   HasSimpleSource(..),

   readContents,
      -- :: HasSource source x d => source -> IO x
      -- Get the current contents of the source, but don't specify any other
      -- action.

   -- miscellaneous handy utilities,
   mkHistorySource, -- :: (x -> d) -> Source x d -> Source x (d,d)
   mkHistorySimpleSource, -- :: x -> SimpleSource x -> SimpleSource (x,x)
   uniqSimpleSource, -- :: Eq x => SimpleSource x -> SimpleSource x

   pairSimpleSources,
      -- :: SimpleSource x1 -> SimpleSource x2 -> SimpleSource (x1,x2)
      -- Pair two SimpleSource's.  This is probably better than using >>=,
      -- since it does not require reregistering with the second SimpleSource

   sequenceSimpleSource, -- :: [SimpleSource x] -> SimpleSource [x]
   -- Does a similar job to pairSimpleSources, so that the sources run
   -- parallel.

   change1, -- :: SimpleSource x -> x -> SimpleSource x
   -- replaces the first value of the SimpleSource.

   mapIOSeq,
      -- :: SimpleSource a -> (a -> IO (SimpleSource b)) -> SimpleSource b
      -- allow us to sequence a SimpleSource where the continuation function
      -- uses an IO action.

   addNewSourceActions,
      -- :: Source x d -> (x -> IO ()) -> (d -> IO ())
      -- -> SinkID -> ParallelExec -> IO x
   -- Run the specified actions for the source, using the given SinkID and
   -- in the ParallelExec thread.
   -- The x -> IO () action is guaranteed to be performed before any of the
   -- d -> IO () actions.

   traceSimpleSource,
      -- :: (a -> String) -> SimpleSource a -> SimpleSource a
      -- Outputs information about what comes through the source, turning
      -- it into a String with the supplied function.  (This is done once
      -- for each active client.)

   traceSource,
      -- :: (a -> String) -> (d -> String) -> Source a d -> Source a d
      -- Like traceSimpleSource but for Source's.

   noLoopSimpleSource,
      -- :: TSem -> ([String] -> a) -> SimpleSource a -> SimpleSource a
      -- Used when we are worried that a SimpleSource recursively constructed
      -- by mapIOSeq, >>= and friends may actually try to call itself, and
      -- so loop forever.   The Strings identify the SimpleSource,
      -- and so the [String] is effectively a backtrace of the TSems,
      -- revealing what chain of simple sources might have caused the loop.

   mkIOSimpleSource,
      -- :: IO (SimpleSource a) -> SimpleSource a

   foldSimpleSourceIO,
      -- :: (x1 -> IO (state,x2)) -> (state -> x1 -> IO (state,x2))
      -- -> SimpleSource x1 -> SimpleSource x2

   ) where

import Data.Maybe

import Control.Applicative
import Control.Concurrent
import Control.Monad
import Data.IORef

import Util.ExtendedPrelude(HasMapIO(..))
import Util.Sink
import Util.TSem
import Util.Debug(debug)

-- -----------------------------------------------------------------
-- Datatypes
-- -----------------------------------------------------------------

newtype Source x d = Source (Client d -> IO x)

newtype Client d = Client (d -> IO (Maybe (Client d)))

data SourceData x d = SourceData {
   SourceData x d -> x
x :: x,
   SourceData x d -> Maybe (Client d)
client :: Maybe (Client d)
   }

-- -----------------------------------------------------------------
-- Producer side
-- -----------------------------------------------------------------

staticSource :: x -> Source x d
staticSource :: x -> Source x d
staticSource x
x = (Client d -> IO x) -> Source x d
forall x d. (Client d -> IO x) -> Source x d
Source (\ Client d
_ -> x -> IO x
forall (m :: * -> *) a. Monad m => a -> m a
return x
x)


staticSourceIO :: IO x -> Source x d
staticSourceIO :: IO x -> Source x d
staticSourceIO IO x
action = (Client d -> IO x) -> Source x d
forall x d. (Client d -> IO x) -> Source x d
Source (\ Client d
_ -> IO x
action)

variableSource :: x -> IO (Source x d,(x -> (x,[d])) -> IO ())
variableSource :: x -> IO (Source x d, (x -> (x, [d])) -> IO ())
variableSource x
x =
   do
      MVar (SourceData x d)
mVar <- SourceData x d -> IO (MVar (SourceData x d))
forall a. a -> IO (MVar a)
newMVar (SourceData :: forall x d. x -> Maybe (Client d) -> SourceData x d
SourceData {
         x :: x
x = x
x,
         client :: Maybe (Client d)
client = Maybe (Client d)
forall a. Maybe a
Nothing
         })
      let
         update :: (x -> (x, [d])) -> IO ()
update x -> (x, [d])
updateFn =
            do
               (SourceData {x :: forall x d. SourceData x d -> x
x = x
x1,client :: forall x d. SourceData x d -> Maybe (Client d)
client = Maybe (Client d)
clientOpt}) <- MVar (SourceData x d) -> IO (SourceData x d)
forall a. MVar a -> IO a
takeMVar MVar (SourceData x d)
mVar
               let
                  (x
x2,[d]
ds) = x -> (x, [d])
updateFn x
x1

                  sendUpdates :: Maybe (Client d) -> [d] -> IO (Maybe (Client d))
sendUpdates (Just (Client d -> IO (Maybe (Client d))
clientFn)) (d
d:[d]
ds) =
                     do
                        Maybe (Client d)
newClientOpt <- d -> IO (Maybe (Client d))
clientFn d
d
                        Maybe (Client d) -> [d] -> IO (Maybe (Client d))
sendUpdates Maybe (Client d)
newClientOpt [d]
ds
                  sendUpdates Maybe (Client d)
clientOpt [d]
_ = Maybe (Client d) -> IO (Maybe (Client d))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Client d)
clientOpt

               Maybe (Client d)
newClientOpt <- Maybe (Client d) -> [d] -> IO (Maybe (Client d))
forall d. Maybe (Client d) -> [d] -> IO (Maybe (Client d))
sendUpdates Maybe (Client d)
clientOpt [d]
ds
               MVar (SourceData x d) -> SourceData x d -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (SourceData x d)
mVar (SourceData :: forall x d. x -> Maybe (Client d) -> SourceData x d
SourceData {x :: x
x = x
x2,client :: Maybe (Client d)
client = Maybe (Client d)
newClientOpt})
         addClient :: Client d -> IO x
addClient Client d
newClient =
            do
               (SourceData {x :: forall x d. SourceData x d -> x
x = x
x,client :: forall x d. SourceData x d -> Maybe (Client d)
client = Maybe (Client d)
oldClientOpt}) <- MVar (SourceData x d) -> IO (SourceData x d)
forall a. MVar a -> IO a
takeMVar MVar (SourceData x d)
mVar
               let
                  fullNewClient :: Client d
fullNewClient = case Maybe (Client d)
oldClientOpt of
                     Maybe (Client d)
Nothing -> Client d
newClient
                     Just Client d
oldClient -> Client d -> Client d -> Client d
forall d. Client d -> Client d -> Client d
combineClients Client d
oldClient Client d
newClient
               MVar (SourceData x d) -> SourceData x d -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (SourceData x d)
mVar (SourceData :: forall x d. x -> Maybe (Client d) -> SourceData x d
SourceData {x :: x
x = x
x,client :: Maybe (Client d)
client = Client d -> Maybe (Client d)
forall a. a -> Maybe a
Just Client d
fullNewClient})
               x -> IO x
forall (m :: * -> *) a. Monad m => a -> m a
return x
x
      (Source x d, (x -> (x, [d])) -> IO ())
-> IO (Source x d, (x -> (x, [d])) -> IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return ((Client d -> IO x) -> Source x d
forall x d. (Client d -> IO x) -> Source x d
Source Client d -> IO x
addClient,(x -> (x, [d])) -> IO ()
update)


newtype Updater x d = Updater (forall extra . (x -> (x,[d],extra)) -> IO extra)

applyToUpdater :: Updater x d -> (x -> (x,[d],extra)) -> IO extra
applyToUpdater :: Updater x d -> (x -> (x, [d], extra)) -> IO extra
applyToUpdater (Updater forall extra. (x -> (x, [d], extra)) -> IO extra
update) x -> (x, [d], extra)
updateAct = (x -> (x, [d], extra)) -> IO extra
forall extra. (x -> (x, [d], extra)) -> IO extra
update x -> (x, [d], extra)
updateAct

variableGeneralSource :: x -> IO (Source x d,Updater x d)
variableGeneralSource :: x -> IO (Source x d, Updater x d)
variableGeneralSource x
x =
   do
      MVar (SourceData x d)
mVar <- SourceData x d -> IO (MVar (SourceData x d))
forall a. a -> IO (MVar a)
newMVar (SourceData :: forall x d. x -> Maybe (Client d) -> SourceData x d
SourceData {
         x :: x
x = x
x,
         client :: Maybe (Client d)
client = Maybe (Client d)
forall a. Maybe a
Nothing
         })
      let
         update :: (x -> (x, [d], b)) -> IO b
update x -> (x, [d], b)
updateFn =
            do
               (SourceData {x :: forall x d. SourceData x d -> x
x = x
x1,client :: forall x d. SourceData x d -> Maybe (Client d)
client = Maybe (Client d)
clientOpt}) <- MVar (SourceData x d) -> IO (SourceData x d)
forall a. MVar a -> IO a
takeMVar MVar (SourceData x d)
mVar

               let
                  (x
x2,[d]
ds,b
extra) = x -> (x, [d], b)
updateFn x
x1
                  sendUpdates :: Maybe (Client d) -> [d] -> IO (Maybe (Client d))
sendUpdates (Just (Client d -> IO (Maybe (Client d))
clientFn)) (d
d:[d]
ds) =
                     do
                        Maybe (Client d)
newClientOpt <- d -> IO (Maybe (Client d))
clientFn d
d
                        Maybe (Client d) -> [d] -> IO (Maybe (Client d))
sendUpdates Maybe (Client d)
newClientOpt [d]
ds
                  sendUpdates Maybe (Client d)
clientOpt [d]
_ = Maybe (Client d) -> IO (Maybe (Client d))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Client d)
clientOpt

               Maybe (Client d)
newClientOpt <- Maybe (Client d) -> [d] -> IO (Maybe (Client d))
forall d. Maybe (Client d) -> [d] -> IO (Maybe (Client d))
sendUpdates Maybe (Client d)
clientOpt [d]
ds
               MVar (SourceData x d) -> SourceData x d -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (SourceData x d)
mVar (SourceData :: forall x d. x -> Maybe (Client d) -> SourceData x d
SourceData {x :: x
x = x
x2,client :: Maybe (Client d)
client = Maybe (Client d)
newClientOpt})
               b -> IO b
forall (m :: * -> *) a. Monad m => a -> m a
return b
extra
         addClient :: Client d -> IO x
addClient Client d
newClient =
            do
               (SourceData {x :: forall x d. SourceData x d -> x
x = x
x,client :: forall x d. SourceData x d -> Maybe (Client d)
client = Maybe (Client d)
oldClientOpt}) <- MVar (SourceData x d) -> IO (SourceData x d)
forall a. MVar a -> IO a
takeMVar MVar (SourceData x d)
mVar
               let
                  fullNewClient :: Client d
fullNewClient = case Maybe (Client d)
oldClientOpt of
                     Maybe (Client d)
Nothing -> Client d
newClient
                     Just Client d
oldClient -> Client d -> Client d -> Client d
forall d. Client d -> Client d -> Client d
combineClients Client d
oldClient Client d
newClient
               MVar (SourceData x d) -> SourceData x d -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (SourceData x d)
mVar (SourceData :: forall x d. x -> Maybe (Client d) -> SourceData x d
SourceData {x :: x
x = x
x,client :: Maybe (Client d)
client = Client d -> Maybe (Client d)
forall a. a -> Maybe a
Just Client d
fullNewClient})
               x -> IO x
forall (m :: * -> *) a. Monad m => a -> m a
return x
x
      (Source x d, Updater x d) -> IO (Source x d, Updater x d)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Client d -> IO x) -> Source x d
forall x d. (Client d -> IO x) -> Source x d
Source Client d -> IO x
addClient,(forall extra. (x -> (x, [d], extra)) -> IO extra) -> Updater x d
forall x d.
(forall extra. (x -> (x, [d], extra)) -> IO extra) -> Updater x d
Updater forall extra. (x -> (x, [d], extra)) -> IO extra
update)

combineClients :: Client d -> Client d -> Client d
combineClients :: Client d -> Client d -> Client d
combineClients (Client d -> IO (Maybe (Client d))
clientFn1) (Client d -> IO (Maybe (Client d))
clientFn2) =
   let
      clientFn :: d -> IO (Maybe (Client d))
clientFn d
d =
         do
            Maybe (Client d)
newClient1Opt <- d -> IO (Maybe (Client d))
clientFn1 d
d
            Maybe (Client d)
newClient2Opt <- d -> IO (Maybe (Client d))
clientFn2 d
d
            case (Maybe (Client d)
newClient1Opt,Maybe (Client d)
newClient2Opt) of
               (Maybe (Client d)
Nothing,Maybe (Client d)
Nothing) -> Maybe (Client d) -> IO (Maybe (Client d))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Client d)
forall a. Maybe a
Nothing
               (Just Client d
newClient1,Maybe (Client d)
Nothing) -> Maybe (Client d) -> IO (Maybe (Client d))
forall (m :: * -> *) a. Monad m => a -> m a
return (Client d -> Maybe (Client d)
forall a. a -> Maybe a
Just Client d
newClient1)
               (Maybe (Client d)
Nothing,Just Client d
newClient2) -> Maybe (Client d) -> IO (Maybe (Client d))
forall (m :: * -> *) a. Monad m => a -> m a
return (Client d -> Maybe (Client d)
forall a. a -> Maybe a
Just Client d
newClient2)
               (Just Client d
newClient1,Just Client d
newClient2)
                  -> Maybe (Client d) -> IO (Maybe (Client d))
forall (m :: * -> *) a. Monad m => a -> m a
return (Client d -> Maybe (Client d)
forall a. a -> Maybe a
Just (Client d -> Client d -> Client d
forall d. Client d -> Client d -> Client d
combineClients Client d
newClient1 Client d
newClient2))
   in
      (d -> IO (Maybe (Client d))) -> Client d
forall d. (d -> IO (Maybe (Client d))) -> Client d
Client d -> IO (Maybe (Client d))
clientFn

-- -----------------------------------------------------------------
-- Client side
-- -----------------------------------------------------------------

attachClient :: Client d -> Source x d -> IO x
attachClient :: Client d -> Source x d -> IO x
attachClient Client d
client (Source Client d -> IO x
addClient) = Client d -> IO x
addClient Client d
client

-- | attachClientTemporary is like attach, but additionally returns an
-- IO action which can be used to prevent any client being run after that
-- IO action is called.
attachClientTemporary :: Client d -> Source x d -> IO (x,IO ())
attachClientTemporary :: Client d -> Source x d -> IO (x, IO ())
attachClientTemporary Client d
client Source x d
source =
   do
      (Client d
newClient,IO ()
terminator) <- Client d -> IO (Client d, IO ())
forall d. Client d -> IO (Client d, IO ())
mkTemporaryClient Client d
client
      x
x <- Client d -> Source x d -> IO x
forall d x. Client d -> Source x d -> IO x
attachClient Client d
newClient Source x d
source
      (x, IO ()) -> IO (x, IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (x
x,IO ()
terminator)

-- | mkTemporaryClient is used to map the client by attachClientTemporary.
mkTemporaryClient :: Client d -> IO (Client d,IO ())
mkTemporaryClient :: Client d -> IO (Client d, IO ())
mkTemporaryClient Client d
client =
   do
      IORef Bool
ioRef <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
True -- write False to this to stop the client.
      let
         newClient :: Client d -> Client d
newClient Client d
client = (d -> IO (Maybe (Client d))) -> Client d
forall d. (d -> IO (Maybe (Client d))) -> Client d
Client (Client d -> d -> IO (Maybe (Client d))
newClientFn Client d
client)

         newClientFn :: Client d -> d -> IO (Maybe (Client d))
newClientFn (Client d -> IO (Maybe (Client d))
oldClientFn) d
d  =
            do
               Bool
goAhead <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
ioRef
               if Bool
goAhead
                  then
                     do
                        Maybe (Client d)
newClientOpt <- d -> IO (Maybe (Client d))
oldClientFn d
d
                        Maybe (Client d) -> IO (Maybe (Client d))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Client d -> Client d) -> Maybe (Client d) -> Maybe (Client d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Client d -> Client d
newClient Maybe (Client d)
newClientOpt)
                  else
                     Maybe (Client d) -> IO (Maybe (Client d))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Client d)
forall a. Maybe a
Nothing
      (Client d, IO ()) -> IO (Client d, IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Client d -> Client d
forall d. Client d -> Client d
newClient Client d
client,IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
ioRef Bool
False)

-- | mkComputedClient computes a client using a value to be supplied via the
-- returned function.  (Hopefully soon after, because of course the source
-- will block until it is.)
mkComputedClient :: (x -> Client d) -> IO (Client d,x -> IO ())
mkComputedClient :: (x -> Client d) -> IO (Client d, x -> IO ())
mkComputedClient x -> Client d
getClient =
   do
      MVar x
mVar <- IO (MVar x)
forall a. IO (MVar a)
newEmptyMVar
      let
         client :: Client d
client = (d -> IO (Maybe (Client d))) -> Client d
forall d. (d -> IO (Maybe (Client d))) -> Client d
Client d -> IO (Maybe (Client d))
clientFn

         clientFn :: d -> IO (Maybe (Client d))
clientFn d
d =
            do
               x
x <- MVar x -> IO x
forall a. MVar a -> IO a
takeMVar MVar x
mVar
               let
                  (Client d -> IO (Maybe (Client d))
realClientFn) = x -> Client d
getClient x
x
               d -> IO (Maybe (Client d))
realClientFn d
d
      (Client d, x -> IO ()) -> IO (Client d, x -> IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Client d
client,MVar x -> x -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar x
mVar)

-- | mkComputedClient is like mkComputedClient, but still more dangerously
-- allows an IO action to compute the client.
--
-- It also allows the supplied function to provide Nothing, indicating no
-- client.
mkComputedClientIO :: (x -> IO (Maybe (Client d))) -> IO (Client d,x -> IO ())
mkComputedClientIO :: (x -> IO (Maybe (Client d))) -> IO (Client d, x -> IO ())
mkComputedClientIO x -> IO (Maybe (Client d))
getClient =
   do
      MVar x
mVar <- IO (MVar x)
forall a. IO (MVar a)
newEmptyMVar
      let
         client :: Client d
client = (d -> IO (Maybe (Client d))) -> Client d
forall d. (d -> IO (Maybe (Client d))) -> Client d
Client d -> IO (Maybe (Client d))
clientFn

         clientFn :: d -> IO (Maybe (Client d))
clientFn d
d =
            do
               x
x <- MVar x -> IO x
forall a. MVar a -> IO a
takeMVar MVar x
mVar
               Maybe (Client d)
clientOpt <- x -> IO (Maybe (Client d))
getClient x
x
               case Maybe (Client d)
clientOpt of
                  Maybe (Client d)
Nothing -> Maybe (Client d) -> IO (Maybe (Client d))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Client d)
forall a. Maybe a
Nothing
                  Just (Client d -> IO (Maybe (Client d))
realClientFn) -> d -> IO (Maybe (Client d))
realClientFn d
d
      (Client d, x -> IO ()) -> IO (Client d, x -> IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Client d
client,MVar x -> x -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar x
mVar)

-- | mkStaticClient is used by various functions to create from a client
-- a single static client which tracks its state using an MVar.
mkStaticClient :: Client d -> IO (Client d)
mkStaticClient :: Client d -> IO (Client d)
mkStaticClient Client d
client =
   do
      (Client d
newClient,IO Bool
_) <- Client d -> IO (Client d, IO Bool)
forall d. Client d -> IO (Client d, IO Bool)
mkStaticClientGeneral Client d
client
      Client d -> IO (Client d)
forall (m :: * -> *) a. Monad m => a -> m a
return Client d
newClient

-- | mkStaticClientGeneral is like mkStaticClient except that it also returns
-- an action which determines if the client is still running.
mkStaticClientGeneral :: Client d -> IO (Client d,IO Bool)
mkStaticClientGeneral :: Client d -> IO (Client d, IO Bool)
mkStaticClientGeneral (Client d
client :: Client d) =
   do
      MVar (Maybe (Client d))
mVar <- Maybe (Client d) -> IO (MVar (Maybe (Client d)))
forall a. a -> IO (MVar a)
newMVar (Client d -> Maybe (Client d)
forall a. a -> Maybe a
Just Client d
client)
      let
         client :: Client d
client = (d -> IO (Maybe (Client d))) -> Client d
forall d. (d -> IO (Maybe (Client d))) -> Client d
Client d -> IO (Maybe (Client d))
clientFn

         clientFn :: d -> IO (Maybe (Client d))
clientFn d
d =
            do
               Maybe (Client d)
clientOpt <- MVar (Maybe (Client d)) -> IO (Maybe (Client d))
forall a. MVar a -> IO a
takeMVar MVar (Maybe (Client d))
mVar
               case Maybe (Client d)
clientOpt of
                  Maybe (Client d)
Nothing -> do
                     MVar (Maybe (Client d)) -> Maybe (Client d) -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Maybe (Client d))
mVar Maybe (Client d)
clientOpt
                     Maybe (Client d) -> IO (Maybe (Client d))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Client d)
forall a. Maybe a
Nothing
                  Just (Client d -> IO (Maybe (Client d))
clientFnInner) ->
                     do
                        Maybe (Client d)
newClientOpt <- d -> IO (Maybe (Client d))
clientFnInner d
d
                        MVar (Maybe (Client d)) -> Maybe (Client d) -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Maybe (Client d))
mVar Maybe (Client d)
newClientOpt
                        Maybe (Client d) -> IO (Maybe (Client d))
forall (m :: * -> *) a. Monad m => a -> m a
return (Client d -> Maybe (Client d)
forall a. a -> Maybe a
Just Client d
client)

         clientRunning :: IO Bool
clientRunning =
            do
               Maybe (Client d)
clientOpt <- MVar (Maybe (Client d)) -> IO (Maybe (Client d))
forall a. MVar a -> IO a
readMVar MVar (Maybe (Client d))
mVar
               Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Client d) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Client d)
clientOpt)

      (Client d, IO Bool) -> IO (Client d, IO Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Client d
client,IO Bool
clientRunning)

-- -----------------------------------------------------------------
-- Transformers
-- -----------------------------------------------------------------

map1 :: (x1 -> x2) -> Source x1 d -> Source x2 d
map1 :: (x1 -> x2) -> Source x1 d -> Source x2 d
map1 x1 -> x2
mapFn (Source Client d -> IO x1
addClient1) =
   let
      addClient2 :: Client d -> IO x2
addClient2 Client d
d =
         do
            x1
x1 <- Client d -> IO x1
addClient1 Client d
d
            x2 -> IO x2
forall (m :: * -> *) a. Monad m => a -> m a
return (x1 -> x2
mapFn x1
x1)
   in
      (Client d -> IO x2) -> Source x2 d
forall x d. (Client d -> IO x) -> Source x d
Source Client d -> IO x2
addClient2

map1IO :: (x1 -> IO x2) -> Source x1 d -> Source x2 d
map1IO :: (x1 -> IO x2) -> Source x1 d -> Source x2 d
map1IO x1 -> IO x2
mapFn (Source Client d -> IO x1
addClient1) =
   let
      addClient2 :: Client d -> IO x2
addClient2 Client d
d =
         do
            x1
x1 <- Client d -> IO x1
addClient1 Client d
d
            x1 -> IO x2
mapFn x1
x1
   in
      (Client d -> IO x2) -> Source x2 d
forall x d. (Client d -> IO x) -> Source x d
Source Client d -> IO x2
addClient2

map2 :: (d1 -> d2) -> Source x d1 -> Source x d2
map2 :: (d1 -> d2) -> Source x d1 -> Source x d2
map2 d1 -> d2
mapFn (Source Client d1 -> IO x
addClient1) =
   let
      addClient2 :: Client d2 -> IO x
addClient2 Client d2
newClient1 = Client d1 -> IO x
addClient1 ((d1 -> d2) -> Client d2 -> Client d1
forall d1 d2. (d1 -> d2) -> Client d2 -> Client d1
coMapClient d1 -> d2
mapFn Client d2
newClient1)
   in
      (Client d2 -> IO x) -> Source x d2
forall x d. (Client d -> IO x) -> Source x d
Source Client d2 -> IO x
addClient2

coMapClient :: (d1 -> d2) -> Client d2 -> Client d1
coMapClient :: (d1 -> d2) -> Client d2 -> Client d1
coMapClient d1 -> d2
mapFn (Client d2 -> IO (Maybe (Client d2))
clientFn2) =
   let
      client1 :: Client d1
client1 = (d1 -> IO (Maybe (Client d1))) -> Client d1
forall d. (d -> IO (Maybe (Client d))) -> Client d
Client d1 -> IO (Maybe (Client d1))
clientFn1

      clientFn1 :: d1 -> IO (Maybe (Client d1))
clientFn1 d1
d1 =
         do
            let
               d2 :: d2
d2 = d1 -> d2
mapFn d1
d1
            Maybe (Client d2)
newClient2Opt <- d2 -> IO (Maybe (Client d2))
clientFn2 d2
d2
            Maybe (Client d1) -> IO (Maybe (Client d1))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Client d2 -> Client d1) -> Maybe (Client d2) -> Maybe (Client d1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
               ((d1 -> d2) -> Client d2 -> Client d1
forall d1 d2. (d1 -> d2) -> Client d2 -> Client d1
coMapClient d1 -> d2
mapFn)
               Maybe (Client d2)
newClient2Opt
               )
   in
      Client d1
client1

filter2 :: (d1 -> Maybe d2) -> Source x d1 -> Source x d2
filter2 :: (d1 -> Maybe d2) -> Source x d1 -> Source x d2
filter2 d1 -> Maybe d2
filterFn (Source Client d1 -> IO x
addClient1) =
   let
      addClient2 :: Client d2 -> IO x
addClient2 Client d2
newClient1 = Client d1 -> IO x
addClient1 ((d1 -> Maybe d2) -> Client d2 -> Client d1
forall d1 d2. (d1 -> Maybe d2) -> Client d2 -> Client d1
filterClient d1 -> Maybe d2
filterFn Client d2
newClient1)
   in
      (Client d2 -> IO x) -> Source x d2
forall x d. (Client d -> IO x) -> Source x d
Source Client d2 -> IO x
addClient2

filterClient :: (d1 -> Maybe d2) -> Client d2 -> Client d1
filterClient :: (d1 -> Maybe d2) -> Client d2 -> Client d1
filterClient d1 -> Maybe d2
filterFn (Client d2 -> IO (Maybe (Client d2))
clientFn2) =
   let
      client1 :: Client d1
client1 = (d1 -> IO (Maybe (Client d1))) -> Client d1
forall d. (d -> IO (Maybe (Client d))) -> Client d
Client d1 -> IO (Maybe (Client d1))
clientFn1

      clientFn1 :: d1 -> IO (Maybe (Client d1))
clientFn1 d1
d1 =
         let
            d2Opt :: Maybe d2
d2Opt = d1 -> Maybe d2
filterFn d1
d1
         in
            case Maybe d2
d2Opt of
               Maybe d2
Nothing -> Maybe (Client d1) -> IO (Maybe (Client d1))
forall (m :: * -> *) a. Monad m => a -> m a
return (Client d1 -> Maybe (Client d1)
forall a. a -> Maybe a
Just Client d1
client1)
               Just d2
d2 ->
                  do
                     Maybe (Client d2)
newClient2Opt <- d2 -> IO (Maybe (Client d2))
clientFn2 d2
d2
                     Maybe (Client d1) -> IO (Maybe (Client d1))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Client d2 -> Client d1) -> Maybe (Client d2) -> Maybe (Client d1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                        ((d1 -> Maybe d2) -> Client d2 -> Client d1
forall d1 d2. (d1 -> Maybe d2) -> Client d2 -> Client d1
filterClient d1 -> Maybe d2
filterFn)
                        Maybe (Client d2)
newClient2Opt
                        )
   in
      Client d1
client1

filter2IO :: (d1 -> IO (Maybe d2)) -> Source x d1 -> Source x d2
filter2IO :: (d1 -> IO (Maybe d2)) -> Source x d1 -> Source x d2
filter2IO d1 -> IO (Maybe d2)
filterFn (Source Client d1 -> IO x
addClient1) =
   let
      addClient2 :: Client d2 -> IO x
addClient2 Client d2
newClient1 = Client d1 -> IO x
addClient1 ((d1 -> IO (Maybe d2)) -> Client d2 -> Client d1
forall d1 d2. (d1 -> IO (Maybe d2)) -> Client d2 -> Client d1
filterClientIO d1 -> IO (Maybe d2)
filterFn Client d2
newClient1)
   in
      (Client d2 -> IO x) -> Source x d2
forall x d. (Client d -> IO x) -> Source x d
Source Client d2 -> IO x
addClient2

filterClientIO :: (d1 -> IO (Maybe d2)) -> Client d2 -> Client d1
filterClientIO :: (d1 -> IO (Maybe d2)) -> Client d2 -> Client d1
filterClientIO d1 -> IO (Maybe d2)
filterFn (Client d2 -> IO (Maybe (Client d2))
clientFn2) =
   let
      client1 :: Client d1
client1 = (d1 -> IO (Maybe (Client d1))) -> Client d1
forall d. (d -> IO (Maybe (Client d))) -> Client d
Client d1 -> IO (Maybe (Client d1))
clientFn1

      clientFn1 :: d1 -> IO (Maybe (Client d1))
clientFn1 d1
d1 =
         do
            Maybe d2
d2Opt <- d1 -> IO (Maybe d2)
filterFn d1
d1
            case Maybe d2
d2Opt of
               Maybe d2
Nothing -> Maybe (Client d1) -> IO (Maybe (Client d1))
forall (m :: * -> *) a. Monad m => a -> m a
return (Client d1 -> Maybe (Client d1)
forall a. a -> Maybe a
Just Client d1
client1)
               Just d2
d2 ->
                  do
                     Maybe (Client d2)
newClient2Opt <- d2 -> IO (Maybe (Client d2))
clientFn2 d2
d2
                     Maybe (Client d1) -> IO (Maybe (Client d1))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Client d2 -> Client d1) -> Maybe (Client d2) -> Maybe (Client d1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                        ((d1 -> IO (Maybe d2)) -> Client d2 -> Client d1
forall d1 d2. (d1 -> IO (Maybe d2)) -> Client d2 -> Client d1
filterClientIO d1 -> IO (Maybe d2)
filterFn)
                        Maybe (Client d2)
newClient2Opt
                        )
   in
      Client d1
client1

foldSource :: (x -> state) -> (state -> d1 -> (state,d2))
   -> Source x d1 -> Source (state,x) d2
foldSource :: (x -> state)
-> (state -> d1 -> (state, d2))
-> Source x d1
-> Source (state, x) d2
foldSource x -> state
xFn state -> d1 -> (state, d2)
foldFn =
   let
      xFnIO :: x -> m (state, x)
xFnIO x
x = (state, x) -> m (state, x)
forall (m :: * -> *) a. Monad m => a -> m a
return (x -> state
xFn x
x,x
x)
      foldFnIO :: state -> d1 -> m (state, d2)
foldFnIO state
state d1
d = (state, d2) -> m (state, d2)
forall (m :: * -> *) a. Monad m => a -> m a
return (state -> d1 -> (state, d2)
foldFn state
state d1
d)
   in
      (x -> IO (state, x))
-> (state -> d1 -> IO (state, d2))
-> Source x d1
-> Source (state, x) d2
forall x1 state x2 d1 d2.
(x1 -> IO (state, x2))
-> (state -> d1 -> IO (state, d2))
-> Source x1 d1
-> Source (state, x2) d2
foldSourceIO x -> IO (state, x)
forall (m :: * -> *). Monad m => x -> m (state, x)
xFnIO state -> d1 -> IO (state, d2)
forall (m :: * -> *). Monad m => state -> d1 -> m (state, d2)
foldFnIO

-- | Fold a Source so that it can carry state around.
foldSourceIO :: (x1 -> IO (state,x2)) -> (state -> d1 -> IO (state,d2))
   -> Source x1 d1 -> Source (state,x2) d2
foldSourceIO :: (x1 -> IO (state, x2))
-> (state -> d1 -> IO (state, d2))
-> Source x1 d1
-> Source (state, x2) d2
foldSourceIO (x1 -> IO (state, x2)
xFnIO :: x1 -> IO (state,x2))
      (state -> d1 -> IO (state, d2)
foldFnIO :: state -> d1 -> IO (state,d2))
      ((Source Client d1 -> IO x1
addClient1) :: Source x1 d1) =
   let
      addClient2 :: Client d2 -> IO (state,x2)
      addClient2 :: Client d2 -> IO (state, x2)
addClient2 Client d2
client2 =
         do
            let
               createClient :: state -> Client d1
               createClient :: state -> Client d1
createClient state
state = state -> (state -> d1 -> IO (state, d2)) -> Client d2 -> Client d1
forall state d1 d2.
state -> (state -> d1 -> IO (state, d2)) -> Client d2 -> Client d1
foldClientIO state
state state -> d1 -> IO (state, d2)
foldFnIO Client d2
client2
            (Client d1
computedClient,state -> IO ()
writeState) <- (state -> Client d1) -> IO (Client d1, state -> IO ())
forall x d. (x -> Client d) -> IO (Client d, x -> IO ())
mkComputedClient state -> Client d1
createClient
            x1
x1 <- Client d1 -> IO x1
addClient1 Client d1
computedClient

            (state
state,x2
x2) <- x1 -> IO (state, x2)
xFnIO x1
x1
            state -> IO ()
writeState state
state
            (state, x2) -> IO (state, x2)
forall (m :: * -> *) a. Monad m => a -> m a
return (state
state,x2
x2)
   in
      (Client d2 -> IO (state, x2)) -> Source (state, x2) d2
forall x d. (Client d -> IO x) -> Source x d
Source Client d2 -> IO (state, x2)
addClient2

foldClientIO
   :: state -> (state -> d1 -> IO (state,d2)) -> Client d2 -> Client d1
foldClientIO :: state -> (state -> d1 -> IO (state, d2)) -> Client d2 -> Client d1
foldClientIO state
state1 state -> d1 -> IO (state, d2)
foldFnIO (Client d2 -> IO (Maybe (Client d2))
clientFn2) =
   let
      clientFn1 :: d1 -> IO (Maybe (Client d1))
clientFn1 d1
d1 =
         do
            (state
state2,d2
d2) <- state -> d1 -> IO (state, d2)
foldFnIO state
state1 d1
d1
            (Maybe (Client d2)
newClient2Opt) <- d2 -> IO (Maybe (Client d2))
clientFn2 d2
d2
            Maybe (Client d1) -> IO (Maybe (Client d1))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Client d2 -> Client d1) -> Maybe (Client d2) -> Maybe (Client d1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
               (state -> (state -> d1 -> IO (state, d2)) -> Client d2 -> Client d1
forall state d1 d2.
state -> (state -> d1 -> IO (state, d2)) -> Client d2 -> Client d1
foldClientIO state
state2 state -> d1 -> IO (state, d2)
foldFnIO)
               Maybe (Client d2)
newClient2Opt
               )
   in
      (d1 -> IO (Maybe (Client d1))) -> Client d1
forall d. (d -> IO (Maybe (Client d))) -> Client d
Client d1 -> IO (Maybe (Client d1))
clientFn1

stepSource :: (x -> d2) -> (d1 -> d2) -> Source x d1 -> Source x d2
stepSource :: (x -> d2) -> (d1 -> d2) -> Source x d1 -> Source x d2
stepSource x -> d2
fromX d1 -> d2
fromD (Source Client d1 -> IO x
addClient1) =
   let
      addClient2 :: Client d2 -> IO x
addClient2 (Client d2 -> IO (Maybe (Client d2))
clientFn2) =
         do
            (Client d2
computedClient,Maybe (Client d2) -> IO ()
writeClientOpt) <- (Maybe (Client d2) -> IO (Maybe (Client d2)))
-> IO (Client d2, Maybe (Client d2) -> IO ())
forall x d.
(x -> IO (Maybe (Client d))) -> IO (Client d, x -> IO ())
mkComputedClientIO Maybe (Client d2) -> IO (Maybe (Client d2))
forall (m :: * -> *) a. Monad m => a -> m a
return
            x
x <- Client d1 -> IO x
addClient1 (((d1 -> d2) -> Client d2 -> Client d1
forall d1 d2. (d1 -> d2) -> Client d2 -> Client d1
coMapClient d1 -> d2
fromD) Client d2
computedClient)
            Maybe (Client d2)
clientOpt <- d2 -> IO (Maybe (Client d2))
clientFn2 (x -> d2
fromX x
x)
            Maybe (Client d2) -> IO ()
writeClientOpt Maybe (Client d2)
clientOpt
            x -> IO x
forall (m :: * -> *) a. Monad m => a -> m a
return x
x
   in
      (Client d2 -> IO x) -> Source x d2
forall x d. (Client d -> IO x) -> Source x d
Source Client d2 -> IO x
addClient2

-- | A Source combinator which \"flattens\" lists of updates.
flattenSource :: Source x [d] -> Source x d
flattenSource :: Source x [d] -> Source x d
flattenSource (Source Client [d] -> IO x
addClient1) =
   let
      addClient2 :: Client d -> IO x
addClient2 Client d
client1 = Client [d] -> IO x
addClient1 (Client d -> Client [d]
forall d. Client d -> Client [d]
flattenClient Client d
client1)
   in
      ((Client d -> IO x) -> Source x d
forall x d. (Client d -> IO x) -> Source x d
Source Client d -> IO x
addClient2)

flattenClient :: Client d -> Client [d]
flattenClient :: Client d -> Client [d]
flattenClient Client d
client0 = ([d] -> IO (Maybe (Client [d]))) -> Client [d]
forall d. (d -> IO (Maybe (Client d))) -> Client d
Client (Client d -> [d] -> IO (Maybe (Client [d]))
forall d. Client d -> [d] -> IO (Maybe (Client [d]))
mkClientFn Client d
client0)
   where
      mkClientFn :: Client d -> [d] -> IO (Maybe (Client [d]))
      mkClientFn :: Client d -> [d] -> IO (Maybe (Client [d]))
mkClientFn Client d
client0 [] = Maybe (Client [d]) -> IO (Maybe (Client [d]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Client [d] -> Maybe (Client [d])
forall a. a -> Maybe a
Just (Client d -> Client [d]
forall d. Client d -> Client [d]
flattenClient Client d
client0))
      mkClientFn (Client d -> IO (Maybe (Client d))
clientFn1) (d
d:[d]
ds) =
         do
            Maybe (Client d)
client1Opt <- d -> IO (Maybe (Client d))
clientFn1 d
d
            case Maybe (Client d)
client1Opt of
               Maybe (Client d)
Nothing -> Maybe (Client [d]) -> IO (Maybe (Client [d]))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Client [d])
forall a. Maybe a
Nothing
               Just Client d
client2 -> Client d -> [d] -> IO (Maybe (Client [d]))
forall d. Client d -> [d] -> IO (Maybe (Client [d]))
mkClientFn Client d
client2 [d]
ds

-- -----------------------------------------------------------------
-- Combinators
-- -----------------------------------------------------------------

-- Combinators
choose :: Source x1 d1 -> Source x2 d2 -> Source (x1,x2) (Either d1 d2)
choose :: Source x1 d1 -> Source x2 d2 -> Source (x1, x2) (Either d1 d2)
choose ((Source Client d1 -> IO x1
addClient1) :: Source x1 d1)
       ((Source Client d2 -> IO x2
addClient2) :: Source x2 d2) =
   let
      addClient :: Client (Either d1 d2) -> IO (x1, x2)
addClient (Client (Either d1 d2)
client :: Client (Either d1 d2)) =
         do
            (Client Either d1 d2 -> IO (Maybe (Client (Either d1 d2)))
staticClientFn) <- Client (Either d1 d2) -> IO (Client (Either d1 d2))
forall d. Client d -> IO (Client d)
mkStaticClient Client (Either d1 d2)
client
            let
               client1 :: Client d1
client1 = (d1 -> IO (Maybe (Client d1))) -> Client d1
forall d. (d -> IO (Maybe (Client d))) -> Client d
Client d1 -> IO (Maybe (Client d1))
clientFn1

               clientFn1 :: d1 -> IO (Maybe (Client d1))
clientFn1 d1
d1 =
                  do
                     Maybe (Client (Either d1 d2))
continue <- Either d1 d2 -> IO (Maybe (Client (Either d1 d2)))
staticClientFn (d1 -> Either d1 d2
forall a b. a -> Either a b
Left d1
d1)
                     Maybe (Client d1) -> IO (Maybe (Client d1))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Client (Either d1 d2) -> Client d1)
-> Maybe (Client (Either d1 d2)) -> Maybe (Client d1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ Client (Either d1 d2)
_ -> Client d1
client1) Maybe (Client (Either d1 d2))
continue)

               client2 :: Client d2
client2 = (d2 -> IO (Maybe (Client d2))) -> Client d2
forall d. (d -> IO (Maybe (Client d))) -> Client d
Client d2 -> IO (Maybe (Client d2))
clientFn2

               clientFn2 :: d2 -> IO (Maybe (Client d2))
clientFn2 d2
d2 =
                  do
                     Maybe (Client (Either d1 d2))
continue <- Either d1 d2 -> IO (Maybe (Client (Either d1 d2)))
staticClientFn (d2 -> Either d1 d2
forall a b. b -> Either a b
Right d2
d2)
                     Maybe (Client d2) -> IO (Maybe (Client d2))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Client (Either d1 d2) -> Client d2)
-> Maybe (Client (Either d1 d2)) -> Maybe (Client d2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ Client (Either d1 d2)
_ -> Client d2
client2) Maybe (Client (Either d1 d2))
continue)

            x1
x1 <- Client d1 -> IO x1
addClient1 Client d1
client1
            x2
x2 <- Client d2 -> IO x2
addClient2 Client d2
client2
            (x1, x2) -> IO (x1, x2)
forall (m :: * -> *) a. Monad m => a -> m a
return (x1
x1,x2
x2)
   in
      (Client (Either d1 d2) -> IO (x1, x2))
-> Source (x1, x2) (Either d1 d2)
forall x d. (Client d -> IO x) -> Source x d
Source Client (Either d1 d2) -> IO (x1, x2)
addClient

seqSource :: Source x1 x1 -> (x1 -> Source x2 x2) -> Source x2 x2
seqSource :: Source x1 x1 -> (x1 -> Source x2 x2) -> Source x2 x2
seqSource Source x1 x1
source x1 -> Source x2 x2
getSource = Source x1 x1 -> (x1 -> IO (Source x2 x2)) -> Source x2 x2
forall x1 x2.
Source x1 x1 -> (x1 -> IO (Source x2 x2)) -> Source x2 x2
seqSourceIO Source x1 x1
source (\ x1
x1 -> Source x2 x2 -> IO (Source x2 x2)
forall (m :: * -> *) a. Monad m => a -> m a
return (x1 -> Source x2 x2
getSource x1
x1))

seqSourceIO :: Source x1 x1 -> (x1 -> (IO (Source x2 x2))) -> Source x2 x2
seqSourceIO :: Source x1 x1 -> (x1 -> IO (Source x2 x2)) -> Source x2 x2
seqSourceIO (Source x1 x1
source1 :: Source x1 x1) (x1 -> IO (Source x2 x2)
getSource2 :: x1 -> IO (Source x2 x2)) =
   let
      addClient :: Client x2 -> IO x2
addClient Client x2
client2 =
         do
            (staticClient2 :: Client x2
staticClient2 @ (Client x2 -> IO (Maybe (Client x2))
staticClientFn),IO Bool
clientRunning)
               <- Client x2 -> IO (Client x2, IO Bool)
forall d. Client d -> IO (Client d, IO Bool)
mkStaticClientGeneral Client x2
client2

            let
               getClient1 :: (IO (),x1) -> Client x1
               getClient1 :: (IO (), x1) -> Client x1
getClient1 (IO ()
oldTerminator,x1
x1) =
                  let
                     client1 :: IO () -> Client x1
client1 IO ()
terminator = (x1 -> IO (Maybe (Client x1))) -> Client x1
forall d. (d -> IO (Maybe (Client d))) -> Client d
Client (IO () -> x1 -> IO (Maybe (Client x1))
clientFn1 IO ()
terminator)

                     clientFn1 :: IO () -> x1 -> IO (Maybe (Client x1))
clientFn1 IO ()
oldTerminator x1
x1 =
                        do
                           Source x2 x2
source2 <- x1 -> IO (Source x2 x2)
getSource2 x1
x1

                           IO ()
oldTerminator
                           Bool
continue <- IO Bool
clientRunning
                           if Bool
continue
                              then
                                 do
                                    (Client x2
staticClient2',() -> IO ()
write)
                                       <- (() -> Client x2) -> IO (Client x2, () -> IO ())
forall x d. (x -> Client d) -> IO (Client d, x -> IO ())
mkComputedClient
                                          (Client x2 -> () -> Client x2
forall a b. a -> b -> a
const Client x2
staticClient2)

                                    (x2
x2,IO ()
newTerminator)
                                       <- Client x2 -> Source x2 x2 -> IO (x2, IO ())
forall d x. Client d -> Source x d -> IO (x, IO ())
attachClientTemporary
                                             Client x2
staticClient2' Source x2 x2
source2
                                    x2 -> IO (Maybe (Client x2))
staticClientFn x2
x2
                                    () -> IO ()
write ()
                                    Maybe (Client x1) -> IO (Maybe (Client x1))
forall (m :: * -> *) a. Monad m => a -> m a
return (Client x1 -> Maybe (Client x1)
forall a. a -> Maybe a
Just (IO () -> Client x1
client1 IO ()
newTerminator))
                              else
                                 Maybe (Client x1) -> IO (Maybe (Client x1))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Client x1)
forall a. Maybe a
Nothing
                  in
                     IO () -> Client x1
client1 IO ()
oldTerminator

            (Client x1
client1',(IO (), x1) -> IO ()
write) <- ((IO (), x1) -> Client x1) -> IO (Client x1, (IO (), x1) -> IO ())
forall x d. (x -> Client d) -> IO (Client d, x -> IO ())
mkComputedClient (IO (), x1) -> Client x1
getClient1
            x1
x1 <- Client x1 -> Source x1 x1 -> IO x1
forall d x. Client d -> Source x d -> IO x
attachClient Client x1
client1' Source x1 x1
source1

            Source x2 x2
source2 <- x1 -> IO (Source x2 x2)
getSource2 x1
x1

            (x2
x2,IO ()
firstTerminator) <- Client x2 -> Source x2 x2 -> IO (x2, IO ())
forall d x. Client d -> Source x d -> IO (x, IO ())
attachClientTemporary Client x2
staticClient2 Source x2 x2
source2
            (IO (), x1) -> IO ()
write (IO ()
firstTerminator,x1
x1)
            x2 -> IO x2
forall (m :: * -> *) a. Monad m => a -> m a
return x2
x2
   in
      (Client x2 -> IO x2) -> Source x2 x2
forall x d. (Client d -> IO x) -> Source x d
Source Client x2 -> IO x2
addClient

-- -----------------------------------------------------------------
-- SimpleSource
-- -----------------------------------------------------------------

newtype SimpleSource x = SimpleSource (Source x x)

staticSimpleSource :: x -> SimpleSource x
staticSimpleSource :: x -> SimpleSource x
staticSimpleSource x
x = Source x x -> SimpleSource x
forall x. Source x x -> SimpleSource x
SimpleSource (x -> Source x x
forall x d. x -> Source x d
staticSource x
x)

staticSimpleSourceIO :: IO x -> SimpleSource x
staticSimpleSourceIO :: IO x -> SimpleSource x
staticSimpleSourceIO IO x
act = Source x x -> SimpleSource x
forall x. Source x x -> SimpleSource x
SimpleSource (IO x -> Source x x
forall x d. IO x -> Source x d
staticSourceIO IO x
act)

instance Functor SimpleSource where
   fmap :: (a -> b) -> SimpleSource a -> SimpleSource b
fmap a -> b
mapFn (SimpleSource Source a a
source) =
      Source b b -> SimpleSource b
forall x. Source x x -> SimpleSource x
SimpleSource ( ((a -> b) -> Source a b -> Source b b
forall x1 x2 d. (x1 -> x2) -> Source x1 d -> Source x2 d
map1 a -> b
mapFn) (Source a b -> Source b b)
-> (Source a a -> Source a b) -> Source a a -> Source b b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> b) -> Source a a -> Source a b
forall d1 d2 x. (d1 -> d2) -> Source x d1 -> Source x d2
map2 a -> b
mapFn) (Source a a -> Source b b) -> Source a a -> Source b b
forall a b. (a -> b) -> a -> b
$ Source a a
source)

instance HasMapIO SimpleSource where
   mapIO :: (a -> IO b) -> SimpleSource a -> SimpleSource b
mapIO a -> IO b
mapFn (SimpleSource Source a a
source) =
      Source b b -> SimpleSource b
forall x. Source x x -> SimpleSource x
SimpleSource (
         ((a -> IO b) -> Source a b -> Source b b
forall x1 x2 d. (x1 -> IO x2) -> Source x1 d -> Source x2 d
map1IO a -> IO b
mapFn)
         (Source a b -> Source b b)
-> (Source a a -> Source a b) -> Source a a -> Source b b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> IO (Maybe b)) -> Source a a -> Source a b
forall d1 d2 x. (d1 -> IO (Maybe d2)) -> Source x d1 -> Source x d2
filter2IO
            (\ a
x ->
               do
                  b
y <- a -> IO b
mapFn a
x
                  Maybe b -> IO (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Maybe b
forall a. a -> Maybe a
Just b
y)
               )
            )
         (Source a a -> Source b b) -> Source a a -> Source b b
forall a b. (a -> b) -> a -> b
$ Source a a
source
         )


mapIOSeq :: SimpleSource a -> (a -> IO (SimpleSource b)) -> SimpleSource b
mapIOSeq :: SimpleSource a -> (a -> IO (SimpleSource b)) -> SimpleSource b
mapIOSeq (SimpleSource (Source a a
source1 :: Source a a))
      (a -> IO (SimpleSource b)
getSimpleSource :: (a -> IO (SimpleSource b))) =
   let
      getSource :: a -> IO (Source b b)
      getSource :: a -> IO (Source b b)
getSource a
a =
         do
            (SimpleSource Source b b
source) <- a -> IO (SimpleSource b)
getSimpleSource a
a
            Source b b -> IO (Source b b)
forall (m :: * -> *) a. Monad m => a -> m a
return Source b b
source

      source2 :: Source b b
      source2 :: Source b b
source2 = Source a a -> (a -> IO (Source b b)) -> Source b b
forall x1 x2.
Source x1 x1 -> (x1 -> IO (Source x2 x2)) -> Source x2 x2
seqSourceIO Source a a
source1 a -> IO (Source b b)
getSource
   in
      Source b b -> SimpleSource b
forall x. Source x x -> SimpleSource x
SimpleSource Source b b
source2

instance Applicative SimpleSource where
   pure :: a -> SimpleSource a
pure = a -> SimpleSource a
forall (m :: * -> *) a. Monad m => a -> m a
return
   <*> :: SimpleSource (a -> b) -> SimpleSource a -> SimpleSource b
(<*>) = SimpleSource (a -> b) -> SimpleSource a -> SimpleSource b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad SimpleSource where
   return :: a -> SimpleSource a
return a
x = Source a a -> SimpleSource a
forall x. Source x x -> SimpleSource x
SimpleSource (a -> Source a a
forall x d. x -> Source x d
staticSource a
x)
   >>= :: SimpleSource a -> (a -> SimpleSource b) -> SimpleSource b
(>>=) (SimpleSource Source a a
source1) a -> SimpleSource b
getSimpleSource2 =
      let
         getSource2 :: a -> Source b b
getSource2 a
x =
            let
               (SimpleSource Source b b
source2) = a -> SimpleSource b
getSimpleSource2 a
x
            in
               Source b b
source2
      in
         Source b b -> SimpleSource b
forall x. Source x x -> SimpleSource x
SimpleSource (Source a a -> (a -> Source b b) -> Source b b
forall x1 x2. Source x1 x1 -> (x1 -> Source x2 x2) -> Source x2 x2
seqSource Source a a
source1 a -> Source b b
getSource2)

-- -----------------------------------------------------------------
-- The HasSource and HasSimpleSource classes and their instances
-- -----------------------------------------------------------------

class HasSource hasSource x d | hasSource -> x,hasSource -> d where
   toSource :: hasSource -> Source x d

class HasSimpleSource hasSource x | hasSource -> x where
   toSimpleSource :: hasSource -> SimpleSource x

instance HasSource (Source x d) x d where
   toSource :: Source x d -> Source x d
toSource Source x d
source = Source x d
source

instance HasSimpleSource (SimpleSource x) x where
   toSimpleSource :: SimpleSource x -> SimpleSource x
toSimpleSource SimpleSource x
simpleSource = SimpleSource x
simpleSource

instance HasSource (SimpleSource x) x x where
   toSource :: SimpleSource x -> Source x x
toSource (SimpleSource Source x x
source) = Source x x
source

-- -----------------------------------------------------------------
-- The readContents function
-- -----------------------------------------------------------------

-- | Get the current contents of the source, but don\'t specify any other
-- action.
readContents :: HasSource source x d => source -> IO x
readContents :: source -> IO x
readContents source
hasSource =
   let
      trivialClient :: Client d
trivialClient = (d -> IO (Maybe (Client d))) -> Client d
forall d. (d -> IO (Maybe (Client d))) -> Client d
Client (\ d
_ -> Maybe (Client d) -> IO (Maybe (Client d))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Client d)
forall a. Maybe a
Nothing)
   in
      Client d -> Source x d -> IO x
forall d x. Client d -> Source x d -> IO x
attachClient Client d
forall d. Client d
trivialClient (source -> Source x d
forall hasSource x d.
HasSource hasSource x d =>
hasSource -> Source x d
toSource source
hasSource)

-- -----------------------------------------------------------------
-- Instance of CanAddSinks
-- -----------------------------------------------------------------

instance HasSource hasSource x d => CanAddSinks hasSource x d where
   addOldSink :: hasSource -> Sink d -> IO x
addOldSink hasSource
hasSource Sink d
sink =
      do
         let
            client :: Client d
client = (d -> IO (Maybe (Client d))) -> Client d
forall d. (d -> IO (Maybe (Client d))) -> Client d
Client d -> IO (Maybe (Client d))
clientFn

            clientFn :: d -> IO (Maybe (Client d))
clientFn d
d =
               do
                  Bool
continue <- Sink d -> d -> IO Bool
forall x. Sink x -> x -> IO Bool
putSink Sink d
sink d
d
                  Maybe (Client d) -> IO (Maybe (Client d))
forall (m :: * -> *) a. Monad m => a -> m a
return (if Bool
continue
                     then
                        Client d -> Maybe (Client d)
forall a. a -> Maybe a
Just Client d
client
                     else
                        Maybe (Client d)
forall a. Maybe a
Nothing
                     )
         Client d -> Source x d -> IO x
forall d x. Client d -> Source x d -> IO x
attachClient Client d
client (hasSource -> Source x d
forall hasSource x d.
HasSource hasSource x d =>
hasSource -> Source x d
toSource hasSource
hasSource)

-- -----------------------------------------------------------------
-- Other handy utilities
-- -----------------------------------------------------------------

-- | Pair two SimpleSource\'s.  This is probably better than using >>=, since it
-- does not require reregistering with the second SimpleSource
pairSimpleSources :: SimpleSource x1 -> SimpleSource x2 -> SimpleSource (x1,x2)
pairSimpleSources :: SimpleSource x1 -> SimpleSource x2 -> SimpleSource (x1, x2)
pairSimpleSources (SimpleSource Source x1 x1
source1) (SimpleSource Source x2 x2
source2) =
   let
      sourceChoose :: Source (x1, x2) (Either x1 x2)
sourceChoose = Source x1 x1 -> Source x2 x2 -> Source (x1, x2) (Either x1 x2)
forall x1 d1 x2 d2.
Source x1 d1 -> Source x2 d2 -> Source (x1, x2) (Either d1 d2)
choose Source x1 x1
source1 Source x2 x2
source2
      source :: Source ((x1, x2), (x1, x2)) (x1, x2)
source =
         ((x1, x2) -> (x1, x2))
-> ((x1, x2) -> Either x1 x2 -> ((x1, x2), (x1, x2)))
-> Source (x1, x2) (Either x1 x2)
-> Source ((x1, x2), (x1, x2)) (x1, x2)
forall x state d1 d2.
(x -> state)
-> (state -> d1 -> (state, d2))
-> Source x d1
-> Source (state, x) d2
foldSource
            (x1, x2) -> (x1, x2)
forall a. a -> a
id
            (\ (x1
x1,x2
x2) Either x1 x2
change ->
               let
                  new :: (x1, x2)
new = case Either x1 x2
change of
                     Left newX1 -> (x1
newX1,x2
x2)
                     Right newX2 -> (x1
x1,x2
newX2)
               in
                  ((x1, x2)
new,(x1, x2)
new)
               )
            Source (x1, x2) (Either x1 x2)
sourceChoose
   in
      Source (x1, x2) (x1, x2) -> SimpleSource (x1, x2)
forall x. Source x x -> SimpleSource x
SimpleSource ((((x1, x2), (x1, x2)) -> (x1, x2))
-> Source ((x1, x2), (x1, x2)) (x1, x2) -> Source (x1, x2) (x1, x2)
forall x1 x2 d. (x1 -> x2) -> Source x1 d -> Source x2 d
map1 ((x1, x2), (x1, x2)) -> (x1, x2)
forall a b. (a, b) -> a
fst Source ((x1, x2), (x1, x2)) (x1, x2)
source)

-- | Does a similar job to pairSimpleSources, so that the sources run
-- parallel.
sequenceSimpleSource :: [SimpleSource x] -> SimpleSource [x]
sequenceSimpleSource :: [SimpleSource x] -> SimpleSource [x]
sequenceSimpleSource [] = [x] -> SimpleSource [x]
forall (m :: * -> *) a. Monad m => a -> m a
return []
sequenceSimpleSource (SimpleSource x
first:[SimpleSource x]
rest) =
   ((x, [x]) -> [x]) -> SimpleSource (x, [x]) -> SimpleSource [x]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((x -> [x] -> [x]) -> (x, [x]) -> [x]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:)) (SimpleSource x -> SimpleSource [x] -> SimpleSource (x, [x])
forall x1 x2.
SimpleSource x1 -> SimpleSource x2 -> SimpleSource (x1, x2)
pairSimpleSources SimpleSource x
first ([SimpleSource x] -> SimpleSource [x]
forall x. [SimpleSource x] -> SimpleSource [x]
sequenceSimpleSource [SimpleSource x]
rest))

-- | For each update d, pairs it with its predecessor (given first).
-- For the very first update, a value is given based on the initial x,
-- mapped by the given function.
mkHistorySource :: (x -> d) -> Source x d -> Source x (d,d)
mkHistorySource :: (x -> d) -> Source x d -> Source x (d, d)
mkHistorySource x -> d
getD Source x d
source =
   ((d, x) -> x) -> Source (d, x) (d, d) -> Source x (d, d)
forall x1 x2 d. (x1 -> x2) -> Source x1 d -> Source x2 d
map1 (\ (d
d,x
x) -> x
x) ((x -> d)
-> (d -> d -> (d, (d, d))) -> Source x d -> Source (d, x) (d, d)
forall x state d1 d2.
(x -> state)
-> (state -> d1 -> (state, d2))
-> Source x d1
-> Source (state, x) d2
foldSource x -> d
getD (\ d
lastD d
d -> (d
d,(d
lastD,d
d))) Source x d
source)

-- | Like mkHistorySource but for SimpleSource\'s; the x returns the initial
-- value to compare with.
mkHistorySimpleSource :: x -> SimpleSource x -> SimpleSource (x,x)
mkHistorySimpleSource :: x -> SimpleSource x -> SimpleSource (x, x)
mkHistorySimpleSource x
lastX (SimpleSource Source x x
source) =
   Source (x, x) (x, x) -> SimpleSource (x, x)
forall x. Source x x -> SimpleSource x
SimpleSource ((x -> (x, x)) -> Source x (x, x) -> Source (x, x) (x, x)
forall x1 x2 d. (x1 -> x2) -> Source x1 d -> Source x2 d
map1 (\ x
x -> (x
lastX,x
x)) ((x -> x) -> Source x x -> Source x (x, x)
forall x d. (x -> d) -> Source x d -> Source x (d, d)
mkHistorySource x -> x
forall a. a -> a
id Source x x
source))

-- | filter out consecutive duplicates
uniqSimpleSource :: Eq x => SimpleSource x -> SimpleSource x
uniqSimpleSource :: SimpleSource x -> SimpleSource x
uniqSimpleSource (SimpleSource Source x x
source0) =
   let
      source1 :: Source x (x, x)
source1 = (x -> x) -> Source x x -> Source x (x, x)
forall x d. (x -> d) -> Source x d -> Source x (d, d)
mkHistorySource x -> x
forall a. a -> a
id Source x x
source0
      source2 :: Source x x
source2 = ((x, x) -> Maybe x) -> Source x (x, x) -> Source x x
forall d1 d2 x. (d1 -> Maybe d2) -> Source x d1 -> Source x d2
filter2 (\ (x
lastD,x
d) -> if x
lastD x -> x -> Bool
forall a. Eq a => a -> a -> Bool
== x
d then Maybe x
forall a. Maybe a
Nothing else x -> Maybe x
forall a. a -> Maybe a
Just x
d)
         Source x (x, x)
source1
   in
      Source x x -> SimpleSource x
forall x. Source x x -> SimpleSource x
SimpleSource Source x x
source2


-- | Fold a Simple Source, so that it carries state.
-- The state is recomputed for each client.
foldSimpleSourceIO :: (x1 -> IO (state,x2)) -> (state -> x1 -> IO (state,x2))
   -> SimpleSource x1 -> SimpleSource x2
foldSimpleSourceIO :: (x1 -> IO (state, x2))
-> (state -> x1 -> IO (state, x2))
-> SimpleSource x1
-> SimpleSource x2
foldSimpleSourceIO (x1 -> IO (state, x2)
getStateIO :: x1 -> IO (state,x2)) state -> x1 -> IO (state, x2)
updateStateIO
      (SimpleSource (Source x1 x1
source :: Source x1 x1)) =
   let
      source1 :: Source (state,x2) x2
      source1 :: Source (state, x2) x2
source1 = (x1 -> IO (state, x2))
-> (state -> x1 -> IO (state, x2))
-> Source x1 x1
-> Source (state, x2) x2
forall x1 state x2 d1 d2.
(x1 -> IO (state, x2))
-> (state -> d1 -> IO (state, d2))
-> Source x1 d1
-> Source (state, x2) d2
foldSourceIO x1 -> IO (state, x2)
getStateIO state -> x1 -> IO (state, x2)
updateStateIO Source x1 x1
source
   in
      Source x2 x2 -> SimpleSource x2
forall x. Source x x -> SimpleSource x
SimpleSource (((state, x2) -> x2) -> Source (state, x2) x2 -> Source x2 x2
forall x1 x2 d. (x1 -> x2) -> Source x1 d -> Source x2 d
map1 (state, x2) -> x2
forall a b. (a, b) -> b
snd Source (state, x2) x2
source1)

-- | replaces the first value of the SimpleSource.
change1 :: SimpleSource x -> x -> SimpleSource x
change1 :: SimpleSource x -> x -> SimpleSource x
change1 (SimpleSource Source x x
source) x
x = Source x x -> SimpleSource x
forall x. Source x x -> SimpleSource x
SimpleSource ((x -> x) -> Source x x -> Source x x
forall x1 x2 d. (x1 -> x2) -> Source x1 d -> Source x2 d
map1 (\ x
_ -> x
x) Source x x
source)

-- | Run the specified actions for the source, using the given SinkID and
-- in the ParallelExec thread.
-- The x -> IO () action is guaranteed to be performed before any of the
-- d -> IO () actions.
addNewSourceActions :: Source x d -> (x -> IO ()) -> (d -> IO ())
   -> SinkID -> ParallelExec -> IO x
addNewSourceActions :: Source x d
-> (x -> IO ()) -> (d -> IO ()) -> SinkID -> ParallelExec -> IO x
addNewSourceActions (Source x d
source1 :: Source x d) x -> IO ()
actionX d -> IO ()
actionD SinkID
sinkID ParallelExec
parallelX =
   do
      MVar x
mVar <- IO (MVar x)
forall a. IO (MVar a)
newEmptyMVar -- used to return the first x value
      let
         actionX' :: x -> IO ()
actionX' x
x =
            do
               MVar x -> x -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar x
mVar x
x
               x -> IO ()
actionX x
x

         (Source x (IO ())
source2 :: Source x (IO ())) = (x -> IO ()) -> (d -> IO ()) -> Source x d -> Source x (IO ())
forall x d2 d1.
(x -> d2) -> (d1 -> d2) -> Source x d1 -> Source x d2
stepSource x -> IO ()
actionX' d -> IO ()
actionD Source x d
source1
      Source x (IO ())
-> (IO () -> IO ()) -> SinkID -> IO (x, Sink (IO ()))
forall sinkSource x delta.
CanAddSinks sinkSource x delta =>
sinkSource -> (delta -> IO ()) -> SinkID -> IO (x, Sink delta)
addNewQuickSinkGeneral
         Source x (IO ())
source2
         (\ IO ()
action -> ParallelExec -> IO () -> IO ()
parallelExec ParallelExec
parallelX IO ()
action)
         SinkID
sinkID
      MVar x -> IO x
forall a. MVar a -> IO a
takeMVar MVar x
mVar

-- -----------------------------------------------------------------
-- Trace functions
-- -----------------------------------------------------------------

-- | Outputs information about what comes through the source, turning
-- it into a String with the supplied function.  (This is done once
-- for each active client.)
traceSimpleSource :: (a -> String) -> SimpleSource a -> SimpleSource a
traceSimpleSource :: (a -> String) -> SimpleSource a -> SimpleSource a
traceSimpleSource a -> String
toS (SimpleSource Source a a
source) =
   Source a a -> SimpleSource a
forall x. Source x x -> SimpleSource x
SimpleSource (
      ((a -> IO a) -> Source a a -> Source a a
forall x1 x2 d. (x1 -> IO x2) -> Source x1 d -> Source x2 d
map1IO
         (\ a
a ->
            do
               String -> IO ()
putStrLn (String
"Initialising "String -> String -> String
forall a. [a] -> [a] -> [a]
++a -> String
toS a
a)
               a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
            )
         )
      (Source a a -> Source a a)
-> (Source a a -> Source a a) -> Source a a -> Source a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      ((a -> IO (Maybe a)) -> Source a a -> Source a a
forall d1 d2 x. (d1 -> IO (Maybe d2)) -> Source x d1 -> Source x d2
filter2IO
         (\ a
a ->
            do
               String -> IO ()
putStrLn (String
"Updating "String -> String -> String
forall a. [a] -> [a] -> [a]
++a -> String
toS a
a)
               Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
a)
            )
         )
      (Source a a -> Source a a) -> Source a a -> Source a a
forall a b. (a -> b) -> a -> b
$
      Source a a
source
      )

-- | Outputs information about what comes through the source, turning
-- it into a String with the supplied function.  (This is done once
-- for each active client.)
traceSource :: (a -> String) -> (d -> String) -> Source a d -> Source a d
traceSource :: (a -> String) -> (d -> String) -> Source a d -> Source a d
traceSource a -> String
toS1 d -> String
toS2 Source a d
source =
   ((a -> IO a) -> Source a d -> Source a d
forall x1 x2 d. (x1 -> IO x2) -> Source x1 d -> Source x2 d
map1IO
      (\ a
a ->
         do
            String -> IO ()
putStrLn (String
"Initialising "String -> String -> String
forall a. [a] -> [a] -> [a]
++a -> String
toS1 a
a)
            a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
         )
      )
   (Source a d -> Source a d)
-> (Source a d -> Source a d) -> Source a d -> Source a d
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   ((d -> IO (Maybe d)) -> Source a d -> Source a d
forall d1 d2 x. (d1 -> IO (Maybe d2)) -> Source x d1 -> Source x d2
filter2IO
      (\ d
d ->
         do
            String -> IO ()
putStrLn (String
"Updating "String -> String -> String
forall a. [a] -> [a] -> [a]
++d -> String
toS2 d
d)
            Maybe d -> IO (Maybe d)
forall (m :: * -> *) a. Monad m => a -> m a
return (d -> Maybe d
forall a. a -> Maybe a
Just d
d)
         )
      )
   (Source a d -> Source a d) -> Source a d -> Source a d
forall a b. (a -> b) -> a -> b
$
   Source a d
source

-- -----------------------------------------------------------------
-- noLoop functions.  (Only noLoopSimpleSource is exported, for now.)
-- -----------------------------------------------------------------

noLoopSource :: TSem -> ([String] -> x) -> ([String] -> d)
   -> Source x d -> Source x d
noLoopSource :: TSem
-> ([String] -> x) -> ([String] -> d) -> Source x d -> Source x d
noLoopSource TSem
tSem [String] -> x
toX [String] -> d
toD (Source Client d -> IO x
addClient0 :: Source x d) =
   let
      mkClient :: Client d -> Client d
      mkClient :: Client d -> Client d
mkClient Client d
client = (d -> IO (Maybe (Client d))) -> Client d
forall d. (d -> IO (Maybe (Client d))) -> Client d
Client (Client d -> d -> IO (Maybe (Client d))
mkClientFn Client d
client)

      mkClientFn :: Client d -> d -> IO (Maybe (Client d))
      mkClientFn :: Client d -> d -> IO (Maybe (Client d))
mkClientFn (client :: Client d
client @ (Client d -> IO (Maybe (Client d))
clientFn0)) d
d =
         do
            (Either [String] (Maybe (Client d))
looped :: Either [String] (Maybe (Client d)))
               <- TSem
-> IO (Maybe (Client d)) -> IO (Either [String] (Maybe (Client d)))
forall a. TSem -> IO a -> IO (Either [String] a)
synchronizeTSem TSem
tSem (d -> IO (Maybe (Client d))
clientFn0 d
d)
            case Either [String] (Maybe (Client d))
looped of
               Left [String]
strings ->
                  do
                     String -> IO ()
forall a. Show a => a -> IO ()
debug (String
"mkClientFn loop caught " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
strings)
                     -- repeat with the artificial d (which had better
                     -- not cause a loop).
                     Client d -> d -> IO (Maybe (Client d))
mkClientFn Client d
client ([String] -> d
toD [String]
strings)
               Right Maybe (Client d)
clientOpt -> Maybe (Client d) -> IO (Maybe (Client d))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Client d -> Client d) -> Maybe (Client d) -> Maybe (Client d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Client d -> Client d
mkClient Maybe (Client d)
clientOpt)

      addClient1 :: Client d -> IO x
      addClient1 :: Client d -> IO x
addClient1 Client d
client =
         do
            Either [String] x
stringsOrX <- TSem -> IO x -> IO (Either [String] x)
forall a. TSem -> IO a -> IO (Either [String] a)
synchronizeTSem TSem
tSem
               (Client d -> IO x
addClient0 (Client d -> Client d
mkClient Client d
client))
            case Either [String] x
stringsOrX of
               Left [String]
strings -> x -> IO x
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> x
toX [String]
strings)
               Right x
x -> x -> IO x
forall (m :: * -> *) a. Monad m => a -> m a
return x
x
   in
      (Client d -> IO x) -> Source x d
forall x d. (Client d -> IO x) -> Source x d
Source Client d -> IO x
addClient1

-- | Used when we are worried that a SimpleSource recursively constructed
-- by mapIOSeq, >>= and friends may actually try to call itself, and
-- so loop forever.   The Strings identify the SimpleSource,
-- and so the [String] is effectively a backtrace of the TSems, revealing what
-- chain of simple sources might have caused the loop.
noLoopSimpleSource :: TSem -> ([String] -> a) -> SimpleSource a
   -> SimpleSource a
noLoopSimpleSource :: TSem -> ([String] -> a) -> SimpleSource a -> SimpleSource a
noLoopSimpleSource TSem
tSem [String] -> a
toA (SimpleSource Source a a
source0) =
   let
      source1 :: Source a a
source1 = TSem
-> ([String] -> a) -> ([String] -> a) -> Source a a -> Source a a
forall x d.
TSem
-> ([String] -> x) -> ([String] -> d) -> Source x d -> Source x d
noLoopSource TSem
tSem [String] -> a
toA [String] -> a
toA Source a a
source0
   in
      Source a a -> SimpleSource a
forall x. Source x x -> SimpleSource x
SimpleSource Source a a
source1

-- ---------------------------------------------------------------------------
-- mkIOSource and mkIOSimpleSource
-- ---------------------------------------------------------------------------

mkIOSource :: IO (Source x d) -> Source x d
mkIOSource :: IO (Source x d) -> Source x d
mkIOSource IO (Source x d)
act =
   let
      addClient :: Client d -> IO x
addClient Client d
client =
         do
            (Source Client d -> IO x
addClient1) <- IO (Source x d)
act
            Client d -> IO x
addClient1 Client d
client
   in
      (Client d -> IO x) -> Source x d
forall x d. (Client d -> IO x) -> Source x d
Source Client d -> IO x
addClient

mkIOSimpleSource :: IO (SimpleSource a) -> SimpleSource a
mkIOSimpleSource :: IO (SimpleSource a) -> SimpleSource a
mkIOSimpleSource IO (SimpleSource a)
act =
   Source a a -> SimpleSource a
forall x. Source x x -> SimpleSource x
SimpleSource (IO (Source a a) -> Source a a
forall x d. IO (Source x d) -> Source x d
mkIOSource (
      do
         SimpleSource a
simpleSource <- IO (SimpleSource a)
act
         Source a a -> IO (Source a a)
forall (m :: * -> *) a. Monad m => a -> m a
return (SimpleSource a -> Source a a
forall hasSource x d.
HasSource hasSource x d =>
hasSource -> Source x d
toSource SimpleSource a
simpleSource)
      ))