-- | Serializable closures for distributed programming. This package builds
-- a "remotable closure" abstraction on top of
-- <https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#static-pointers static pointers>.
-- See
-- <https://ocharles.org.uk/blog/guest-posts/2014-12-23-static-pointers.html this blog post>
-- for a longer introduction.

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ExplicitNamespaces #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StaticPointers #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
#if __GLASGOW_HASKELL__ >= 800
{-# LANGUAGE UndecidableSuperClasses #-}
#endif

module Control.Distributed.Closure
  ( Serializable
    -- * Closures
  , Closure
  , closure
  , unclosure
  , cpure
  , cap
  , cmap
  , cduplicate
    -- * Special closures
  , WrappedArrowClosure(..)
  , type (/->)
    -- * Closure dictionaries
    -- $static-dicts
  , Dict(..)
  , Static(..)
  ) where

import Control.Distributed.Closure.Internal
import Data.Binary (Binary)
import Data.Constraint (Dict(..))
import Data.Typeable (Typeable)

-- $static-dicts
--
-- A 'Dict' reifies a constraint in the form of a first class value. The 'Dict'
-- type is not serializable: how do you serialize the constraint that values of
-- this type carry? Whereas, for any constraint @c@, a value of type @'Closure'
-- ('Dict' c)@ /can/ be serialized and sent over the wire, just like any
-- 'Closure'. A /static dictionary/ for some constraint @c@ is a value of type
-- @'Closure' ('Dict' c)@.

-- | It's often useful to create a static dictionary on-the-fly given any
-- constraint. Morally, all type class constraints have associated static
-- dictionaries, since these are either global values or simple combinations
-- thereof. But GHC doesn't yet know how to invent a static dictionary on-demand
-- yet given any type class constraint, so we'll have to do it manually for the
-- time being. By defining instances of this type class manually, or via
-- 'Control.Distributed.Closure.TH.withStatic' if it becomes too tedious.
class c => Static c where
  closureDict :: Closure (Dict c)

instance (Static c1, Static c2, Typeable c1, Typeable c2, (c1, c2)) => Static (c1, c2) where
  closureDict :: Closure (Dict (c1, c2))
closureDict = static Dict c1 -> Dict c2 -> Dict (c1, c2)
forall (c1 :: Constraint) (c2 :: Constraint).
Dict c1 -> Dict c2 -> Dict (c1, c2)
f Closure (Dict c1 -> Dict c2 -> Dict (c1, c2))
-> Closure (Dict c1) -> Closure (Dict c2 -> Dict (c1, c2))
forall a b.
Typeable a =>
Closure (a -> b) -> Closure a -> Closure b
`cap` Closure (Dict c1)
forall (c :: Constraint). Static c => Closure (Dict c)
closureDict Closure (Dict c2 -> Dict (c1, c2))
-> Closure (Dict c2) -> Closure (Dict (c1, c2))
forall a b.
Typeable a =>
Closure (a -> b) -> Closure a -> Closure b
`cap` Closure (Dict c2)
forall (c :: Constraint). Static c => Closure (Dict c)
closureDict
    where
      f :: Dict c1 -> Dict c2 -> Dict (c1, c2)
      f :: forall (c1 :: Constraint) (c2 :: Constraint).
Dict c1 -> Dict c2 -> Dict (c1, c2)
f Dict c1
Dict Dict c2
Dict = Dict (c1, c2)
forall (a :: Constraint). a => Dict a
Dict

instance (Static c1, Static c2, Static c3, Typeable c1, Typeable c2, Typeable c3, (c1, c2, c3)) => Static (c1, c2, c3) where
  closureDict :: Closure (Dict (c1, c2, c3))
closureDict = static Dict c1 -> Dict c2 -> Dict c3 -> Dict (c1, c2, c3)
forall (c1 :: Constraint) (c2 :: Constraint) (c3 :: Constraint).
Dict c1 -> Dict c2 -> Dict c3 -> Dict (c1, c2, c3)
f Closure (Dict c1 -> Dict c2 -> Dict c3 -> Dict (c1, c2, c3))
-> Closure (Dict c1)
-> Closure (Dict c2 -> Dict c3 -> Dict (c1, c2, c3))
forall a b.
Typeable a =>
Closure (a -> b) -> Closure a -> Closure b
`cap` Closure (Dict c1)
forall (c :: Constraint). Static c => Closure (Dict c)
closureDict Closure (Dict c2 -> Dict c3 -> Dict (c1, c2, c3))
-> Closure (Dict c2) -> Closure (Dict c3 -> Dict (c1, c2, c3))
forall a b.
Typeable a =>
Closure (a -> b) -> Closure a -> Closure b
`cap` Closure (Dict c2)
forall (c :: Constraint). Static c => Closure (Dict c)
closureDict Closure (Dict c3 -> Dict (c1, c2, c3))
-> Closure (Dict c3) -> Closure (Dict (c1, c2, c3))
forall a b.
Typeable a =>
Closure (a -> b) -> Closure a -> Closure b
`cap` Closure (Dict c3)
forall (c :: Constraint). Static c => Closure (Dict c)
closureDict
    where
      f :: Dict c1 -> Dict c2 -> Dict c3 -> Dict (c1, c2, c3)
      f :: forall (c1 :: Constraint) (c2 :: Constraint) (c3 :: Constraint).
Dict c1 -> Dict c2 -> Dict c3 -> Dict (c1, c2, c3)
f Dict c1
Dict Dict c2
Dict Dict c3
Dict = Dict (c1, c2, c3)
forall (a :: Constraint). a => Dict a
Dict

instance (Static c1, Static c2, Static c3, Static c4, Typeable c1, Typeable c2, Typeable c3, Typeable c4, (c1, c2, c3, c4)) => Static (c1, c2, c3, c4) where
  closureDict :: Closure (Dict (c1, c2, c3, c4))
closureDict = static Dict c1 -> Dict c2 -> Dict c3 -> Dict c4 -> Dict (c1, c2, c3, c4)
forall (c1 :: Constraint) (c2 :: Constraint) (c3 :: Constraint)
       (c4 :: Constraint).
Dict c1 -> Dict c2 -> Dict c3 -> Dict c4 -> Dict (c1, c2, c3, c4)
f Closure
  (Dict c1 -> Dict c2 -> Dict c3 -> Dict c4 -> Dict (c1, c2, c3, c4))
-> Closure (Dict c1)
-> Closure (Dict c2 -> Dict c3 -> Dict c4 -> Dict (c1, c2, c3, c4))
forall a b.
Typeable a =>
Closure (a -> b) -> Closure a -> Closure b
`cap` Closure (Dict c1)
forall (c :: Constraint). Static c => Closure (Dict c)
closureDict Closure (Dict c2 -> Dict c3 -> Dict c4 -> Dict (c1, c2, c3, c4))
-> Closure (Dict c2)
-> Closure (Dict c3 -> Dict c4 -> Dict (c1, c2, c3, c4))
forall a b.
Typeable a =>
Closure (a -> b) -> Closure a -> Closure b
`cap` Closure (Dict c2)
forall (c :: Constraint). Static c => Closure (Dict c)
closureDict Closure (Dict c3 -> Dict c4 -> Dict (c1, c2, c3, c4))
-> Closure (Dict c3) -> Closure (Dict c4 -> Dict (c1, c2, c3, c4))
forall a b.
Typeable a =>
Closure (a -> b) -> Closure a -> Closure b
`cap` Closure (Dict c3)
forall (c :: Constraint). Static c => Closure (Dict c)
closureDict Closure (Dict c4 -> Dict (c1, c2, c3, c4))
-> Closure (Dict c4) -> Closure (Dict (c1, c2, c3, c4))
forall a b.
Typeable a =>
Closure (a -> b) -> Closure a -> Closure b
`cap` Closure (Dict c4)
forall (c :: Constraint). Static c => Closure (Dict c)
closureDict
    where
      f :: Dict c1 -> Dict c2 -> Dict c3 -> Dict c4 -> Dict (c1, c2, c3, c4)
      f :: forall (c1 :: Constraint) (c2 :: Constraint) (c3 :: Constraint)
       (c4 :: Constraint).
Dict c1 -> Dict c2 -> Dict c3 -> Dict c4 -> Dict (c1, c2, c3, c4)
f Dict c1
Dict Dict c2
Dict Dict c3
Dict Dict c4
Dict = Dict (c1, c2, c3, c4)
forall (a :: Constraint). a => Dict a
Dict

instance (Static c1, Static c2, Static c3, Static c4, Static c5, Typeable c1, Typeable c2, Typeable c3, Typeable c4, Typeable c5, (c1, c2, c3, c4, c5)) => Static (c1, c2, c3, c4, c5) where
  closureDict :: Closure (Dict (c1, c2, c3, c4, c5))
closureDict = static Dict c1
-> Dict c2
-> Dict c3
-> Dict c4
-> Dict c5
-> Dict (c1, c2, c3, c4, c5)
forall (c1 :: Constraint) (c2 :: Constraint) (c3 :: Constraint)
       (c4 :: Constraint) (c5 :: Constraint).
Dict c1
-> Dict c2
-> Dict c3
-> Dict c4
-> Dict c5
-> Dict (c1, c2, c3, c4, c5)
f Closure
  (Dict c1
   -> Dict c2
   -> Dict c3
   -> Dict c4
   -> Dict c5
   -> Dict (c1, c2, c3, c4, c5))
-> Closure (Dict c1)
-> Closure
     (Dict c2
      -> Dict c3 -> Dict c4 -> Dict c5 -> Dict (c1, c2, c3, c4, c5))
forall a b.
Typeable a =>
Closure (a -> b) -> Closure a -> Closure b
`cap` Closure (Dict c1)
forall (c :: Constraint). Static c => Closure (Dict c)
closureDict Closure
  (Dict c2
   -> Dict c3 -> Dict c4 -> Dict c5 -> Dict (c1, c2, c3, c4, c5))
-> Closure (Dict c2)
-> Closure
     (Dict c3 -> Dict c4 -> Dict c5 -> Dict (c1, c2, c3, c4, c5))
forall a b.
Typeable a =>
Closure (a -> b) -> Closure a -> Closure b
`cap` Closure (Dict c2)
forall (c :: Constraint). Static c => Closure (Dict c)
closureDict Closure
  (Dict c3 -> Dict c4 -> Dict c5 -> Dict (c1, c2, c3, c4, c5))
-> Closure (Dict c3)
-> Closure (Dict c4 -> Dict c5 -> Dict (c1, c2, c3, c4, c5))
forall a b.
Typeable a =>
Closure (a -> b) -> Closure a -> Closure b
`cap` Closure (Dict c3)
forall (c :: Constraint). Static c => Closure (Dict c)
closureDict Closure (Dict c4 -> Dict c5 -> Dict (c1, c2, c3, c4, c5))
-> Closure (Dict c4)
-> Closure (Dict c5 -> Dict (c1, c2, c3, c4, c5))
forall a b.
Typeable a =>
Closure (a -> b) -> Closure a -> Closure b
`cap` Closure (Dict c4)
forall (c :: Constraint). Static c => Closure (Dict c)
closureDict Closure (Dict c5 -> Dict (c1, c2, c3, c4, c5))
-> Closure (Dict c5) -> Closure (Dict (c1, c2, c3, c4, c5))
forall a b.
Typeable a =>
Closure (a -> b) -> Closure a -> Closure b
`cap` Closure (Dict c5)
forall (c :: Constraint). Static c => Closure (Dict c)
closureDict
    where
      f :: Dict c1 -> Dict c2 -> Dict c3 -> Dict c4 -> Dict c5 -> Dict (c1, c2, c3, c4, c5)
      f :: forall (c1 :: Constraint) (c2 :: Constraint) (c3 :: Constraint)
       (c4 :: Constraint) (c5 :: Constraint).
Dict c1
-> Dict c2
-> Dict c3
-> Dict c4
-> Dict c5
-> Dict (c1, c2, c3, c4, c5)
f Dict c1
Dict Dict c2
Dict Dict c3
Dict Dict c4
Dict Dict c5
Dict = Dict (c1, c2, c3, c4, c5)
forall (a :: Constraint). a => Dict a
Dict

instance (Static c1, Static c2, Static c3, Static c4, Static c5, Static c6, Typeable c1, Typeable c2, Typeable c3, Typeable c4, Typeable c5, Typeable c6, (c1, c2, c3, c4, c5, c6)) => Static (c1, c2, c3, c4, c5, c6) where
  closureDict :: Closure (Dict (c1, c2, c3, c4, c5, c6))
closureDict = static Dict c1
-> Dict c2
-> Dict c3
-> Dict c4
-> Dict c5
-> Dict c6
-> Dict (c1, c2, c3, c4, c5, c6)
forall (c1 :: Constraint) (c2 :: Constraint) (c3 :: Constraint)
       (c4 :: Constraint) (c5 :: Constraint) (c6 :: Constraint).
Dict c1
-> Dict c2
-> Dict c3
-> Dict c4
-> Dict c5
-> Dict c6
-> Dict (c1, c2, c3, c4, c5, c6)
f Closure
  (Dict c1
   -> Dict c2
   -> Dict c3
   -> Dict c4
   -> Dict c5
   -> Dict c6
   -> Dict (c1, c2, c3, c4, c5, c6))
-> Closure (Dict c1)
-> Closure
     (Dict c2
      -> Dict c3
      -> Dict c4
      -> Dict c5
      -> Dict c6
      -> Dict (c1, c2, c3, c4, c5, c6))
forall a b.
Typeable a =>
Closure (a -> b) -> Closure a -> Closure b
`cap` Closure (Dict c1)
forall (c :: Constraint). Static c => Closure (Dict c)
closureDict Closure
  (Dict c2
   -> Dict c3
   -> Dict c4
   -> Dict c5
   -> Dict c6
   -> Dict (c1, c2, c3, c4, c5, c6))
-> Closure (Dict c2)
-> Closure
     (Dict c3
      -> Dict c4 -> Dict c5 -> Dict c6 -> Dict (c1, c2, c3, c4, c5, c6))
forall a b.
Typeable a =>
Closure (a -> b) -> Closure a -> Closure b
`cap` Closure (Dict c2)
forall (c :: Constraint). Static c => Closure (Dict c)
closureDict Closure
  (Dict c3
   -> Dict c4 -> Dict c5 -> Dict c6 -> Dict (c1, c2, c3, c4, c5, c6))
-> Closure (Dict c3)
-> Closure
     (Dict c4 -> Dict c5 -> Dict c6 -> Dict (c1, c2, c3, c4, c5, c6))
forall a b.
Typeable a =>
Closure (a -> b) -> Closure a -> Closure b
`cap` Closure (Dict c3)
forall (c :: Constraint). Static c => Closure (Dict c)
closureDict Closure
  (Dict c4 -> Dict c5 -> Dict c6 -> Dict (c1, c2, c3, c4, c5, c6))
-> Closure (Dict c4)
-> Closure (Dict c5 -> Dict c6 -> Dict (c1, c2, c3, c4, c5, c6))
forall a b.
Typeable a =>
Closure (a -> b) -> Closure a -> Closure b
`cap` Closure (Dict c4)
forall (c :: Constraint). Static c => Closure (Dict c)
closureDict Closure (Dict c5 -> Dict c6 -> Dict (c1, c2, c3, c4, c5, c6))
-> Closure (Dict c5)
-> Closure (Dict c6 -> Dict (c1, c2, c3, c4, c5, c6))
forall a b.
Typeable a =>
Closure (a -> b) -> Closure a -> Closure b
`cap` Closure (Dict c5)
forall (c :: Constraint). Static c => Closure (Dict c)
closureDict Closure (Dict c6 -> Dict (c1, c2, c3, c4, c5, c6))
-> Closure (Dict c6) -> Closure (Dict (c1, c2, c3, c4, c5, c6))
forall a b.
Typeable a =>
Closure (a -> b) -> Closure a -> Closure b
`cap` Closure (Dict c6)
forall (c :: Constraint). Static c => Closure (Dict c)
closureDict
    where
      f :: Dict c1 -> Dict c2 -> Dict c3 -> Dict c4 -> Dict c5 -> Dict c6 -> Dict (c1, c2, c3, c4, c5, c6)
      f :: forall (c1 :: Constraint) (c2 :: Constraint) (c3 :: Constraint)
       (c4 :: Constraint) (c5 :: Constraint) (c6 :: Constraint).
Dict c1
-> Dict c2
-> Dict c3
-> Dict c4
-> Dict c5
-> Dict c6
-> Dict (c1, c2, c3, c4, c5, c6)
f Dict c1
Dict Dict c2
Dict Dict c3
Dict Dict c4
Dict Dict c5
Dict Dict c6
Dict = Dict (c1, c2, c3, c4, c5, c6)
forall (a :: Constraint). a => Dict a
Dict

-- instance (Static c1, Static c2, Typeable c1, Typeable c2, (c1, c2)) => Static (c1, c2) where
--   closureDict = static pairDict `cap` closureDict `cap` closureDict

-- | A newtype-wrapper useful for defining instances of classes indexed by
-- higher-kinded types.
newtype WrappedArrowClosure a b = WrapArrowClosure
  { forall a b. WrappedArrowClosure a b -> Closure (a -> b)
unwrapClosureArrow :: Closure (a -> b)
  } deriving (Get (WrappedArrowClosure a b)
[WrappedArrowClosure a b] -> Put
WrappedArrowClosure a b -> Put
(WrappedArrowClosure a b -> Put)
-> Get (WrappedArrowClosure a b)
-> ([WrappedArrowClosure a b] -> Put)
-> Binary (WrappedArrowClosure a b)
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
forall a b.
(Typeable a, Typeable b) =>
Get (WrappedArrowClosure a b)
forall a b.
(Typeable a, Typeable b) =>
[WrappedArrowClosure a b] -> Put
forall a b.
(Typeable a, Typeable b) =>
WrappedArrowClosure a b -> Put
$cput :: forall a b.
(Typeable a, Typeable b) =>
WrappedArrowClosure a b -> Put
put :: WrappedArrowClosure a b -> Put
$cget :: forall a b.
(Typeable a, Typeable b) =>
Get (WrappedArrowClosure a b)
get :: Get (WrappedArrowClosure a b)
$cputList :: forall a b.
(Typeable a, Typeable b) =>
[WrappedArrowClosure a b] -> Put
putList :: [WrappedArrowClosure a b] -> Put
Binary)

infixr 0 /->
type (/->) = WrappedArrowClosure