{-# LANGUAGE ExistentialQuantification #-}
Object model
module Object where
Class is a function which maps an object's internal state (st) to its behavior. The behavior is parametrized using a type constructor intf.
type Cls st intf = st -> intf st
The object is a 2-tuple of an internal state (st) and a class. The concrete state and class can be left abstract in function signatures, so the caller depends only on intf, the interface of the object.
type Obj st intf = (st, Cls st intf)
Accessing objects this way is cumbersome, so we need a few convenience operators. An object's members (including member functions) can be accessed using the following operator:
(##) :: Obj st intf -> (intf st -> a) -> a
(st, cls) ## ifunc = ifunc (cls st)
Referential transparency means we can't modify an object in-place, but we can construct a new object state based on an existing one. The following operator executes such non-destructive update, but requires the updating member function to take only one argument.
(-->) :: Obj st intf -> (intf st -> p -> a) -> p -> (a, Cls st intf)
obj@(st, cls) --> ifunc = \p -> (obj ## ifunc $ p, cls)
Example
We use restaurant employees as an example. This is the interface for an employee:
data Employee st = Employee { setName :: String -> st
This member function updates the employee's name (non-destructively).
, welcome :: String -> String }
This member function returns a welcome phrase appropriate for the employee. It takes the customer's name as an argument.
waiter :: Cls String Employee
waiter st = Employee { setName = id
, welcome = \x -> "Hello " ++ x ++ " I'm " ++ st}
makeWaiter :: Obj String Employee
makeWaiter = ("", waiter)
Waiter has a single string as its state. The string contains the waiter's name. The waiter is polite to the customer.
cook :: Cls () Employee
cook st = Employee { setName = const ()
, welcome = const "Get out of my kitchen!"}
makeCook :: Obj () Employee
makeCook = ((), cook)
The cook doesn't remember its name, so it has no state. He also isn't very polite.
visit :: Obj a Employee -> String -> String
visit emp name = let emp' = emp --> setName $ "Jon"
in emp' ## welcome $ name
When you define functions that operate on Objs, make them polymorphic on the first type variable (st). That way, they work on all objects that implement the given interface.
data EmployeeBox = forall a. EmployeeBox (Obj a Employee)
data Restaurant st = Restaurant { setEmployees :: [EmployeeBox] -> st
, vipWelcome :: String -> [String] }
Objects can also contain other objects, as long as they are boxed. You need -XExistentialQuantification for that.
tinyRestaurant :: Cls EmployeeBox Restaurant
tinyRestaurant (EmployeeBox emp) = Restaurant
{ setEmployees = head
, vipWelcome = (:[]) . (emp ## welcome) }
makeTinyRestaurant :: Obj EmployeeBox Restaurant
makeTinyRestaurant = (EmployeeBox undefined, tinyRestaurant)
The main program tests our example objects.
main :: IO ()
main = let w = makeWaiter
c = makeCook
c' = c --> setName $ "Andrew"
r = makeTinyRestaurant
r' = r --> setEmployees $ [EmployeeBox c']
in do putStrLn $ visit w "J. Random Hacker"
putStrLn $ visit c "Mr. Mystery"
putStrLn $ show $ (r' ## vipWelcome) "Gillian"