\begin{code}
 
module Main (main) where 
 
import Distributed
import Maybe
import Monad

data Msg = Alloc String Pid | Value String Pid | Lookup String Pid |
	   Allocated | Free | IsValue (Maybe String) | Connect Pid | Shutdown
  deriving (Show, Read)
instance Serialize Msg

main :: IO ()
main = do
  timeFix <- myGetVar "DHS_TIMEFIX"
  when (isNothing timeFix)
    (putStrLn "*** receiveAfter disabled, set DHS_TIMEFIX to enable!")
  let recv = if (isNothing timeFix)
                then ( \_ _ -> receive)
		else receiveAfter
  Distributed.start (do
    register "dataBase"
    dataBase recv []) "DB-Server"

dataBase :: (Int -> DIO Msg () -> (Msg -> DIO Msg ()) -> DIO Msg ()) -> [(String,String)] -> DIO Msg ()
dataBase recv l = receive (\v -> case v of
  Shutdown -> do
    proc $ putStrLn "Bye."
    halt
  Alloc key pid -> 
     case lookup key l of
       Nothing -> do
 	  pid <!> Free
 	  recv 15 (dataBase recv l) (\v' -> case v' of
 	   Value v pid' | pid'==pid -> do
 	     proc $ putStrLn ("New entry : "++key)
             dataBase recv ((key,v):l))
       Just _ -> do
         pid <!> Allocated
         dataBase recv l
  Lookup key pid -> do
    proc $ putStrLn ("Lookup : "++key)
    pid <!> (IsValue (lookup key l))
    dataBase recv l
  Connect pid -> do
    me <- self
    pid <!> (Connect me)
    dataBase recv l
  Value _ p -> do
    proc $ putStrLn ("Dangling Value from " ++ (show p))
    dataBase recv l
 )
\end{code}