-- they are underneath the code that follows

-- the code
-- specifies parallelism
-- and
-- implements it using a dummy version of the hakka library
-- (see https://hackage.haskell.org/package/hakka-0.2.0/docs/src/Hakka-Actor.html)

-- first I need some language extensions

{-# LANGUAGE TypeOperators #-}

{-# LANGUAGE MultiParamTypeClasses #-}

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

{-# LANGUAGE FlexibleInstances #-}

{-# LANGUAGE InstanceSigs #-}

{-# LANGUAGE LambdaCase #-}

{-# LANGUAGE GADTs #-}

-- next I need some imports

import           Control.Monad.IO.Class

import           Control.Monad.Trans.Class

import           Control.Monad.Trans.State.Strict
import           Control.Monad.Trans.Cont

-- next some useful generic code

infixr `c`
infixr `d`

f `c` g = f . g

(f `d` g) h = f `c` g h

--
-- parallel specification
--
-- note the extra type class parameters x and w
--

type z && y = (z, y)

class Parallel x w to where
    par :: (z `to` x) -> (y `to` w) -> (z && y) `to` (x && w)

--
-- parallel implementation
--
-- o msg stands for message
-- o mnd stands for monad
-- o rst stands for result
--
--
-- three actors involved
--
-- o reactor
--  - reacts by using a continuation cont when both
--   . an x result (at left)
--   . a w result (at right)
--    have been received
--
-- o leftActor
--  - acts to send an x result (at left) to reactor
--
-- o rightActor
--  - acts to send a w result (at right) to reactor
--
-- reactor sends both leftActor and rightActor a message to let them act
--

data ActorRef = ActorRef

newtype ActorContext msg = ActorContext msg

newtype ActorT msg mnd z = ActorT { runActorT :: StateT (ActorContext msg) mnd z }
  deriving (Functor, Applicative, Monad, MonadFail, MonadTrans, MonadIO)

actor :: String -> (msg -> ActorT msg IO ()) -> ActorT msg IO ActorRef
actor name messageHandler = undefined

become :: (msg -> ActorT msg IO ()) -> ActorT msg IO ()
become messageHandler = undefined

(!) :: ActorRef -> msg -> ActorT msg IO ()
actorRef ! message = undefined

newtype ReactiveT msg rst mnd z = ReactiveT { runReactiveT :: ContT rst (ActorT msg mnd) z }
  deriving (Functor, Applicative, Monad, MonadFail, MonadIO)

newtype KleisliT mnd z y = KleisliT { runKleisliT :: z -> mnd y }

type ReactiveParallelT msg rst mnd = KleisliT (ReactiveT msg rst mnd)

data Message x w = LeftReact x | RightReact w | LeftAct | RightAct

type ReactiveActorBasedParallelT x w = ReactiveParallelT (Message x w) () IO
runReactiveActorBasedParallelT = runContT `d` runReactiveT `d` runKleisliT

instance Parallel x w (ReactiveActorBasedParallelT x w) where
  par z2x y2w = KleisliT
    (\case
      (z, y) -> ReactiveT
        (ContT
          (\cont ->
            actor
                "reactor"
                (\case
                  LeftReact x -> become
                    (\case
                      RightReact w -> cont (x, w)
                    )
                  RightReact w -> become
                    (\case
                      LeftReact x -> cont (x, w)
                    )
                )
              >>= \reactorRef ->
                    actor
                        "leftActor"
                        (\case
                          LeftAct -> runReactiveActorBasedParallelT
                            z2x
                            z
                            (\x -> reactorRef ! LeftReact x)
                        )
                      >>= \leftActorRef ->
                            actor
                                "rightActor"
                                (\case
                                  RightAct -> runReactiveActorBasedParallelT
                                    y2w
                                    y
                                    (\w -> reactorRef ! RightReact w)
                                )
                              >>= \rightActorRef ->
                                    leftActorRef
                                      !  LeftAct
                                      >> rightActorRef
                                      !  RightAct
          )
        )
    )


-- class Parallel to where

-- data Message = forall x. LeftReact x | forall w. RightReact w | LeftAct | RightAct

-- data Message where
--   LeftReact :: x -> Message
--   RightReact :: w -> Message
--   LeftAct :: Message
--   RightAct :: Message

-- type ReactiveActorBasedParallelT = ReactiveParallelT Message () IO

-- instance Parallel (ReactiveActorBasedParallelT IO) where

--
   __~O
  -\ <,
(*)/ (*)

reality goes far beyond imagination