machines.hs

-- Type-aligned sequence catenable queue supporting O(1) append, snoc, uncons
-- Don't need it to be a dequeue (unsnoc not needed)
data TCQueue c a b -- c is the category, a is starting type, b is ending type

type Channel f a b = TCQueue (Transition f) a b
type Process f b = Channel f () b

data Transition f a b where
  Bind :: (a -> Process f b) -> Transition f a b
  OnHalt :: (Cause -> Process f b) -> Transition f a b 
  Emit :: b -> Transition f a b
  Await :: f b -> Transition f a (Either Cause b)
  Halt :: Cause -> Transition f a b

data Cause = Normal | Error String

onHalt :: Channel f a b -> (Cause -> Process f b) -> Channel f a b
onHalt h t = h |> OnHalt t

append :: Channel f a b -> Process f b -> Channel f a b
append a b = onHalt a go where
  go Normal = b
  go cause = singleton (Halt cause)

through :: Channel f a b -> Channel f b c -> Channel f a c
through = ><

instance Monad (Process f b) where
  return a = singleton (Emit a)
  (>>=) p f = p |> Bind f

step :: Cause -> a -> Channel f a b -> Process f (Either Cause (b, Channel f a b))
step = ...

machines.scala

// Type-aligned sequence catenable queue supporting O(1) append, snoc, uncons
// Don't need it to be a dequeue (unsnoc not needed)
abstract class TCQueue[c, a, b] // c is the category, a is starting type, b is ending type

type Channel[f, a, b] = TCQueue[({ type l[x, y] = Transition[f, x, y] })#l, a, b]
type Process[f, b] = Channel[f, Unit, b]

sealed abstract class Transition[f, a, b]
case class Bind[f, a, b](get: a => Process[f, b]) extends Transition[f, a, b]
case class OnHalt[f, a, b](get: Cause => Process[f, b]) extends Transition[f, a, b]
case class Emit[f, a, b](get: b) extends Transition[f, a, b]
case class Await[f, a, b](get: f[b]) extends Transition[f, a, Either[Cause, b]]
case class Halt[f, a, b](get: Cause) extends Transition[f, a, b]

sealed abstract trait Cause
case object Normal extends Cause
case class Error(msg: String) extends Cause

def onHalt[f, a, b](h: Channel[f, a, b], t: Cause => Process[f, b]): Channel[f, a, b] = h |> OnHalt t

def append[f, a, b](a: Channel[f, a, b], b: Process[f, b]): Channel[f, a, b] = {
  def go(x: Cause) = x match {
    case Normal => b
    case cause => singleton(Halt(cause))
  }
  onHalt(a, go)
}

through :: Channel f a b -> Channel f b c -> Channel f a c
through = ><

implicit def processInstance[f] = new Monad[({ type l[a] = Process[f, a] })#l] {
  def pure[t](a: t) = singleton(Emit(a))
  def flatMap[t, u](p: Process[f, t], f: t => Process[f, u]) = p |> Bind(f)
}

step :: Cause -> a -> Channel f a b -> Process f (Either Cause (b, Channel f a b))
step = ...