content: {-# LANGUAGE DeriveGeneric #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE StaticPointers #-}
  {-# LANGUAGE TemplateHaskell #-}
  
  import Control.Concurrent.Async
  import Control.Concurrent.Chan
  import Control.Distributed.Closure
  import Control.Distributed.Closure.TH
  import Control.Monad (forever)
  import Data.Binary
  import qualified Data.ByteString.Lazy as BSL
  import Data.Functor.Static
  import Data.Typeable (Typeable)
  import GHC.Generics
  import GHC.StaticPtr
  
  -- | An instruction to the server.
  data Instruction
    = CallStatic StaticKey Int
      -- ^ @CallStatic skFun arg@
      --
      -- Apply the function behind the 'StaticKey' @skFun@ to @arg@.
    | CallClosure (Closure (Int -> Int)) Int
      -- ^ @CallClosure cl arg@
      --
      -- Apply the closure @cl@ to @arg@.
    deriving Generic
  instance Binary Instruction
  
  -- | Handle an instruction by the client.
  --
  -- This is where we resolve a 'StaticKey'
  -- by looking up the 'StaticPtr' and dereferencing it.
  --
  -- This is also where we resolve a 'Closure'.
  handleInstruction :: Instruction -> IO (Maybe Int)
  handleInstruction (CallStatic skey input) = do
    mbSPtr <- unsafeLookupStaticPtr skey
    return $ case mbSPtr of
      Nothing -> Nothing
      Just sptr ->
        let fun = deRefStaticPtr sptr in
        Just $ fun input
  handleInstruction (CallClosure cl input) =
    let fun = unclosure cl in
    return $ Just $ fun input
  
  -- | Channel to which a client will send its request.
  type ServerChan = Chan (BSL.ByteString, ResponseChan)
  
  -- | Channel to which the server will send its response.
  type ResponseChan = Chan BSL.ByteString
  
  -- | Execute an action with a concurrent server thread.
  --
  -- This mocks a network connection between a client and a server process.
  -- For simplicity, the client and server run within the same process
  -- and communicate through 'Chan's instead of sockets.
  --
  -- The server listens on a channel for requests.
  -- The client sends requests on that channel together with a response channel.
  -- The server handles the request and sends the result on the response channel.
  withServer :: (ServerChan -> IO ()) -> IO ()
  withServer action = do
    serverChan <- newChan
    let server = forever $ do
          (body, responseChan) <- readChan serverChan
          result <- case decodeOrFail body of
            Left _ -> return Nothing
            Right (_, _, instruction) -> handleInstruction instruction
          writeChan responseChan (encode result)
    withAsync server (\_ -> action serverChan)
  
  -- | A global function that can be packed into a 'CallStatic' instruction.
  double :: Int -> Int
  double = (*2)
  
  -- | A wrapper around 'Int' used to fulfill the 'Serializable' constraint,
  -- so that it can be packed into a 'Closure'.
  newtype SerializableInt = SI Int deriving (Generic, Typeable)
  withStatic [d|
    instance Binary SerializableInt
    instance Typeable SerializableInt
    |]
  
  -- | Demonstration of client server interactions.
  main :: IO ()
  main = withServer $ \serverChan -> do
    do
      clientChan <- newChan
      -- Obtain the 'StaticPtr' to the global function 'double'
      -- using the 'static' keyword, enabled by the 'StaticPointers' extension.
      -- Convert the 'StaticPtr' into a 'StaticKey' using 'staticKey',
      -- so that it can be sent across the wire.
      let fun = staticKey $ static double
          request = encode $ CallStatic fun 4
      writeChan serverChan (request, clientChan)
      result <- decode <$> readChan clientChan
      putStrLn $ "double 4 = " ++ show (result :: Maybe Int)
    do
      clientChan <- newChan
      -- Construct a 'Closure' that effectively captures a value
      -- and represents a partially applied function.
      -- The 'static' keyword is used to convert a lambda,
      -- that doesn't capture any free variables, into a 'StaticPtr'.
      -- Then we use 'staticMap' to partially apply the lambda within the closure.
      let three = SI 3
          c = static (\(SI a) b -> a + b)
            `staticMap` cpure closureDict three
          request = encode $ CallClosure c 4
      writeChan serverChan (request, clientChan)
      result <- decode <$> readChan clientChan
      putStrLn $ "3 + 4 = " ++ show (result :: Maybe Int)
  