{-# LANGUAGE DeriveAnyClass      #-}
{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE FlexibleContexts       #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE PolyKinds           #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeFamilies        #-}

-- | An 'ExtVar' is an 'MVar' that can be accessed by an external
-- client. The "host" is the machine where the underlying 'MVar'
-- exists. The host can continue to use the underlying 'MVar' as
-- usual. A client can interact with it via functions like
-- 'takeExtVar', 'putExtVar', 'readExtVar', etc., which behave in the
-- same way as their 'MVar' counterparts. An 'ExtVar' can be
-- recontstructed from its representation as a String or serialized
-- to/from Binary data (and hence sent across a network).
--
-- For an example of using an 'ExtVar' as a client, look in the hosts
-- logs for a line that looks like:
--
-- > [Thu 01/06/22 13:04:17] New ExtVar: extVar @Int "login1.cm.cluster:39443:0" "test"
--
-- This shows that the host machine has made an ExtVar and it is ready
-- to be accessed by a client.  Now in a GHCi session (possibly on a
-- completely different machine), you can do:
--
-- >>> eVar = extVar @Int "login1.cm.cluster:39443:0" "test"
-- >>> tryReadExtVarIO eVar
-- Just 42
-- >>> modifyExtVarIO_ eVar (\x -> pure (x+1))
-- ()
-- >>> tryReadExtVarIO eVar
-- Just 43
--
module Hyperion.ExtVar
  ( ExtVar
  , extVar
  , newExtVar
  , newEmptyExtVar
  , makeExtVar
  , killExtVar
  , takeExtVar
  , tryTakeExtVar
  , putExtVar
  , tryPutExtVar
  , readExtVar
  , tryReadExtVar
  , withExtVar
  , modifyExtVar_
  , modifyExtVar
  , takeExtVarIO
  , tryTakeExtVarIO
  , putExtVarIO
  , tryPutExtVarIO
  , readExtVarIO
  , tryReadExtVarIO
  , withExtVarIO
  , modifyExtVarIO_
  , modifyExtVarIO
  , newExtVarStream
  ) where

import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Base (MonadBase, liftBase)
import           Control.Concurrent.MVar     (MVar, newEmptyMVar, newMVar, modifyMVar,
                                              putMVar, readMVar, takeMVar,
                                              tryPutMVar, tryReadMVar,
                                              tryTakeMVar)
import           Control.Distributed.Process (NodeId (..), Process, SendPort,
                                              expect, getSelfPid, liftIO,
                                              newChan, nsendRemote,
                                              processNodeId, receiveChan,
                                              register, sendChan, spawnLocal)
import           Control.Monad               (void)
import           Control.Monad.Catch         (bracket, mask, onException)
import           Data.Binary                 (Binary, decodeOrFail, encode)
import           Data.ByteString             (ByteString)
import           Data.IORef                  (IORef, atomicModifyIORef',
                                              newIORef)
import           Data.Text                   (Text, pack)
import           GHC.Generics                (Generic)
import qualified Hyperion.Log                as Log
import           Hyperion.Remote             (runProcessLocal)
import           Network.Transport           (EndPointAddress (..))
import           System.IO.Unsafe            (unsafePerformIO)
import           Type.Reflection             (Typeable, typeRep)


data ExtVar a = MkExtVar NodeId String
  deriving (ExtVar a -> ExtVar a -> Bool
(ExtVar a -> ExtVar a -> Bool)
-> (ExtVar a -> ExtVar a -> Bool) -> Eq (ExtVar a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (a :: k). ExtVar a -> ExtVar a -> Bool
/= :: ExtVar a -> ExtVar a -> Bool
$c/= :: forall k (a :: k). ExtVar a -> ExtVar a -> Bool
== :: ExtVar a -> ExtVar a -> Bool
$c== :: forall k (a :: k). ExtVar a -> ExtVar a -> Bool
Eq, Eq (ExtVar a)
Eq (ExtVar a)
-> (ExtVar a -> ExtVar a -> Ordering)
-> (ExtVar a -> ExtVar a -> Bool)
-> (ExtVar a -> ExtVar a -> Bool)
-> (ExtVar a -> ExtVar a -> Bool)
-> (ExtVar a -> ExtVar a -> Bool)
-> (ExtVar a -> ExtVar a -> ExtVar a)
-> (ExtVar a -> ExtVar a -> ExtVar a)
-> Ord (ExtVar a)
ExtVar a -> ExtVar a -> Bool
ExtVar a -> ExtVar a -> Ordering
ExtVar a -> ExtVar a -> ExtVar a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k (a :: k). Eq (ExtVar a)
forall k (a :: k). ExtVar a -> ExtVar a -> Bool
forall k (a :: k). ExtVar a -> ExtVar a -> Ordering
forall k (a :: k). ExtVar a -> ExtVar a -> ExtVar a
min :: ExtVar a -> ExtVar a -> ExtVar a
$cmin :: forall k (a :: k). ExtVar a -> ExtVar a -> ExtVar a
max :: ExtVar a -> ExtVar a -> ExtVar a
$cmax :: forall k (a :: k). ExtVar a -> ExtVar a -> ExtVar a
>= :: ExtVar a -> ExtVar a -> Bool
$c>= :: forall k (a :: k). ExtVar a -> ExtVar a -> Bool
> :: ExtVar a -> ExtVar a -> Bool
$c> :: forall k (a :: k). ExtVar a -> ExtVar a -> Bool
<= :: ExtVar a -> ExtVar a -> Bool
$c<= :: forall k (a :: k). ExtVar a -> ExtVar a -> Bool
< :: ExtVar a -> ExtVar a -> Bool
$c< :: forall k (a :: k). ExtVar a -> ExtVar a -> Bool
compare :: ExtVar a -> ExtVar a -> Ordering
$ccompare :: forall k (a :: k). ExtVar a -> ExtVar a -> Ordering
$cp1Ord :: forall k (a :: k). Eq (ExtVar a)
Ord, (forall x. ExtVar a -> Rep (ExtVar a) x)
-> (forall x. Rep (ExtVar a) x -> ExtVar a) -> Generic (ExtVar a)
forall x. Rep (ExtVar a) x -> ExtVar a
forall x. ExtVar a -> Rep (ExtVar a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (a :: k) x. Rep (ExtVar a) x -> ExtVar a
forall k (a :: k) x. ExtVar a -> Rep (ExtVar a) x
$cto :: forall k (a :: k) x. Rep (ExtVar a) x -> ExtVar a
$cfrom :: forall k (a :: k) x. ExtVar a -> Rep (ExtVar a) x
Generic, Get (ExtVar a)
[ExtVar a] -> Put
ExtVar a -> Put
(ExtVar a -> Put)
-> Get (ExtVar a) -> ([ExtVar a] -> Put) -> Binary (ExtVar a)
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
forall k (a :: k). Get (ExtVar a)
forall k (a :: k). [ExtVar a] -> Put
forall k (a :: k). ExtVar a -> Put
putList :: [ExtVar a] -> Put
$cputList :: forall k (a :: k). [ExtVar a] -> Put
get :: Get (ExtVar a)
$cget :: forall k (a :: k). Get (ExtVar a)
put :: ExtVar a -> Put
$cput :: forall k (a :: k). ExtVar a -> Put
Binary)

instance Typeable a => Show (ExtVar a) where
  showsPrec :: Int -> ExtVar a -> ShowS
showsPrec Int
d (MkExtVar (NodeId (EndPointAddress ByteString
address)) String
name) =
    Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString String
"extVar @" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Int -> TypeRep a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 (Typeable a => TypeRep a
forall k (a :: k). Typeable a => TypeRep a
typeRep @a) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ByteString -> ShowS
forall a. Show a => a -> ShowS
shows ByteString
address ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    String -> ShowS
forall a. Show a => a -> ShowS
shows String
name

-- | 'ExtVar' from an address and a name. To see what arguments you
-- should pass to 'extVar', it is best to look for the "Made ExtVar"
-- entry in the log of the host machine.
extVar
  :: ByteString -- ^ End point address.
  -> String     -- ^ Name of the ExtVar
  -> ExtVar a
extVar :: ByteString -> String -> ExtVar a
extVar ByteString
address String
name = NodeId -> String -> ExtVar a
forall k (a :: k). NodeId -> String -> ExtVar a
MkExtVar (EndPointAddress -> NodeId
NodeId (EndPointAddress -> NodeId) -> EndPointAddress -> NodeId
forall a b. (a -> b) -> a -> b
$ ByteString -> EndPointAddress
EndPointAddress ByteString
address) String
name

data ExtVarMessage a
  = Take     (SendPort a)
  | TryTake  (SendPort (Maybe a))
  | Put    a (SendPort ())
  | TryPut a (SendPort Bool)
  | Read     (SendPort a)
  | TryRead  (SendPort (Maybe a))
  | Shutdown
  deriving ((forall x. ExtVarMessage a -> Rep (ExtVarMessage a) x)
-> (forall x. Rep (ExtVarMessage a) x -> ExtVarMessage a)
-> Generic (ExtVarMessage a)
forall x. Rep (ExtVarMessage a) x -> ExtVarMessage a
forall x. ExtVarMessage a -> Rep (ExtVarMessage a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ExtVarMessage a) x -> ExtVarMessage a
forall a x. ExtVarMessage a -> Rep (ExtVarMessage a) x
$cto :: forall a x. Rep (ExtVarMessage a) x -> ExtVarMessage a
$cfrom :: forall a x. ExtVarMessage a -> Rep (ExtVarMessage a) x
Generic, Get (ExtVarMessage a)
[ExtVarMessage a] -> Put
ExtVarMessage a -> Put
(ExtVarMessage a -> Put)
-> Get (ExtVarMessage a)
-> ([ExtVarMessage a] -> Put)
-> Binary (ExtVarMessage a)
forall a. (Binary a, Typeable a) => Get (ExtVarMessage a)
forall a. (Binary a, Typeable a) => [ExtVarMessage a] -> Put
forall a. (Binary a, Typeable a) => ExtVarMessage a -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [ExtVarMessage a] -> Put
$cputList :: forall a. (Binary a, Typeable a) => [ExtVarMessage a] -> Put
get :: Get (ExtVarMessage a)
$cget :: forall a. (Binary a, Typeable a) => Get (ExtVarMessage a)
put :: ExtVarMessage a -> Put
$cput :: forall a. (Binary a, Typeable a) => ExtVarMessage a -> Put
Binary)

-- [Note: expect] Due to a bug (?) in GHC/GHCi, when a datatype is
-- defined in a library that is loaded in GHCi, then the TypeRep
-- Fingerprint assigned to it is different in GHCi and a compiled
-- Haskell program. This causes 'expect' not to work correctly because
-- it cannot match Fingerprints of incoming messages. Instead, we
-- 'expect' a 'ByteString' and decode it by hand, discarding cases
-- where decoding fails.
--
extVarServer :: forall a . (Typeable a, Binary a) => String -> MVar a -> Process ()
extVarServer :: String -> MVar a -> Process ()
extVarServer String
name MVar a
var = do
  ProcessId
pid <- Process ProcessId
getSelfPid
  String -> ProcessId -> Process ()
register String
name ProcessId
pid
  let
    -- Reconstruct the ExtVar for logging purposes
    eVar :: ExtVar a
eVar = NodeId -> String -> ExtVar a
forall k (a :: k). NodeId -> String -> ExtVar a
MkExtVar @a (ProcessId -> NodeId
processNodeId ProcessId
pid) String
name

    forClient :: (Typeable b, Binary b) => Text -> SendPort b -> IO b -> Process ()
    forClient :: Text -> SendPort b -> IO b -> Process ()
forClient Text
cmd SendPort b
client IO b
run = do
      Text -> Process ()
forall (m :: * -> *). MonadIO m => Text -> m ()
Log.text (Text -> Process ()) -> Text -> Process ()
forall a b. (a -> b) -> a -> b
$ Text
cmd Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (ExtVar a -> String
forall a. Show a => a -> String
show ExtVar a
eVar) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
      Process ProcessId -> Process ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Process ProcessId -> Process ())
-> Process ProcessId -> Process ()
forall a b. (a -> b) -> a -> b
$ Process () -> Process ProcessId
spawnLocal (Process () -> Process ProcessId)
-> Process () -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ IO b -> Process b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO b
run Process b -> (b -> Process ()) -> Process ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SendPort b -> b -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort b
client
      Process ()
go

    go :: Process ()
go = do
      -- We read the message encoded as a ByteString. See [Note:
      -- expect] for an explanation.
      ByteString
encodedMsg <- Process ByteString
forall a. Serializable a => Process a
expect
      case ByteString
-> Either
     (ByteString, ByteOffset, String)
     (ByteString, ByteOffset, ExtVarMessage a)
forall a.
Binary a =>
ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
decodeOrFail ByteString
encodedMsg of
        Right (ByteString
_, ByteOffset
_, ExtVarMessage a
cmd) -> case ExtVarMessage a
cmd of
          Take SendPort a
c            -> Text -> SendPort a -> IO a -> Process ()
forall b.
(Typeable b, Binary b) =>
Text -> SendPort b -> IO b -> Process ()
forClient Text
"takeExtVar"    SendPort a
c (IO a -> Process ()) -> IO a -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar a -> IO a
forall a. MVar a -> IO a
takeMVar MVar a
var
          TryTake SendPort (Maybe a)
c         -> Text -> SendPort (Maybe a) -> IO (Maybe a) -> Process ()
forall b.
(Typeable b, Binary b) =>
Text -> SendPort b -> IO b -> Process ()
forClient Text
"tryTakeExtVar" SendPort (Maybe a)
c (IO (Maybe a) -> Process ()) -> IO (Maybe a) -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar a -> IO (Maybe a)
forall a. MVar a -> IO (Maybe a)
tryTakeMVar MVar a
var
          Put a
contents SendPort ()
c    -> Text -> SendPort () -> IO () -> Process ()
forall b.
(Typeable b, Binary b) =>
Text -> SendPort b -> IO b -> Process ()
forClient Text
"putExtVar"     SendPort ()
c (IO () -> Process ()) -> IO () -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar a -> a -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar a
var a
contents
          TryPut a
contents SendPort Bool
c -> Text -> SendPort Bool -> IO Bool -> Process ()
forall b.
(Typeable b, Binary b) =>
Text -> SendPort b -> IO b -> Process ()
forClient Text
"tryPutExtVar"  SendPort Bool
c (IO Bool -> Process ()) -> IO Bool -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar a -> a -> IO Bool
forall a. MVar a -> a -> IO Bool
tryPutMVar MVar a
var a
contents
          Read SendPort a
c            -> Text -> SendPort a -> IO a -> Process ()
forall b.
(Typeable b, Binary b) =>
Text -> SendPort b -> IO b -> Process ()
forClient Text
"readExtVar"    SendPort a
c (IO a -> Process ()) -> IO a -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar a -> IO a
forall a. MVar a -> IO a
readMVar MVar a
var
          TryRead SendPort (Maybe a)
c         -> Text -> SendPort (Maybe a) -> IO (Maybe a) -> Process ()
forall b.
(Typeable b, Binary b) =>
Text -> SendPort b -> IO b -> Process ()
forClient Text
"tryReadExtVar" SendPort (Maybe a)
c (IO (Maybe a) -> Process ()) -> IO (Maybe a) -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar a -> IO (Maybe a)
forall a. MVar a -> IO (Maybe a)
tryReadMVar MVar a
var
          ExtVarMessage a
Shutdown            -> () -> Process ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Left (ByteString
_, ByteOffset
_, String
e) -> Text -> String -> Process ()
forall a (m :: * -> *). (Show a, MonadIO m) => Text -> a -> m ()
Log.warn Text
"Couldn't decode ExtVar message" String
e
  Process ()
go


extVarCounter :: IORef Integer
extVarCounter :: IORef Integer
extVarCounter = IO (IORef Integer) -> IORef Integer
forall a. IO a -> a
unsafePerformIO (Integer -> IO (IORef Integer)
forall a. a -> IO (IORef a)
newIORef Integer
0)
{-# NOINLINE extVarCounter #-}

newExtVarName :: IO String
newExtVarName :: IO String
newExtVarName = (Integer -> String) -> IO Integer -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String
"extVar:" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ShowS -> (Integer -> String) -> Integer -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show) (IO Integer -> IO String) -> IO Integer -> IO String
forall a b. (a -> b) -> a -> b
$ IORef Integer -> (Integer -> (Integer, Integer)) -> IO Integer
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef Integer
extVarCounter ((Integer -> (Integer, Integer)) -> IO Integer)
-> (Integer -> (Integer, Integer)) -> IO Integer
forall a b. (a -> b) -> a -> b
$ \Integer
c -> (Integer
cInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1,Integer
c)

-- | Make a new 'ExtVar' containing 'x'. Return both the 'ExtVar' and
-- its underlying 'MVar'.
newExtVar :: (Binary a, Typeable a) => a -> Process (MVar a, ExtVar a)
newExtVar :: a -> Process (MVar a, ExtVar a)
newExtVar a
x = do
  MVar a
m <- IO (MVar a) -> Process (MVar a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MVar a) -> Process (MVar a))
-> IO (MVar a) -> Process (MVar a)
forall a b. (a -> b) -> a -> b
$ a -> IO (MVar a)
forall a. a -> IO (MVar a)
newMVar a
x
  ExtVar a
e <- MVar a -> Process (ExtVar a)
forall a. (Binary a, Typeable a) => MVar a -> Process (ExtVar a)
makeExtVar MVar a
m
  (MVar a, ExtVar a) -> Process (MVar a, ExtVar a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MVar a
m, ExtVar a
e)

-- | Make a new empty 'ExtVar'. Return both the 'ExtVar' and its
-- underlying 'MVar'.
newEmptyExtVar :: (Binary a, Typeable a) => Process (MVar a, ExtVar a)
newEmptyExtVar :: Process (MVar a, ExtVar a)
newEmptyExtVar = do
  MVar a
m <- IO (MVar a) -> Process (MVar a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MVar a) -> Process (MVar a))
-> IO (MVar a) -> Process (MVar a)
forall a b. (a -> b) -> a -> b
$ IO (MVar a)
forall a. IO (MVar a)
newEmptyMVar
  ExtVar a
e <- MVar a -> Process (ExtVar a)
forall a. (Binary a, Typeable a) => MVar a -> Process (ExtVar a)
makeExtVar MVar a
m
  (MVar a, ExtVar a) -> Process (MVar a, ExtVar a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MVar a
m, ExtVar a
e)

-- | Make a new 'ExtVar' from an 'MVar'. The host program can continue
-- to use the 'MVar' as usual.
makeExtVar :: (Binary a, Typeable a) => MVar a -> Process (ExtVar a)
makeExtVar :: MVar a -> Process (ExtVar a)
makeExtVar MVar a
m = do
  String
name <- IO String -> Process String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> Process String) -> IO String -> Process String
forall a b. (a -> b) -> a -> b
$ IO String
newExtVarName
  ProcessId
