ObjectServer.hs

{-

Copyright © Jon Kristensen, 2010-2011.

This file is part of Pontarius Media Server.

Pontarius Media Server is free software: you can redistribute it and/or modify
it under the terms of the GNU Affero General Public License as published by the
Free Software Foundation, either version 3 of the License, or (at your option)
any later version.

Pontarius Media Server is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
more details.

You should have received a copy of the GNU Affero General Public License along
with Pontarius Media Server. If not, see <http://www.gnu.org/licenses/>.

-}


-- | Module:      $Header$
--   Description: Event-based module for managing media database objects
--   Copyright:   Copyright © 2010-2011 Jon Kristensen
--   License:     AGPL-3
--   
--   Maintainer:  info@pontarius.org
--   Stability:   unstable
--   Portability: portable

module Media.XPMN.Server.ObjectServer (ObjectServerOutEvent (..), ObjectServerInEvent (..), start) where

import Media.XPMN.Server.Object

import Database.HDBC
import Database.HDBC.Sqlite3

import Control.Concurrent (forkIO, threadDelay)
import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)
import Data.Maybe

data State = State { stateConnection :: Connection }

data ObjectServerInEvent = OSIEPersistObject Object |
                           OSIEUpdateObject ObjectID Object |
                           OSIEGetObject ObjectID |
                           OSIEGetRoot |
                           OSIEGetChildren ObjectID deriving (Show)

data ObjectServerOutEvent = OSOEObjectPersisted PersistedObject |
                            OSOEObjectUpdated PersistedObject |
                            OSOEObject (Maybe PersistedObject) |
                            OSOEGetRoot [PersistedObject] |
                            OSOEGetChildren [PersistedObject]  deriving (Show)

start :: String -> IO ((ObjectServerInEvent -> IO ()), IO ObjectServerOutEvent)
start s = do
  c <- newChan
  c_ <- newChan
  connection <- connectToDatabase s
  -- initializeDatabase connection
  forkIO $ eventLoop c c_ (State { stateConnection = connection })
  return (writeChan c, readChan c_)

eventLoop :: Chan ObjectServerInEvent -> Chan ObjectServerOutEvent -> State -> IO ()
eventLoop c c_ s = do
  e <- readChan c
  s' <- processEvent e c_ s
  eventLoop c c_ s

processEvent :: ObjectServerInEvent -> Chan ObjectServerOutEvent -> State -> IO State
processEvent (OSIEPersistObject o) c s = do
  persistedObject <- persist (stateConnection s) o Nothing
  writeChan c $ OSOEObjectPersisted persistedObject
  putStrLn (show $ objectID persistedObject)
  return s
processEvent (OSIEUpdateObject i o) c s = do
  persistedObject <- update (stateConnection s) i Nothing o
  writeChan c $ OSOEObjectUpdated persistedObject
  putStrLn (show $ objectID persistedObject)
  return s
processEvent (OSIEGetObject i) c s = do
  persistedObject <- getObject (stateConnection s) i
  writeChan c $ OSOEObject persistedObject
  putStrLn $ "Got object: " ++ (show $ objectID $ fromJust persistedObject)
  return s
processEvent OSIEGetRoot c s = do
  persistedObjects <- getRoot (stateConnection s)
  writeChan c $ OSOEGetRoot persistedObjects
  putStrLn $ "Got " ++ (show $ length persistedObjects) ++ " objects."
  return s
processEvent (OSIEGetChildren i) c s = do
  persistedObjects <- getChildren (stateConnection s) i
  writeChan c $ OSOEGetChildren persistedObjects
  putStrLn $ "Got " ++ (show $ length persistedObjects) ++ " objects."
  return s

main = do
  (write, read) <- start "Test"
  write $ OSIEPersistObject (container Nothing Nothing)
  write $ OSIEPersistObject (item Nothing Nothing Nothing Nothing)
  write $ OSIEUpdateObject "82c2cae1-b7b4-248e-ede6-9792419a1576" (item Nothing Nothing Nothing Nothing)
  write $ OSIEGetObject "82c2cae1-b7b4-248e-ede6-9792419a1576"
  write $ OSIEGetRoot
  write $ OSIEGetChildren "82c2cae1-b7b4-248e-ede6-9792419a1576"
  return ()