actors in haskell

Actor.hs

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverlappingInstances #-}

import Control.Applicative
import Control.Concurrent
import Control.Concurrent.STM
import Data.Dynamic
import Data.Monoid
import Data.Word
import qualified Data.Foldable as F

data Address = Address
    { proto :: String
    , sys   :: String
    , host  :: String
    , port  :: Int
    } deriving (Eq)

instance Show Address where
    show (Address proto sys host port) =
        proto ++ "://" ++ sys ++ "@" ++ host ++ ":" ++ show port

data ActorSystem = ActorSystem
    { deadletters :: ActorRef
    , terminated  :: STM Bool
    , shutdown    :: STM ()
    }

data ActorPath = ActorPath
    { address :: Address
    , parent  :: ActorPath
    , name    :: String
    , (/)     :: String -> ActorPath
    }

-- TODO
instance Show ActorPath where
    show a = show (parent a) ++ "/" ++ name a

data ActorRef = ActorRef
    { (!)  :: Dynamic -> ActorRef -> STM ()
    , (?)  :: Dynamic -> ActorRef -> STM Dynamic
    , path :: ActorPath
    , uuid :: Word32
    }

instance Show ActorRef where
    show = show . path

instance Eq ActorRef where
    a1 == a2 = uuid a1 == uuid a2

newtype ExecutionContext = ExecutionContext { offer :: IO () -> IO () }

class ActorRefFactory factory where
    actorOf    :: factory -> Props -> String -> STM ActorRef
    dispatcher :: factory -> ExecutionContext

-- TODO
instance ActorRefFactory ActorSystem
instance ActorRefFactory ActorContext

newtype Props = Props Receive

data ActorContext = ActorContext
    { self   :: ActorRef
    , sender :: MVar ActorRef
    , system :: ActorSystem
    , props  :: Props
    }

type PartialFunction a b = a -> Maybe b

type Receive = PartialFunction Dynamic (STM ())

instance Monoid (a -> Maybe b) where
    mempty = const Nothing
    f `mappend` g = \a -> case f a of
        Nothing -> g a
        x -> x

mkProps :: [Receive] -> Props
mkProps = Props . mconcat

foo tvar = mkProps
    [ \dyn -> (modifyTVar tvar . (+)) <$> (fromDynamic dyn :: Maybe Int)
    , \dyn -> (modifyTVar tvar . (+) . length ) <$> (fromDynamic dyn :: Maybe String)
    ]