pid <- Process () -> Process ProcessId
spawnLocal (Process () -> Process ProcessId)
-> Process () -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ String -> MVar a -> Process ()
forall a. (Typeable a, Binary a) => String -> MVar a -> Process ()
extVarServer String
name MVar a
m
  let e :: ExtVar a
e = NodeId -> String -> ExtVar a
forall k (a :: k). NodeId -> String -> ExtVar a
MkExtVar (ProcessId -> NodeId
processNodeId ProcessId
pid) String
name
  Text -> Process ()
forall (m :: * -> *). MonadIO m => Text -> m ()
Log.text (Text -> Process ()) -> Text -> Process ()
forall a b. (a -> b) -> a -> b
$ Text
"New ExtVar: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (ExtVar a -> String
forall a. Show a => a -> String
show ExtVar a
e)
  ExtVar a -> Process (ExtVar a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExtVar a
e

-- | Kill the server underlying the 'ExtVar'. Subsequent calls from
-- clients may block indefinitely.
killExtVar :: forall a . (Binary a, Typeable a) => ExtVar a -> Process ()
killExtVar :: ExtVar a -> Process ()
killExtVar (MkExtVar NodeId
nid String
name) = NodeId -> String -> ExtVarMessage a -> Process ()
forall a. Serializable a => NodeId -> String -> a -> Process ()
nsendRemote NodeId
nid String
name (ExtVarMessage a -> Process ()) -> ExtVarMessage a -> Process ()
forall a b. (a -> b) -> a -> b
$ ExtVarMessage a
forall a. ExtVarMessage a
Shutdown @a

withSelf
  :: (Binary b, Typeable b, Binary a, Typeable a)
  => ExtVar a
  -> (SendPort b -> ExtVarMessage a)
  -> Process b
withSelf :: ExtVar a -> (SendPort b -> ExtVarMessage a) -> Process b
withSelf (MkExtVar NodeId
nid String
name) SendPort b -> ExtVarMessage a
mkMessage = do
  (SendPort b
sendSelf, ReceivePort b
recvSelf) <- Process (SendPort b, ReceivePort b)
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan
  NodeId -> String -> ByteString -> Process ()
forall a. Serializable a => NodeId -> String -> a -> Process ()
nsendRemote NodeId
nid String
name (ExtVarMessage a -> ByteString
forall a. Binary a => a -> ByteString
encode (SendPort b -> ExtVarMessage a
mkMessage SendPort b
sendSelf))
  ReceivePort b -> Process b
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort b
recvSelf

-- | 'takeExtVar', etc. are analogous to 'takeMVar', etc. All
-- functions block until they receive a response from the host.
--
-- [Note: Safety] The functions 'takeExtVar', 'tryTakeExtVar', and
-- those that use them like 'withExtVar', 'modifyExtVar_', and
-- 'modifyExtVar' (and all of their IO variants) must be used with
-- care. On the host side, they cause data to be taken out of the
-- underlying 'MVar'. If an exception occurs, that data will not be
-- automatically replaced. Thus, the underlying 'MVar' could remain
-- empty and the data that was in it may be lost.
--
-- Here is an example situation where that would occur. Suppose that
-- we have an 'ExtVar' with type 'String':
--
-- > extVar @String "host.address.com" "extVar:0"
--
-- However, suppose that a client tries to take an 'ExtVar' with the
-- same address and name, but the wrong type:
--
-- >>> takeExtVarIO $ extVar @Int "host.address.com" "extVar:0"
--
-- On the host, the 'String' will be removed from the 'MVar',
-- serialized to 'ByteString', and sent to the client. (The 'host' no
-- longer has the data.) The client will try to deserialize the
-- 'ByteString' to an 'Int', which will fail (because 'Int' is the
-- incorrect type) and throw an exception. As 'takeExtVar' is
-- currently implemented, the data will never get sent back to the
-- host.
--
-- It is the client's responsibility to make sure this doesn't
-- happen. In a GHCi session, it is recommended that you use
-- 'readExtVarIO' first to make sure your connection is good and you
-- have the right 'ExtVar' *including its type*, before you use
-- functions like 'takeExtVar'.
--
takeExtVar :: (Binary a, Typeable a) => ExtVar a -> Process a
takeExtVar :: ExtVar a -> Process a
takeExtVar ExtVar a
eVar = ExtVar a -> (SendPort a -> ExtVarMessage a) -> Process a
forall b a.
(Binary b, Typeable b, Binary a, Typeable a) =>
ExtVar a -> (SendPort b -> ExtVarMessage a) -> Process b
withSelf ExtVar a
eVar SendPort a -> ExtVarMessage a
forall a. SendPort a -> ExtVarMessage a
Take

tryTakeExtVar :: (Binary a, Typeable a) => ExtVar a -> Process (Maybe a)
tryTakeExtVar :: ExtVar a -> Process (Maybe a)
tryTakeExtVar ExtVar a
eVar = ExtVar a
-> (SendPort (Maybe a) -> ExtVarMessage a) -> Process (Maybe a)
forall b a.
(Binary b, Typeable b, Binary a, Typeable a) =>
ExtVar a -> (SendPort b -> ExtVarMessage a) -> Process b
withSelf ExtVar a
eVar SendPort (Maybe a) -> ExtVarMessage a
forall a. SendPort (Maybe a) -> ExtVarMessage a
TryTake

putExtVar :: (Binary a, Typeable a) => ExtVar a -> a -> Process ()
putExtVar :: ExtVar a -> a -> Process ()
putExtVar ExtVar a
eVar a
a = ExtVar a -> (SendPort () -> ExtVarMessage a) -> Process ()
forall b a.
(Binary b, Typeable b, Binary a, Typeable a) =>
ExtVar a -> (SendPort b -> ExtVarMessage a) -> Process b
withSelf ExtVar a
eVar ((SendPort () -> ExtVarMessage a) -> Process ())
-> (SendPort () -> ExtVarMessage a) -> Process ()
forall a b. (a -> b) -> a -> b
$ a -> SendPort () -> ExtVarMessage a
forall a. a -> SendPort () -> ExtVarMessage a
Put a
a

tryPutExtVar :: (Binary a, Typeable a) => ExtVar a -> a -> Process Bool
tryPutExtVar :: ExtVar a -> a -> Process Bool
tryPutExtVar ExtVar a
eVar a
a = ExtVar a -> (SendPort Bool -> ExtVarMessage a) -> Process Bool
forall b a.
(Binary b, Typeable b, Binary a, Typeable a) =>
ExtVar a -> (SendPort b -> ExtVarMessage a) -> Process b
withSelf ExtVar a
eVar ((SendPort Bool -> ExtVarMessage a) -> Process Bool)
-> (SendPort Bool -> ExtVarMessage a) -> Process Bool
forall a b. (a -> b) -> a -> b
$ a -> SendPort Bool -> ExtVarMessage a
forall a. a -> SendPort Bool -> ExtVarMessage a
TryPut a
a

readExtVar :: (Binary a, Typeable a) => ExtVar a -> Process a
readExtVar :: ExtVar a -> Process a
readExtVar ExtVar a
eVar = ExtVar a -> (SendPort a -> ExtVarMessage a) -> Process a
forall b a.
(Binary b, Typeable b, Binary a, Typeable a) =>
ExtVar a -> (SendPort b -> ExtVarMessage a) -> Process b
withSelf ExtVar a
eVar SendPort a -> ExtVarMessage a
forall a. SendPort a -> ExtVarMessage a
Read

tryReadExtVar :: (Binary a, Typeable a) => ExtVar a -> Process (Maybe a)
tryReadExtVar :: ExtVar a -> Process (Maybe a)
tryReadExtVar ExtVar a
eVar = ExtVar a
-> (SendPort (Maybe a) -> ExtVarMessage a) -> Process (Maybe a)
forall b a.
(Binary b, Typeable b, Binary a, Typeable a) =>
ExtVar a -> (SendPort b -> ExtVarMessage a) -> Process b
withSelf ExtVar a
eVar SendPort (Maybe a) -> ExtVarMessage a
forall a. SendPort (Maybe a) -> ExtVarMessage a
TryRead

withExtVar :: (Binary a, Typeable a) => ExtVar a -> (a -> Process b) -> Process b
withExtVar :: ExtVar a -> (a -> Process b) -> Process b
withExtVar ExtVar a
eVar = Process a -> (a -> Process ()) -> (a -> Process b) -> Process b
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket (ExtVar a -> Process a
forall a. (Binary a, Typeable a) => ExtVar a -> Process a
takeExtVar ExtVar a
eVar) (ExtVar a -> a -> Process ()
forall a. (Binary a, Typeable a) => ExtVar a -> a -> Process ()
putExtVar ExtVar a
eVar)

modifyExtVar_ :: (Binary a, Typeable a) => ExtVar a -> (a -> Process a) -> Process ()
modifyExtVar_ :: ExtVar a -> (a -> Process a) -> Process ()
modifyExtVar_ ExtVar a
eVar a -> Process a
go = ((forall a. Process a -> Process a) -> Process ()) -> Process ()
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. Process a -> Process a) -> Process ()) -> Process ())
-> ((forall a. Process a -> Process a) -> Process ()) -> Process ()
forall a b. (a -> b) -> a -> b
$ \forall a. Process a -> Process a
restore -> do
  a
