import IO
import Port
import Maybe
import FiniteMap

import Interface

type DB = FiniteMap String String

data TMesg = Timeout deriving (Read,Show)

main = do
    serverport <- newPort
    registerPort serverport "DBServer"
    loop serverport emptyFM 
  where
    loop :: ServerPort -> DB -> IO ()
    loop serverport db = do
        putStrLn "loop: Waiting for request..."
        message <- readPort serverport
	newdb <- processMessage message db
	loop serverport newdb

processMessage :: DBMessages -> DB -> IO (DB)
processMessage message db = do
    putStrLn ("processMessage: Received "++ (show message))
    case message of
      (Alloc key checkport) -> do
	  let test = lookupFM db key
	  if (isNothing test)
	    then do
              allocPort <- newPort
	      checkport <!> Free allocPort 
              timePort  <- newPort
	      th <- forkIO (threadDelay (1000*1000*15) >> timePort <!> Timeout)
	      p <- allocPort <|> timePort
	      -- str <- readPort allocPort
	      str <- readPort p
	      print str
              case str of
	        Left value -> print "ja" >> killThread th >> return (addToFM db key value)
	        Right _    -> print "fiep!" >> return db
	    else do
	      checkport <!> Allocated
	      putStrLn ("processMessage: Not updated DB")
	      return db 
      (Lookup key answerport) -> do
          writePort answerport (lookupFM db key)
	  putStrLn ("processMessage: Lookup done")
	  return db