-- | /Towards Haskell in the Cloud/ (Epstein et al, Haskell Symposium 2011)
-- introduces the concept of /static/ values: values that are known at compile
-- time. In a distributed setting where all nodes are running the same
-- executable, static values can be serialized simply by transmitting a code
-- pointer to the value. This however requires special compiler support, which
-- is not yet available in ghc. We can mimick the behaviour by keeping an
-- explicit mapping ('RemoteTable') from labels to values (and making sure that
-- all distributed nodes are using the same 'RemoteTable'). In this module
-- we implement this mimickry and various extensions.
--
-- [Compositionality]
--
-- Static values as described in the paper are not compositional: there is no
-- way to combine two static values and get a static value out of it. This
-- makes sense when interpreting static strictly as /known at compile time/,
-- but it severely limits expressiveness. However, the main motivation for
-- 'static' is not that they are known at compile time but rather that
-- /they provide a free/ 'Binary' /instance/.  We therefore provide two basic
-- constructors for 'Static' values:
--
-- > staticLabel :: String -> Static a
-- > staticApply :: Static (a -> b) -> Static a -> Static b
--
-- The first constructor refers to a label in a 'RemoteTable'. The second
-- allows to apply a static function to a static argument, and makes 'Static'
-- compositional: once we have 'staticApply' we can implement numerous derived
-- combinators on 'Static' values (we define a few in this module; see
-- 'staticCompose', 'staticSplit', and 'staticConst').
--
-- [Closures]
--
-- Closures in functional programming arise when we partially apply a function.
-- A closure is a code pointer together with a runtime data structure that
-- represents the value of the free variables of the function. A 'Closure'
-- represents these closures explicitly so that they can be serialized:
--
-- > data Closure a = Closure (Static (ByteString -> a)) ByteString
--
-- See /Towards Haskell in the Cloud/ for the rationale behind representing
-- the function closure environment in serialized ('ByteString') form. Any
-- static value can trivially be turned into a 'Closure' ('staticClosure').
-- Moreover, since 'Static' is now compositional, we can also define derived
-- operators on 'Closure' values ('closureApplyStatic', 'closureApply',
-- 'closureCompose', 'closureSplit').
--
-- [Monomorphic example]
--
-- Suppose we are working in the context of some distributed environment, with
-- a monadic type 'Process' representing processes, 'NodeId' representing node
-- addresses and 'ProcessId' representing process addresses. Suppose further
-- that we have a primitive
--
-- > sendInt :: ProcessId -> Int -> Process ()
--
-- We might want to define
--
-- > sendIntClosure :: ProcessId -> Closure (Int -> Process ())
--
-- In order to do that, we need a static version of 'send', and a static
-- decoder for 'ProcessId':
--
-- > sendIntStatic :: Static (ProcessId -> Int -> Process ())
-- > sendIntStatic = staticLabel "$send"
--
-- > decodeProcessIdStatic :: Static (ByteString -> Int)
-- > decodeProcessIdStatic = staticLabel "$decodeProcessId"
--
-- where of course we have to make sure to use an appropriate 'RemoteTable':
--
-- > rtable :: RemoteTable
-- > rtable = registerStatic "$send" (toDynamic sendInt)
-- >        . registerStatic "$decodeProcessId" (toDynamic (decode :: ByteString -> Int))
-- >        $ initRemoteTable
--
-- We can now define 'sendIntClosure':
--
-- > sendIntClosure :: ProcessId -> Closure (Int -> Process ())
-- > sendIntClosure pid = closure decoder (encode pid)
-- >   where
-- >     decoder :: Static (ByteString -> Int -> Process ())
-- >     decoder = sendIntStatic `staticCompose` decodeProcessIdStatic
--
-- [Polymorphic example]
--
-- Suppose we wanted to define a primitive
--
-- > sendIntResult :: ProcessId -> Closure (Process Int) -> Closure (Process ())
--
-- which turns a process that computes an integer into a process that computes
-- the integer and then sends it someplace else.
--
-- We can define
--
-- > bindStatic :: (Typeable a, Typeable b) => Static (Process a -> (a -> Process b) -> Process b)
-- > bindStatic = staticLabel "$bind"
--
-- provided that we register this label:
--
-- > rtable :: RemoteTable
-- > rtable = ...
-- >        . registerStatic "$bind" ((>>=) :: Process ANY1 -> (ANY1 -> Process ANY2) -> Process ANY2)
-- >        $ initRemoteTable
--
-- (Note that we are using the special 'Data.Rank1Typeable.ANY1' and
-- 'Data.Rank1Typeable.ANY2' types from "Data.Rank1Typeable" to represent this
-- polymorphic value.) Once we have a static bind we can define
--
-- > sendIntResult :: ProcessId -> Closure (Process Int) -> Closure (Process ())
-- > sendIntResult pid cl = bindStatic `closureApplyStatic` cl `closureApply` sendIntClosure pid
--
-- [Dealing with qualified types]
--
-- In the above we were careful to avoid qualified types. Suppose that we have
-- instead
--
-- > send :: Binary a => ProcessId -> a -> Process ()
--
-- If we now want to define 'sendClosure', analogous to 'sendIntClosure' above,
-- we somehow need to include the 'Binary' instance in the closure -- after
-- all, we can ship this closure someplace else, where it needs to accept an
-- 'a', /then encode it/, and send it off. In order to do this, we need to turn
-- the Binary instance into an explicit dictionary:
--
-- > data BinaryDict a where
-- >   BinaryDict :: Binary a => BinaryDict a
-- >
-- > sendDict :: BinaryDict a -> ProcessId -> a -> Process ()
-- > sendDict BinaryDict = send
--
-- Now 'sendDict' is a normal polymorphic value:
--
-- > sendDictStatic :: Static (BinaryDict a -> ProcessId -> a -> Process ())
-- > sendDictStatic = staticLabel "$sendDict"
-- >
-- > rtable :: RemoteTable
-- > rtable = ...
-- >        . registerStatic "$sendDict" (sendDict :: BinaryDict ANY -> ProcessId -> ANY -> Process ())
-- >        $ initRemoteTable
--
-- so that we can define
--
-- > sendClosure :: Static (BinaryDict a) -> Process a -> Closure (a -> Process ())
-- > sendClosure dict pid = closure decoder (encode pid)
-- >   where
-- >     decoder :: Static (ByteString -> a -> Process ())
-- >     decoder = (sendDictStatic `staticApply` dict) `staticCompose` decodeProcessIdStatic
--
-- [Word of Caution]
--
-- You should not /define/ functions on 'ANY' and co. For example, the following
-- definition of 'rtable' is incorrect:
--
-- > rtable :: RemoteTable
-- > rtable = registerStatic "$sdictSendPort" sdictSendPort
-- >        $ initRemoteTable
-- >   where
-- >     sdictSendPort :: SerializableDict ANY -> SerializableDict (SendPort ANY)
-- >     sdictSendPort SerializableDict = SerializableDict
--
-- This definition of 'sdictSendPort' ignores its argument completely, and
-- constructs a 'SerializableDict' for the /monomorphic/ type @SendPort ANY@,
-- which isn't what you want. Instead, you should do
--
-- > rtable :: RemoteTable
-- > rtable = registerStatic "$sdictSendPort" (sdictSendPort :: SerializableDict ANY -> SerializableDict (SendPort ANY))
-- >        $ initRemoteTable
-- >   where
-- >     sdictSendPort :: forall a. SerializableDict a -> SerializableDict (SendPort a)
-- >     sdictSendPort SerializableDict = SerializableDict
{-# LANGUAGE StaticPointers #-}
{-# LANGUAGE RoleAnnotations #-}
module Control.Distributed.Static
  ( -- * Static values
    Static
  , staticLabel
  , staticApply
  , staticPtr
  , staticApplyPtr
    -- * Derived static combinators
  , staticCompose
  , staticSplit
  , staticConst
  , staticFlip
    -- * Closures
  , Closure
  , closure
    -- * Derived closure combinators
  , staticClosure
  , closureApplyStatic
  , closureApply
  , closureCompose
  , closureSplit
    -- * Resolution
  , RemoteTable
  , initRemoteTable
  , registerStatic
  , unstatic
  , unclosure
  ) where

import Data.Binary
  ( Binary(get, put)
  , Put
  , Get
  , putWord8
  , getWord8
  , encode
  , decode
  )
import Data.ByteString.Lazy (ByteString, empty)
import Data.Map (Map)
import qualified Data.Map as Map (lookup, empty, insert)
import Control.Arrow as Arrow ((***), app)
import Control.DeepSeq (NFData(rnf), force)
import Data.Rank1Dynamic (Dynamic, toDynamic, fromDynamic, dynApply)
import Data.Rank1Typeable
  ( Typeable
  , ANY1
  , ANY2
  , ANY3
  , ANY4
  , TypeRep
  , typeOf
  )

-- Imports necessary to support StaticPtr
import qualified GHC.Exts as GHC (Any)
import GHC.StaticPtr
import GHC.Fingerprint.Type (Fingerprint(..))
import System.IO.Unsafe (unsafePerformIO)
import Data.Rank1Dynamic (unsafeToDynamic)
import Unsafe.Coerce (unsafeCoerce)

--------------------------------------------------------------------------------
-- Introducing static values                                                  --
--------------------------------------------------------------------------------

-- | Static dynamic values
--
-- In the new proposal for static, the SPT contains these 'TypeRep's.
-- In the current implemnentation however they do not, so we need to carry
-- them ourselves. This is the TypeRep of @a@, /NOT/ of @StaticPtr a@.
data SDynamic = SDynamic TypeRep (StaticPtr GHC.Any)
  deriving (Typeable)

instance Show SDynamic where
  show :: SDynamic -> String
show (SDynamic TypeRep
typ StaticPtr Any
ptr) =
    let spi :: StaticPtrInfo
spi = StaticPtr Any -> StaticPtrInfo
forall a. StaticPtr a -> StaticPtrInfo
staticPtrInfo StaticPtr Any
ptr
        (Int
line, Int
col) = StaticPtrInfo -> (Int, Int)
spInfoSrcLoc StaticPtrInfo
spi
     in [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"<<static ", StaticPtrInfo -> String
spInfoModuleName StaticPtrInfo
spi, String
":", Int -> String
forall a. Show a => a -> String
show Int
line, String
":"
               , Int -> String
forall a. Show a => a -> String
show Int
col, String
" :: ", TypeRep -> String
forall a. Show a => a -> String
show TypeRep
typ, String
">>"
               ]

instance Eq SDynamic where
  SDynamic TypeRep
_ StaticPtr Any
ptr1 == :: SDynamic -> SDynamic -> Bool
== SDynamic TypeRep
_ StaticPtr Any
ptr2 =
    StaticPtr Any -> StaticKey
forall a. StaticPtr a -> StaticKey
staticKey StaticPtr Any
ptr1 StaticKey -> StaticKey -> Bool
forall a. Eq a => a -> a -> Bool
== StaticPtr Any -> StaticKey
forall a. StaticPtr a -> StaticKey
staticKey StaticPtr Any
ptr2

instance Ord SDynamic where
  SDynamic TypeRep
_ StaticPtr Any
ptr1 compare :: SDynamic -> SDynamic -> Ordering
`compare` SDynamic TypeRep
_ StaticPtr Any
ptr2 =
    StaticPtr Any -> StaticKey
forall a. StaticPtr a -> StaticKey
staticKey StaticPtr Any
ptr1 StaticKey -> StaticKey -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` StaticPtr Any -> StaticKey
forall a. StaticPtr a -> StaticKey
staticKey StaticPtr Any
ptr2

data StaticLabel =
    StaticLabel String
  | StaticApply !StaticLabel !StaticLabel
  | StaticPtr SDynamic
  deriving (StaticLabel -> StaticLabel -> Bool
(StaticLabel -> StaticLabel -> Bool)
-> (StaticLabel -> StaticLabel -> Bool) -> Eq StaticLabel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StaticLabel -> StaticLabel -> Bool
== :: StaticLabel -> StaticLabel -> Bool
$c/= :: StaticLabel -> StaticLabel -> Bool
/= :: StaticLabel -> StaticLabel -> Bool
Eq, Eq StaticLabel
Eq StaticLabel =>
(StaticLabel -> StaticLabel -> Ordering)
-> (StaticLabel -> StaticLabel -> Bool)
-> (StaticLabel -> StaticLabel -> Bool)
-> (StaticLabel -> StaticLabel -> Bool)
-> (StaticLabel -> StaticLabel -> Bool)
-> (StaticLabel -> StaticLabel -> StaticLabel)
-> (StaticLabel -> StaticLabel -> StaticLabel)
-> Ord StaticLabel
StaticLabel -> StaticLabel -> Bool
StaticLabel -> StaticLabel -> Ordering
StaticLabel -> StaticLabel -> StaticLabel
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
$ccompare :: StaticLabel -> StaticLabel -> Ordering
compare :: StaticLabel -> StaticLabel -> Ordering
$c< :: StaticLabel -> StaticLabel -> Bool
< :: StaticLabel -> StaticLabel -> Bool
$c<= :: StaticLabel -> StaticLabel -> Bool
<= :: StaticLabel -> StaticLabel -> Bool
$c> :: StaticLabel -> StaticLabel -> Bool
> :: StaticLabel -> StaticLabel -> Bool
$c>= :: StaticLabel -> StaticLabel -> Bool
>= :: StaticLabel -> StaticLabel -> Bool
$cmax :: StaticLabel -> StaticLabel -> StaticLabel
max :: StaticLabel -> StaticLabel -> StaticLabel
$cmin :: StaticLabel -> StaticLabel -> StaticLabel
min :: StaticLabel -> StaticLabel -> StaticLabel
Ord, Typeable, Int -> StaticLabel -> ShowS
[StaticLabel] -> ShowS
StaticLabel -> String
(Int -> StaticLabel -> ShowS)
-> (StaticLabel -> String)
-> ([StaticLabel] -> ShowS)
-> Show StaticLabel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StaticLabel -> ShowS
showsPrec :: Int -> StaticLabel -> ShowS
$cshow :: StaticLabel -> String
show :: StaticLabel -> String
$cshowList :: [StaticLabel] -> ShowS
showList :: [StaticLabel] -> ShowS
Show)

instance NFData StaticLabel where
  rnf :: StaticLabel -> ()
rnf (StaticLabel String
s) = String -> ()
forall a. NFData a => a -> ()
rnf String
s
  rnf (StaticApply StaticLabel
a StaticLabel
b) = StaticLabel -> ()
forall a. NFData a => a -> ()
rnf StaticLabel
a () -> () -> ()
forall a b. a -> b -> b
`seq` StaticLabel -> ()
forall a. NFData a => a -> ()
rnf StaticLabel
b
  -- There are no NFData instances for TypeRep or for StaticPtr :/
  rnf (StaticPtr (SDynamic TypeRep
_a StaticPtr Any
_b)) = ()

-- | A static value. Static is opaque; see 'staticLabel' and 'staticApply'.
newtype Static a = Static StaticLabel
  deriving (Static a -> Static a -> Bool
(Static a -> Static a -> Bool)
-> (Static a -> Static a -> Bool) -> Eq (Static a)
forall a. Static a -> Static a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Static a -> Static a -> Bool
== :: Static a -> Static a -> Bool
$c/= :: forall a. Static a -> Static a -> Bool
/= :: Static a -> Static a -> Bool
Eq, Eq (Static a)
Eq (Static a) =>
(Static a -> Static a -> Ordering)
-> (Static a -> Static a -> Bool)
-> (Static a -> Static a -> Bool)
-> (Static a -> Static a -> Bool)
-> (Static a -> Static a -> Bool)
-> (Static a -> Static a -> Static a)
-> (Static a -> Static a -> Static a)
-> Ord (Static a)
Static a -> Static a -> Bool
Static a -> Static a -> Ordering
Static a -> Static a -> Static a
forall a. Eq (Static 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 a. Static a -> Static a -> Bool
forall a. Static a -> Static a -> Ordering
forall a. Static a -> Static a -> Static a
$ccompare :: forall a. Static a -> Static a -> Ordering
compare :: Static a -> Static a -> Ordering
$c< :: forall a. Static a -> Static a -> Bool
< :: Static a -> Static a -> Bool
$c<= :: forall a. Static a -> Static a -> Bool
<= :: Static a -> Static a -> Bool
$c> :: forall a. Static a -> Static a -> Bool
> :: Static a -> Static a -> Bool
$c>= :: forall a. Static a -> Static a -> Bool
>= :: Static a -> Static a -> Bool
$cmax :: forall a. Static a -> Static a -> Static a
max :: Static a -> Static a -> Static a
$cmin :: forall a. Static a -> Static a -> Static a
min :: Static a -> Static a -> Static a
Ord, Typeable, Int -> Static a -> ShowS
[Static a] -> ShowS
Static a -> String
(Int -> Static a -> ShowS)
-> (Static a -> String) -> ([Static a] -> ShowS) -> Show (Static a)
forall a. Int -> Static a -> ShowS
forall a. [Static a] -> ShowS
forall a. Static a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> Static a -> ShowS
showsPrec :: Int -> Static a -> ShowS
$cshow :: forall a. Static a -> String
show :: Static a -> String
$cshowList :: forall a. [Static a] -> ShowS
showList :: [Static a] -> ShowS
Show)

-- Trying to 'coerce' static values will lead to unification errors
type role Static nominal

instance NFData (Static a) where
  rnf :: Static a -> ()
rnf (Static StaticLabel
s) = StaticLabel -> ()
forall a. NFData a => a -> ()
rnf StaticLabel
s

instance Binary (Static a) where
  put :: Static a -> Put
put (Static StaticLabel
label) = StaticLabel -> Put
putStaticLabel StaticLabel
label
  get :: Get (Static a)
get = StaticLabel -> Static a
forall a. StaticLabel -> Static a
Static (StaticLabel -> Static a) -> Get StaticLabel -> Get (Static a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get StaticLabel
getStaticLabel

-- We don't want StaticLabel to be its own Binary instance
putStaticLabel :: StaticLabel -> Put
putStaticLabel :: StaticLabel -> Put
putStaticLabel (StaticLabel String
string) =
  Word8 -> Put
putWord8 Word8
0 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
forall t. Binary t => t -> Put
put String
string
putStaticLabel (StaticApply StaticLabel
label1 StaticLabel
label2) =
  Word8 -> Put
putWord8 Word8
1 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StaticLabel -> Put
putStaticLabel StaticLabel
label1 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StaticLabel -> Put
putStaticLabel StaticLabel
label2
putStaticLabel (StaticPtr (SDynamic TypeRep
typ StaticPtr Any
ptr)) =
  let Fingerprint Word64
hi Word64
lo = StaticPtr Any -> StaticKey
forall a. StaticPtr a -> StaticKey
staticKey StaticPtr Any
ptr
  in Word8 -> Put
putWord8 Word8
2 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeRep -> Put
forall t. Binary t => t -> Put
put TypeRep
typ Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word64 -> Put
forall t. Binary t => t -> Put
put Word64
hi Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word64 -> Put
forall t. Binary t => t -> Put
put Word64
lo

getStaticLabel :: Get StaticLabel
getStaticLabel :: Get StaticLabel
getStaticLabel = do
  Word8
header <- Get Word8
getWord8
  case Word8
header of
    Word8
0 -> String -> StaticLabel
StaticLabel (String -> StaticLabel) -> Get String -> Get StaticLabel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get String
forall t. Binary t => Get t
get
    Word8
1 -> StaticLabel -> StaticLabel -> StaticLabel
StaticApply (StaticLabel -> StaticLabel -> StaticLabel)
-> Get StaticLabel -> Get (StaticLabel -> StaticLabel)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get StaticLabel
getStaticLabel Get (StaticLabel -> StaticLabel)
-> Get StaticLabel -> Get StaticLabel
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get StaticLabel
getStaticLabel
    Word8
2 -> do TypeRep
typ <- Get TypeRep
forall t. Binary t => Get t
get
            Word64
hi  <- Get Word64
forall t. Binary t => Get t
get
            Word64
lo  <- Get Word64
forall t. Binary t => Get t
get
            let key :: StaticKey
key = Word64 -> Word64 -> StaticKey
Fingerprint Word64
hi Word64
lo
            case StaticKey -> Maybe (StaticPtr Any)
forall a. StaticKey -> Maybe (StaticPtr a)
unsaferLookupStaticPtr StaticKey
key of
              Maybe (StaticPtr Any)
Nothing  -> String -> Get StaticLabel
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"StaticLabel.get: invalid pointer"
              Just StaticPtr Any
ptr -> StaticLabel -> Get StaticLabel
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (StaticLabel -> Get StaticLabel) -> StaticLabel -> Get StaticLabel
forall a b. (a -> b) -> a -> b
$ SDynamic -> StaticLabel
StaticPtr (TypeRep -> StaticPtr Any -> SDynamic
SDynamic TypeRep
typ StaticPtr Any
ptr)
    Word8
_ -> String -> Get StaticLabel
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"StaticLabel.get: invalid"

-- | We need to be able to lookup keys outside of the IO monad so that we
-- can provide a 'Get' instance.
unsaferLookupStaticPtr :: StaticKey -> Maybe (StaticPtr a)
unsaferLookupStaticPtr :: forall a. StaticKey -> Maybe (StaticPtr a)
unsaferLookupStaticPtr = IO (Maybe (StaticPtr a)) -> Maybe (StaticPtr a)
forall a. IO a -> a
unsafePerformIO (IO (Maybe (StaticPtr a)) -> Maybe (StaticPtr a))
-> (StaticKey -> IO (Maybe (StaticPtr a)))
-> StaticKey
-> Maybe (StaticPtr a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaticKey -> IO (Maybe (StaticPtr a))
forall a. StaticKey -> IO (Maybe (StaticPtr a))
unsafeLookupStaticPtr

-- | Create a primitive static value.
--
-- It is the responsibility of the client code to make sure the corresponding
-- entry in the 'RemoteTable' has the appropriate type.
staticLabel :: String -> Static a
staticLabel :: forall a. String -> Static a
staticLabel = StaticLabel -> Static a
forall a. StaticLabel -> Static a
Static (StaticLabel -> Static a)
-> (String -> StaticLabel) -> String -> Static a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StaticLabel
StaticLabel (String -> StaticLabel) -> ShowS -> String -> StaticLabel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. NFData a => a -> a
force

-- | Apply two static values
staticApply :: Static (a -> b) -> Static a -> Static b
staticApply :: forall a b. Static (a -> b) -> Static a -> Static b
staticApply (Static StaticLabel
f) (Static StaticLabel
x) = StaticLabel -> Static b
forall a. StaticLabel -> Static a
Static (StaticLabel -> StaticLabel -> StaticLabel
StaticApply StaticLabel
f StaticLabel
x)

-- | Construct a static value from a static pointer
--
-- Since 0.3.4.0.
staticPtr :: forall a. Typeable a => StaticPtr a -> Static a
staticPtr :: forall a. Typeable a => StaticPtr a -> Static a
staticPtr StaticPtr a
x = StaticLabel -> Static a
forall a. StaticLabel -> Static a
Static (StaticLabel -> Static a)
-> (SDynamic -> StaticLabel) -> SDynamic -> Static a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDynamic -> StaticLabel
StaticPtr
            (SDynamic -> Static a) -> SDynamic -> Static a
forall a b. (a -> b) -> a -> b
$ TypeRep -> StaticPtr Any -> SDynamic
SDynamic (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (a
forall a. HasCallStack => a
undefined :: a)) (StaticPtr a -> StaticPtr Any
forall a b. a -> b
unsafeCoerce StaticPtr a
x)

-- | Apply a static pointer to a static value
--
-- Since 0.3.4.0.
staticApplyPtr :: (Typeable a, Typeable b)
               => StaticPtr (a -> b) -> Static a -> Static b
staticApplyPtr :: forall a b.
(Typeable a, Typeable b) =>
StaticPtr (a -> b) -> Static a -> Static b
staticApplyPtr = Static (a -> b) -> Static a -> Static b
forall a b. Static (a -> b) -> Static a -> Static b
staticApply (Static (a -> b) -> Static a -> Static b)
-> (StaticPtr (a -> b) -> Static (a -> b))
-> StaticPtr (a -> b)
-> Static a
-> Static b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaticPtr (a -> b) -> Static (a -> b)
forall a. Typeable a => StaticPtr a -> Static a
staticPtr

--------------------------------------------------------------------------------
-- Eliminating static values                                                  --
--------------------------------------------------------------------------------

-- | Runtime dictionary for 'unstatic' lookups
newtype RemoteTable = RemoteTable (Map String Dynamic)

-- | Initial remote table
initRemoteTable :: RemoteTable
initRemoteTable :: RemoteTable
initRemoteTable =
      String -> Dynamic -> RemoteTable -> RemoteTable
registerStatic String
"$compose"       (((ANY2 -> ANY3) -> (ANY1 -> ANY2) -> ANY1 -> ANY3) -> Dynamic
forall a. Typeable a => a -> Dynamic
toDynamic ((ANY2 -> ANY3) -> (ANY1 -> ANY2) -> ANY1 -> ANY3
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)    :: (ANY2 -> ANY3) -> (ANY1 -> ANY2) -> ANY1 -> ANY3))
    (RemoteTable -> RemoteTable)
-> (RemoteTable -> RemoteTable) -> RemoteTable -> RemoteTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Dynamic -> RemoteTable -> RemoteTable
registerStatic String
"$const"         ((ANY1 -> ANY2 -> ANY1) -> Dynamic
forall a. Typeable a => a -> Dynamic
toDynamic (ANY1 -> ANY2 -> ANY1
forall a b. a -> b -> a
const  :: ANY1 -> ANY2 -> ANY1))
    (RemoteTable -> RemoteTable)
-> (RemoteTable -> RemoteTable) -> RemoteTable -> RemoteTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Dynamic -> RemoteTable -> RemoteTable
registerStatic String
"$split"         (((ANY1 -> ANY3) -> (ANY2 -> ANY4) -> (ANY1, ANY2) -> (ANY3, ANY4))
-> Dynamic
forall a. Typeable a => a -> Dynamic
toDynamic ((ANY1 -> ANY3) -> (ANY2 -> ANY4) -> (ANY1, ANY2) -> (ANY3, ANY4)
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
(***)  :: (ANY1 -> ANY3) -> (ANY2 -> ANY4) -> (ANY1, ANY2) -> (ANY3, ANY4)))
    (RemoteTable -> RemoteTable)
-> (RemoteTable -> RemoteTable) -> RemoteTable -> RemoteTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Dynamic -> RemoteTable -> RemoteTable
registerStatic String
"$app"           (((ANY1 -> ANY2, ANY1) -> ANY2) -> Dynamic
forall a. Typeable a => a -> Dynamic
toDynamic ((ANY1 -> ANY2, ANY1) -> ANY2
forall b c. (b -> c, b) -> c
forall (a :: * -> * -> *) b c. ArrowApply a => a (a b c, b) c
app    :: (ANY1 -> ANY2, ANY1) -> ANY2))
    (RemoteTable -> RemoteTable)
-> (RemoteTable -> RemoteTable) -> RemoteTable -> RemoteTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Dynamic -> RemoteTable -> RemoteTable
registerStatic String
"$decodeEnvPair" ((ByteString -> (ByteString, ByteString)) -> Dynamic
forall a. Typeable a => a -> Dynamic
toDynamic (ByteString -> (ByteString, ByteString)
forall a. Binary a => ByteString -> a
decode :: ByteString -> (ByteString, ByteString)))
    (RemoteTable -> RemoteTable)
-> (RemoteTable -> RemoteTable) -> RemoteTable -> RemoteTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Dynamic -> RemoteTable -> RemoteTable
registerStatic String
"$flip"          (((ANY1 -> ANY2 -> ANY3) -> ANY2 -> ANY1 -> ANY3) -> Dynamic
forall a. Typeable a => a -> Dynamic
toDynamic ((ANY1 -> ANY2 -> ANY3) -> ANY2 -> ANY1 -> ANY3
forall a b c. (a -> b -> c) -> b -> a -> c
flip   :: (ANY1 -> ANY2 -> ANY3) -> ANY2 -> ANY1 -> ANY3))
    (RemoteTable -> RemoteTable) -> RemoteTable -> RemoteTable
forall a b. (a -> b) -> a -> b
$ Map String Dynamic -> RemoteTable
RemoteTable Map String Dynamic
forall k a. Map k a
Map.empty

-- | Register a static label
registerStatic :: String -> Dynamic -> RemoteTable -> RemoteTable
registerStatic :: String -> Dynamic -> RemoteTable -> RemoteTable
registerStatic String
label Dynamic
dyn (RemoteTable Map String Dynamic
rtable)
  = Map String Dynamic -> RemoteTable
RemoteTable (String -> Dynamic -> Map String Dynamic -> Map String Dynamic
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
label Dynamic
dyn Map String Dynamic
rtable)

-- Pseudo-type: RemoteTable -> Static a -> a
resolveStaticLabel :: RemoteTable -> StaticLabel -> Either String Dynamic
resolveStaticLabel :: RemoteTable -> StaticLabel -> Either String Dynamic
resolveStaticLabel (RemoteTable Map String Dynamic
rtable) (StaticLabel String
label) =
  case String -> Map String Dynamic -> Maybe Dynamic
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
label Map String Dynamic
rtable of
    Maybe Dynamic
Nothing -> String -> Either String Dynamic
forall a b. a -> Either a b
Left (String -> Either String Dynamic)
-> String -> Either String Dynamic
forall a b. (a -> b) -> a -> b
$ String
"Invalid static label '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
label String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'"
    Just Dynamic
d  -> Dynamic -> Either String Dynamic
forall a b. b -> Either a b
Right Dynamic
d
resolveStaticLabel RemoteTable
rtable (StaticApply StaticLabel
label1 StaticLabel
label2) = do
  Dynamic
f <- RemoteTable -> StaticLabel -> Either String Dynamic
resolveStaticLabel RemoteTable
rtable StaticLabel
label1
  Dynamic
x <- RemoteTable -> StaticLabel -> Either String Dynamic
resolveStaticLabel RemoteTable
rtable StaticLabel
label2
  Dynamic
f Dynamic -> Dynamic -> Either String Dynamic
`dynApply` Dynamic
x
resolveStaticLabel RemoteTable
_ (StaticPtr (SDynamic TypeRep
typ StaticPtr Any
ptr)) =
  Dynamic -> Either String Dynamic
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Dynamic -> Either String Dynamic)
-> Dynamic -> Either String Dynamic
forall a b. (a -> b) -> a -> b
$ TypeRep -> Any -> Dynamic
forall a. TypeRep -> a -> Dynamic
unsafeToDynamic TypeRep
typ (StaticPtr Any -> Any
forall a. StaticPtr a -> a
deRefStaticPtr StaticPtr Any
ptr)

-- | Resolve a static value
unstatic :: Typeable a => RemoteTable -> Static a -> Either String a
unstatic :: forall a. Typeable a => RemoteTable -> Static a -> Either String a
unstatic RemoteTable
rtable (Static StaticLabel
label) = do
  Dynamic
dyn <- RemoteTable -> StaticLabel -> Either String Dynamic
resolveStaticLabel RemoteTable
rtable StaticLabel
label
  Dynamic -> Either String a
forall a. Typeable a => Dynamic -> Either String a
fromDynamic Dynamic
dyn

--------------------------------------------------------------------------------
-- Closures                                                                   --
--------------------------------------------------------------------------------

-- | A closure is a static value and an encoded environment
data Closure a = Closure !(Static (ByteString -> a)) !ByteString
  deriving (Closure a -> Closure a -> Bool
(Closure a -> Closure a -> Bool)
-> (Closure a -> Closure a -> Bool) -> Eq (Closure a)
forall a. Closure a -> Closure a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Closure a -> Closure a -> Bool
== :: Closure a -> Closure a -> Bool
$c/= :: forall a. Closure a -> Closure a -> Bool
/= :: Closure a -> Closure a -> Bool
Eq, Eq (Closure a)
Eq (Closure a) =>
(Closure a -> Closure a -> Ordering)
-> (Closure a -> Closure a -> Bool)
-> (Closure a -> Closure a -> Bool)
-> (Closure a -> Closure a -> Bool)
-> (Closure a -> Closure a -> Bool)
-> (Closure a -> Closure a -> Closure a)
-> (Closure a -> Closure a -> Closure a)
-> Ord (Closure a)
Closure a -> Closure a -> Bool
Closure a -> Closure a -> Ordering
Closure a -> Closure a -> Closure a
forall a. Eq (Closure 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 a. Closure a -> Closure a -> Bool
forall a. Closure a -> Closure a -> Ordering
forall a. Closure a -> Closure a -> Closure a
$ccompare :: forall a. Closure a -> Closure a -> Ordering
compare :: Closure a -> Closure a -> Ordering
$c< :: forall a. Closure a -> Closure a -> Bool
< :: Closure a -> Closure a -> Bool
$c<= :: forall a. Closure a -> Closure a -> Bool
<= :: Closure a -> Closure a -> Bool
$c> :: forall a. Closure a -> Closure a -> Bool
> :: Closure a -> Closure a -> Bool
$c>= :: forall a. Closure a -> Closure a -> Bool
>= :: Closure a -> Closure a -> Bool
$cmax :: forall a. Closure a -> Closure a -> Closure a
max :: Closure a -> Closure a -> Closure a
$cmin :: forall a. Closure a -> Closure a -> Closure a
min :: Closure a -> Closure a -> Closure a
Ord, Typeable, Int -> Closure a -> ShowS
[Closure a] -> ShowS
Closure a -> String
(Int -> Closure a -> ShowS)
-> (Closure a -> String)
-> ([Closure a] -> ShowS)
-> Show (Closure a)
forall a. Int -> Closure a -> ShowS
forall a. [Closure a] -> ShowS
forall a. Closure a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> Closure a -> ShowS
showsPrec :: Int -> Closure a -> ShowS
$cshow :: forall a. Closure a -> String
show :: Closure a -> String
$cshowList :: forall a. [Closure a] -> ShowS
showList :: [Closure a] -> ShowS
Show)

instance Binary (Closure a) where
  put :: Closure a -> Put
put (Closure Static (ByteString -> a)
st ByteString
env) = Static (ByteString -> a) -> Put
forall t. Binary t => t -> Put
put Static (ByteString -> a)
st Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Put
forall t. Binary t => t -> Put
put ByteString
env
  get :: Get (Closure a)
get = Static (ByteString -> a) -> ByteString -> Closure a
forall a. Static (ByteString -> a) -> ByteString -> Closure a
Closure (Static (ByteString -> a) -> ByteString -> Closure a)
-> Get (Static (ByteString -> a)) -> Get (ByteString -> Closure a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Static (ByteString -> a))
forall t. Binary t => Get t
get Get (ByteString -> Closure a) -> Get ByteString -> Get (Closure a)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ByteString
forall t. Binary t => Get t
get

instance NFData (Closure a) where rnf :: Closure a -> ()
rnf (Closure Static (ByteString -> a)
f ByteString
b) = Static (ByteString -> a) -> ()
forall a. NFData a => a -> ()
rnf Static (ByteString -> a)
f () -> () -> ()
forall a b. a -> b -> b
`seq` ByteString -> ()
forall a. NFData a => a -> ()
rnf ByteString
b

closure :: Static (ByteString -> a) -- ^ Decoder
        -> ByteString               -- ^ Encoded closure environment
        -> Closure a
closure :: forall a. Static (ByteString -> a) -> ByteString -> Closure a
closure = Static (ByteString -> a) -> ByteString -> Closure a
forall a. Static (ByteString -> a) -> ByteString -> Closure a
Closure

-- | Resolve a closure
unclosure :: Typeable a => RemoteTable -> Closure a -> Either String a
unclosure :: forall a. Typeable a => RemoteTable -> Closure a -> Either String a
unclosure RemoteTable
rtable (Closure Static (ByteString -> a)
dec ByteString
env) = do
  ByteString -> a
f <- RemoteTable
-> Static (ByteString -> a) -> Either String (ByteString -> a)
forall a. Typeable a => RemoteTable -> Static a -> Either String a
unstatic RemoteTable
rtable Static (ByteString -> a)
dec
  a -> Either String a
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> a
f ByteString
env)

-- | Convert a static value into a closure.
staticClosure :: Static a -> Closure a
staticClosure :: forall a. Static a -> Closure a
staticClosure Static a
dec = Static (ByteString -> a) -> ByteString -> Closure a
forall a. Static (ByteString -> a) -> ByteString -> Closure a
closure (Static a -> Static (ByteString -> a)
forall a b. Static a -> Static (b -> a)
staticConst Static a
dec) ByteString
empty

--------------------------------------------------------------------------------
-- Predefined static values                                                   --
--------------------------------------------------------------------------------

-- | Static version of ('Prelude..')
composeStatic :: Static ((b -> c) -> (a -> b) -> a -> c)
composeStatic :: forall b c a. Static ((b -> c) -> (a -> b) -> a -> c)
composeStatic = String -> Static ((b -> c) -> (a -> b) -> a -> c)
forall a. String -> Static a
staticLabel String
"$compose"

-- | Static version of 'const'
constStatic :: Static (a -> b -> a)
constStatic :: forall a b. Static (a -> b -> a)
constStatic = String -> Static (a -> b -> a)
forall a. String -> Static a
staticLabel String
"$const"

-- | Static version of ('Arrow.***')
splitStatic :: Static ((a -> b) -> (a' -> b') -> (a, a') -> (b, b'))
splitStatic :: forall a b a' b'.
Static ((a -> b) -> (a' -> b') -> (a, a') -> (b, b'))
splitStatic = String -> Static ((a -> b) -> (a' -> b') -> (a, a') -> (b, b'))
forall a. String -> Static a
staticLabel String
"$split"

-- | Static version of 'Arrow.app'
appStatic :: Static ((a -> b, a) -> b)
appStatic :: forall a b. Static ((a -> b, a) -> b)
appStatic = String -> Static ((a -> b, a) -> b)
forall a. String -> Static a
staticLabel String
"$app"

-- | Static version of 'flip'
flipStatic :: Static ((a -> b -> c) -> b -> a -> c)
flipStatic :: forall a b c. Static ((a -> b -> c) -> b -> a -> c)
flipStatic = String -> Static ((a -> b -> c) -> b -> a -> c)
forall a. String -> Static a
staticLabel String
"$flip"

--------------------------------------------------------------------------------
-- Combinators on static values                                               --
--------------------------------------------------------------------------------

-- | Static version of ('Prelude..')
staticCompose :: Static (b -> c) -> Static (a -> b) -> Static (a -> c)
staticCompose :: forall b c a. Static (b -> c) -> Static (a -> b) -> Static (a -> c)
staticCompose Static (b -> c)
g Static (a -> b)
f = Static ((b -> c) -> (a -> b) -> a -> c)
forall b c a. Static ((b -> c) -> (a -> b) -> a -> c)
composeStatic Static ((b -> c) -> (a -> b) -> a -> c)
-> Static (b -> c) -> Static ((a -> b) -> a -> c)
forall a b. Static (a -> b) -> Static a -> Static b
`staticApply` Static (b -> c)
g Static ((a -> b) -> a -> c) -> Static (a -> b) -> Static (a -> c)
forall a b. Static (a -> b) -> Static a -> Static b
`staticApply` Static (a -> b)
f

-- | Static version of ('Control.Arrow.***')
staticSplit :: Static (a -> b) -> Static (a' -> b') -> Static ((a, a') -> (b, b'))
staticSplit :: forall a b a' b'.
Static (a -> b) -> Static (a' -> b') -> Static ((a, a') -> (b, b'))
staticSplit Static (a -> b)
f Static (a' -> b')
g = Static ((a -> b) -> (a' -> b') -> (a, a') -> (b, b'))
forall a b a' b'.
Static ((a -> b) -> (a' -> b') -> (a, a') -> (b, b'))
splitStatic Static ((a -> b) -> (a' -> b') -> (a, a') -> (b, b'))
-> Static (a -> b) -> Static ((a' -> b') -> (a, a') -> (b, b'))
forall a b. Static (a -> b) -> Static a -> Static b
`staticApply` Static (a -> b)
f Static ((a' -> b') -> (a, a') -> (b, b'))
-> Static (a' -> b') -> Static ((a, a') -> (b, b'))
forall a b. Static (a -> b) -> Static a -> Static b
`staticApply` Static (a' -> b')
g

-- | Static version of 'Prelude.const'
staticConst :: Static a -> Static (b -> a)
staticConst :: forall a b. Static a -> Static (b -> a)
staticConst Static a
x = Static (a -> b -> a)
forall a b. Static (a -> b -> a)
constStatic Static (a -> b -> a) -> Static a -> Static (b -> a)
forall a b. Static (a -> b) -> Static a -> Static b
`staticApply` Static a
x

-- | Static version of 'Prelude.flip'
staticFlip :: Static (a -> b -> c) -> Static (b -> a -> c)
staticFlip :: forall a b c. Static (a -> b -> c) -> Static (b -> a -> c)
staticFlip Static (a -> b -> c)
f = Static ((a -> b -> c) -> b -> a -> c)
forall a b c. Static ((a -> b -> c) -> b -> a -> c)
flipStatic Static ((a -> b -> c) -> b -> a -> c)
-> Static (a -> b -> c) -> Static (b -> a -> c)
forall a b. Static (a -> b) -> Static a -> Static b
`staticApply` Static (a -> b -> c)
f

--------------------------------------------------------------------------------
-- Combinators on Closures                                                    --
--------------------------------------------------------------------------------

-- | Apply a static function to a closure
closureApplyStatic :: Static (a -> b) -> Closure a -> Closure b
closureApplyStatic :: forall a b. Static (a -> b) -> Closure a -> Closure b
closureApplyStatic Static (a -> b)
f (Closure Static (ByteString -> a)
decoder ByteString
env) =
  Static (ByteString -> b) -> ByteString -> Closure b
forall a. Static (ByteString -> a) -> ByteString -> Closure a
closure (Static (a -> b)
f Static (a -> b)
-> Static (ByteString -> a) -> Static (ByteString -> b)
forall b c a. Static (b -> c) -> Static (a -> b) -> Static (a -> c)
`staticCompose` Static (ByteString -> a)
decoder) ByteString
env

decodeEnvPairStatic :: Static (ByteString -> (ByteString, ByteString))
decodeEnvPairStatic :: Static (ByteString -> (ByteString, ByteString))
decodeEnvPairStatic = String -> Static (ByteString -> (ByteString, ByteString))
forall a. String -> Static a
staticLabel String
"$decodeEnvPair"

-- | Closure application
closureApply :: forall a b .
                Closure (a -> b) -> Closure a -> Closure b
closureApply :: forall a b. Closure (a -> b) -> Closure a -> Closure b
closureApply (Closure Static (ByteString -> a -> b)
fdec ByteString
fenv) (Closure Static (ByteString -> a)
xdec ByteString
xenv) =
    Static (ByteString -> b) -> ByteString -> Closure b
forall a. Static (ByteString -> a) -> ByteString -> Closure a
closure Static (ByteString -> b)
decoder ((ByteString, ByteString) -> ByteString
forall a. Binary a => a -> ByteString
encode (ByteString
fenv, ByteString
xenv))
  where
    decoder :: Static (ByteString -> b)
    decoder :: Static (ByteString -> b)
decoder = Static ((a -> b, a) -> b)
forall a b. Static ((a -> b, a) -> b)
appStatic
            Static ((a -> b, a) -> b)
-> Static ((ByteString, ByteString) -> (a -> b, a))
-> Static ((ByteString, ByteString) -> b)
forall b c a. Static (b -> c) -> Static (a -> b) -> Static (a -> c)
`staticCompose`
              (Static (ByteString -> a -> b)
fdec Static (ByteString -> a -> b)
-> Static (ByteString -> a)
-> Static ((ByteString, ByteString) -> (a -> b, a))
forall a b a' b'.
Static (a -> b) -> Static (a' -> b') -> Static ((a, a') -> (b, b'))
`staticSplit` Static (ByteString -> a)
xdec)
            Static ((ByteString, ByteString) -> b)
-> Static (ByteString -> (ByteString, ByteString))
-> Static (ByteString -> b)
forall b c a. Static (b -> c) -> Static (a -> b) -> Static (a -> c)
`staticCompose`
              Static (ByteString -> (ByteString, ByteString))
decodeEnvPairStatic

-- | Closure composition
closureCompose :: Closure (b -> c) -> Closure (a -> b) -> Closure (a -> c)
closureCompose :: forall b c a.
Closure (b -> c) -> Closure (a -> b) -> Closure (a -> c)
closureCompose Closure (b -> c)
g Closure (a -> b)
f = Static ((b -> c) -> (a -> b) -> a -> c)
forall b c a. Static ((b -> c) -> (a -> b) -> a -> c)
composeStatic Static ((b -> c) -> (a -> b) -> a -> c)
-> Closure (b -> c) -> Closure ((a -> b) -> a -> c)
forall a b. Static (a -> b) -> Closure a -> Closure b
`closureApplyStatic` Closure (b -> c)
g Closure ((a -> b) -> a -> c)
-> Closure (a -> b) -> Closure (a -> c)
forall a b. Closure (a -> b) -> Closure a -> Closure b
`closureApply` Closure (a -> b)
f

-- | Closure version of ('Arrow.***')
closureSplit ::  Closure (a -> b) -> Closure (a' -> b') -> Closure ((a, a') -> (b, b'))
closureSplit :: forall a b a' b'.
Closure (a -> b)
-> Closure (a' -> b') -> Closure ((a, a') -> (b, b'))
closureSplit Closure (a -> b)
f Closure (a' -> b')
g = Static ((a -> b) -> (a' -> b') -> (a, a') -> (b, b'))
forall a b a' b'.
Static ((a -> b) -> (a' -> b') -> (a, a') -> (b, b'))
splitStatic Static ((a -> b) -> (a' -> b') -> (a, a') -> (b, b'))
-> Closure (a -> b) -> Closure ((a' -> b') -> (a, a') -> (b, b'))
forall a b. Static (a -> b) -> Closure a -> Closure b
`closureApplyStatic` Closure (a -> b)
f Closure ((a' -> b') -> (a, a') -> (b, b'))
-> Closure (a' -> b') -> Closure ((a, a') -> (b, b'))
forall a b. Closure (a -> b) -> Closure a -> Closure b
`closureApply` Closure (a' -> b')
g