a  <- ExtVar a -> Process a
forall a. (Binary a, Typeable a) => ExtVar a -> Process a
takeExtVar ExtVar a
eVar
  a
a' <- Process a -> Process a
forall a. Process a -> Process a
restore (a -> Process a
go a
a) Process a -> Process () -> Process a
forall (m :: * -> *) a b. MonadCatch m => m a -> m b -> m a
`onException` ExtVar a -> a -> Process ()
forall a. (Binary a, Typeable a) => ExtVar a -> a -> Process ()
putExtVar ExtVar a
eVar a
a
  ExtVar a -> a -> Process ()
forall a. (Binary a, Typeable a) => ExtVar a -> a -> Process ()
putExtVar ExtVar a
eVar a
a'

modifyExtVar :: (Binary a, Typeable a) => ExtVar a -> (a -> Process (a,b)) -> Process b
modifyExtVar :: ExtVar a -> (a -> Process (a, b)) -> Process b
modifyExtVar ExtVar a
eVar a -> Process (a, b)
go = ((forall a. Process a -> Process a) -> Process b) -> Process b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. Process a -> Process a) -> Process b) -> Process b)
-> ((forall a. Process a -> Process a) -> Process b) -> Process b
forall a b. (a -> b) -> a -> b
$ \forall a. Process a -> Process a
restore -> do
  a
