Created
November 26, 2013 13:08
-
-
Save crdueck/abcaeed12fb3643c52ab to your computer and use it in GitHub Desktop.
actors in haskell
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# 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) | |
] | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment