{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
module Util.Sources(
Source,
Client,
staticSource,
staticSourceIO,
variableSource,
variableGeneralSource,
Updater,
applyToUpdater,
attachClient,
map1,
map1IO,
map2,
filter2,
filter2IO,
foldSource,
foldSourceIO,
stepSource,
choose,
seqSource,
flattenSource,
SimpleSource(..),
staticSimpleSource,
staticSimpleSourceIO,
HasSource(..),
HasSimpleSource(..),
readContents,
mkHistorySource,
mkHistorySimpleSource,
uniqSimpleSource,
pairSimpleSources,
sequenceSimpleSource,
change1,
mapIOSeq,
addNewSourceActions,
traceSimpleSource,
traceSource,
noLoopSimpleSource,
mkIOSimpleSource,
foldSimpleSourceIO,
) 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)
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)
}
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
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 :: 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 :: 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
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 :: (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)
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 :: 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 :: 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)
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
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
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
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
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)
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
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 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)
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)
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))
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)
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))
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
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)
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)
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
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
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
)
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
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)
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
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 :: 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)
))