a      <- ExtVar a -> Process a
forall a. (Binary a, Typeable a) => ExtVar a -> Process a
takeExtVar ExtVar a
eVar
  (a
a',b
b) <- Process (a, b) -> Process (a, b)
forall a. Process a -> Process a
restore (a -> Process (a, b)
go a
a) Process (a, b) -> Process () -> Process (a, b)
forall (m :: * -> *) a b. MonadCatch m => m a -> m b -> m a
`onException` ExtVar a -> a -> Process ()
forall a. (Binary a, Typeable a) => ExtVar a -> a -> Process ()
putExtVar ExtVar a
eVar a
a
  ExtVar a -> a -> Process ()
forall a. (Binary a, Typeable a) => ExtVar a -> a -> Process ()
putExtVar ExtVar a
eVar a
a'
  b -> Process b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
b

-- | 'IO' versions of 'ExtVar' functions, for convenience.

takeExtVarIO :: (Binary a, Typeable a) => ExtVar a -> IO a
takeExtVarIO :: ExtVar a -> IO a
takeExtVarIO = Process a -> IO a
forall a. Process a -> IO a
runProcessLocal (Process a -> IO a) -> (ExtVar a -> Process a) -> ExtVar a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExtVar a -> Process a
forall a. (Binary a, Typeable a) => ExtVar a -> Process a
takeExtVar

tryTakeExtVarIO :: (Binary a, Typeable a) => ExtVar a -> IO (Maybe a)
tryTakeExtVarIO :: ExtVar a -> IO (Maybe a)
tryTakeExtVarIO = Process (Maybe a) -> IO (Maybe a)
forall a. Process a -> IO a
runProcessLocal (Process (Maybe a) -> IO (Maybe a))
-> (ExtVar a -> Process (Maybe a)) -> ExtVar a -> IO (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExtVar a -> Process (Maybe a)
forall a. (Binary a, Typeable a) => ExtVar a -> Process (Maybe a)
tryTakeExtVar

putExtVarIO :: (Binary a, Typeable a) => ExtVar a -> a -> IO ()
putExtVarIO :: ExtVar a -> a -> IO ()
putExtVarIO ExtVar a
eVar = Process () -> IO ()
forall a. Process a -> IO a
runProcessLocal (Process () -> IO ()) -> (a -> Process ()) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExtVar a -> a -> Process ()
forall a. (Binary a, Typeable a) => ExtVar a -> a -> Process ()
putExtVar ExtVar a
eVar

tryPutExtVarIO :: (Binary a, Typeable a) => ExtVar a -> a -> IO Bool
tryPutExtVarIO :: ExtVar a -> a -> IO Bool
tryPutExtVarIO ExtVar a
eVar = Process Bool -> IO Bool
forall a. Process a -> IO a
runProcessLocal (Process Bool -> IO Bool) -> (a -> Process Bool) -> a -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExtVar a -> a -> Process Bool
forall a. (Binary a, Typeable a) => ExtVar a -> a -> Process Bool
tryPutExtVar ExtVar a
eVar

readExtVarIO :: (Binary a, Typeable a) => ExtVar a -> IO a
readExtVarIO :: ExtVar a -> IO a
readExtVarIO = Process a -> IO a
forall a. Process a -> IO a
runProcessLocal (Process a -> IO a) -> (ExtVar a -> Process a) -> ExtVar a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExtVar a -> Process a
forall a. (Binary a, Typeable a) => ExtVar a -> Process a
readExtVar

tryReadExtVarIO :: (Binary a, Typeable a) => ExtVar a -> IO (Maybe a)
tryReadExtVarIO :: ExtVar a -> IO (Maybe a)
tryReadExtVarIO = Process (Maybe a) -> IO (Maybe a)
forall a. Process a -> IO a
runProcessLocal (Process (Maybe a) -> IO (Maybe a))
-> (ExtVar a -> Process (Maybe a)) -> ExtVar a -> IO (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExtVar a -> Process (Maybe a)
forall a. (Binary a, Typeable a) => ExtVar a -> Process (Maybe a)
tryReadExtVar

withExtVarIO :: (Binary a, Typeable a) => ExtVar a -> (a -> IO b) -> IO b
withExtVarIO :: ExtVar a -> (a -> IO b) -> IO b
withExtVarIO ExtVar a
eVar a -> IO b
go = Process b -> IO b
forall a. Process a -> IO a
runProcessLocal (Process b -> IO b) -> Process b -> IO b
forall a b. (a -> b) -> a -> b
$ ExtVar a -> (a -> Process b) -> Process b
forall a b.
(Binary a, Typeable a) =>
ExtVar a -> (a -> Process b) -> Process b
withExtVar ExtVar a
eVar (IO b -> Process b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> Process b) -> (a -> IO b) -> a -> Process b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO b
go)

modifyExtVarIO_ :: (Binary a, Typeable a) => ExtVar a -> (a -> IO a) -> IO ()
modifyExtVarIO_ :: ExtVar a -> (a -> IO a) -> IO ()
modifyExtVarIO_ ExtVar a
eVar a -> IO a
go = Process () -> IO ()
forall a. Process a -> IO a
runProcessLocal (Process () -> IO ()) -> Process () -> IO ()
forall a b. (a -> b) -> a -> b
$ ExtVar a -> (a -> Process a) -> Process ()
forall a.
(Binary a, Typeable a) =>
ExtVar a -> (a -> Process a) -> Process ()
modifyExtVar_ ExtVar a
eVar (IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Process a) -> (a -> IO a) -> a -> Process a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO a
go)

modifyExtVarIO :: (Binary a, Typeable a) => ExtVar a -> (a -> IO (a,b)) -> IO b
modifyExtVarIO :: ExtVar a -> (a -> IO (a, b)) -> IO b
modifyExtVarIO ExtVar a
eVar a -> IO (a, b)
go = Process b -> IO b
forall a. Process a -> IO a
runProcessLocal (Process b -> IO b) -> Process b -> IO b
forall a b. (a -> b) -> a -> b
$ ExtVar a -> (a -> Process (a, b)) -> Process b
forall a b.
(Binary a, Typeable a) =>
ExtVar a -> (a -> Process (a, b)) -> Process b
modifyExtVar ExtVar a
eVar (IO (a, b) -> Process (a, b)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (a, b) -> Process (a, b))
-> (a -> IO (a, b)) -> a -> Process (a, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO (a, b)
go)

-- | Store the given list in an 'ExtVar' and return an action that
-- repeatedly pops the first element from the list until there are
-- none left. An external client can freely modify the contents of the
-- 'ExtVar', and in this way insert or delete elements by hand while
-- the program is running.
newExtVarStream
  :: (Binary a, Typeable a, MonadIO m, MonadBase Process n)
  => [a]
  -> n (ExtVar [a], m (Maybe a))
newExtVarStream :: [a] -> n (ExtVar [a], m (Maybe a))
newExtVarStream [a]
vs = Process (ExtVar [a], m (Maybe a)) -> n (ExtVar [a], m (Maybe a))
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (Process (ExtVar [a], m (Maybe a)) -> n (ExtVar [a], m (Maybe a)))
-> Process (ExtVar [a], m (Maybe a)) -> n (ExtVar [a], m (Maybe a))
forall a b. (a -> b) -> a -> b
$ do
  (MVar [a]
mVar, ExtVar [a]
eVar) <- [a] -> Process (MVar [a], ExtVar [a])
forall a. (Binary a, Typeable a) => a -> Process (MVar a, ExtVar a)
newExtVar [a]
vs
  let pop :: m (Maybe a)
pop = 
        IO (Maybe a) -> m (Maybe a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a) -> m (Maybe a)) -> IO (Maybe a) -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ MVar [a] -> ([a] -> IO ([a], Maybe a)) -> IO (Maybe a)
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar [a]
mVar (([a] -> IO ([a], Maybe a)) -> IO (Maybe a))
-> ([a] -> IO ([a], Maybe a)) -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ ([a], Maybe a) -> IO ([a], Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([a], Maybe a) -> IO ([a], Maybe a))
-> ([a] -> ([a], Maybe a)) -> [a] -> IO ([a], Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
        []     -> ([], Maybe a
forall a. Maybe a
Nothing)
        a
u : [a]
us -> ([a]
us, a -> Maybe a
forall a. a -> Maybe a
Just a
u)
  (ExtVar [a], m (Maybe a)) -> Process (ExtVar [a], m (Maybe a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExtVar [a]
eVar, m (Maybe a)
pop)