Object.hs

-- | Module:      $Header$
--   Description: Utilities for managing media objects
--   Copyright:   Copyright © 2010-2011 Jon Kristensen
--   License:     BSD-3
--   
--   Maintainer:  info@pontarius.org
--   Stability:   unstable
--   Portability: portable
--   
--   An 'Object' is either an 'Item' or a 'Container'. 'Item's and 'Container's
--   both have 'ObjectAttributes'. 'Additionally, Item's have 'ItemAttributes'.
--   
--   A 'PersistedObject' represents an 'Object' which has been stored in the
--   database (thus having an identifier and perhaps also a parent). This
--   identifier cannot be changed.

-- Parts of this module are not very thoroughly done as we are considering
-- moving to HaskellDB.

-- Example for specific meta-data (log table not tested):
--
-- run c "CREATE TABLE metadata_1 (id INTEGER PRIMARY KEY NOT NULL, object_i" ++
--       "d INTEGER NOT NULL, dummy_value INTEGER, FOREIGN KEY(object_id) RE" ++
--       "FERENCES objects(id))" [] -- x in metadata_x is the types value
-- run c "CREATE TABLE metadata_1_log (id INTEGER PRIMARY KEY NOT NULL, meta" ++
--       "data_id INTEGER NOT NULL, object_id TEXT NOT NULL, dummy_value INT" ++
--       "EGER, FOREIGN KEY(object_id) REFERENCES objects(id), FOREIGN KEY(m" ++
--       "etadata_id) REFERENCES metadata_1(id))" []

module Media.XPMN.PonariusMediaServer.Object ( connectToDatabase
                                             , initializeDatabase
                                             , objectID
                                             , parentID
                                             , object
                                             , container
                                             , item
                                             , persist
                                             , update
                                             , getRoot
                                             , getChildren
                                             , getObject
                                             , insertDummyData -- TODO: Remove
                                             ) where

import Database.HDBC
import Database.HDBC.Sqlite3

import Data.XML.Types


-- An object cannot have its objectID modified.
-- TODO: Add date and time information?

type ObjectID = String -- TODO: Use UUID

data Object = Item { itemObjectAttributes :: ObjectAttributes
                   , itemAttributes :: ItemAttributes } |
              Container ObjectAttributes

data ObjectAttributes = ObjectAttributes { objectType :: Maybe Integer
                                         , objectExtraMetadata :: Maybe Element }

data ItemAttributes = ItemAttributes { objectHash :: Maybe String -- TODO
                                     , objectSize :: Maybe Integer }

data PersistedObject = PO (ObjectID, Maybe ObjectID, Object)


-- | Connects to the local database (the provided string appended by ".db).

connectToDatabase :: String -> IO Connection
connectToDatabase s = connectSqlite3 (s ++ ".db")


disconnectFromDatabase :: IConnection c => c -> IO ()
disconnectFromDatabase l = disconnect l


-- | Creates the necessary tables.

-- TODO: Use withTransaction?

initializeDatabase :: IConnection conn => conn -> IO ()

initializeDatabase c = do
  -- Create the object data and log table
  run c "CREATE TABLE objects (id TEXT PRIMARY KEY NOT NULL, parent_id TEXT, type INTEGER, extra_metadata TEXT, is_container INTEGER NOT NULL, hash TEXT, size INTEGER, CHECK ((is_container = 0 and hash = NULL and size = NULL) or (is_container != 0 and hash != NULL and size != NULL)))" []
  run c "CREATE TABLE objects_log (id INTEGER PRIMARY KEY NOT NULL, object_id TEXT NOT NULL, parent_id TEXT, type INTEGER, extra_metadata TEXT, is_container INTEGER NOT NULL, hash TEXT, size INTEGER, FOREIGN KEY(object_id) REFERENCES objects(id), CHECK ((is_container = 0 and hash = NULL and size = NULL) or (is_container != 0 and hash != NULL and size != NULL)))" []
  
  commit c
  
  return ()


-- | Returns the 'ObjectID' of a 'PersistedObject'.

objectID :: PersistedObject -> ObjectID
objectID (PO (i, _, _)) = i


-- | Returns the potential 'ObjectID' of the parent of a 'PersistedObject'.

parentID :: PersistedObject -> Maybe ObjectID
parentID (PO (_, p, _)) = p


-- | Returns the 'Object' of a 'PersistedObject'.

object :: PersistedObject -> Object
object (PO (_, _, o)) = o


-- | Creates a 'Container' 'Object'.

container :: Maybe Integer -> Maybe Element -> Object
container t m = Container $ ObjectAttributes { objectType = t
                                             , objectExtraMetadata = m }


-- | Creates a 'Item' 'Object'.

item :: Maybe Integer -> Maybe Element -> Maybe String -> Maybe Integer -> Object
item t m h s = Item { itemObjectAttributes = ObjectAttributes { objectType = t
                                                              , objectExtraMetadata = m }
                    , itemAttributes = ItemAttributes { objectHash = h
                                                      , objectSize = s } }


-- | Persists an object (with or without a parent) in the database.

persist :: (IConnection c) => c -> Object -> Maybe ObjectID -> IO PersistedObject

persist c (Item { itemObjectAttributes = oa, itemAttributes = ia }) i =
  do let hash' = case objectHash ia of -- TODO: itemHash in record...
           Just x -> toSql x
           Nothing -> SqlNull
         size' = case objectSize ia of
           Just x -> toSql x
           Nothing -> SqlNull
     run c "INSERT INTO objects (id, parent_id, type, extra_metadata, is_container, hash, size) VALUES (?, ?, ?, ?, ?, ?, ?)" [toSql id, parent_id', type', extra', toSql "0", hash', size']
     run c "INSERT INTO objects_log (object_id, parent_id, type, extra_metadata, is_container, hash, size) VALUES (?, ?, ?, ?, ?, ?, ?)" [toSql id, parent_id', type', extra', toSql "0", hash', size']
     commit c
     return $ PO (id, i, Item { itemObjectAttributes = oa, itemAttributes = ia } )
    where
      id = "fa768fa6-2121-f90a-3902-307297203971"
      parent_id' :: SqlValue
      parent_id' = case i of
        Just x -> toSql (show x)
        Nothing -> SqlNull
      type' :: SqlValue
      type' = case objectType oa of
        Just x -> toSql (show x)
        Nothing -> SqlNull
      extra' :: SqlValue
      extra' = case objectExtraMetadata oa of
        Just x -> toSql (show x)
        Nothing -> SqlNull

persist c (Container oa) i =
  do run c "INSERT INTO objects (id, parent_id, type, extra_metadata, is_container, hash, size) VALUES (?, ?, ?, ?, ?, ?, ?)" [toSql id, parent_id', type', extra', toSql "1", SqlNull, SqlNull]
     run c "INSERT INTO objects_log (object_id, parent_id, type, extra_metadata, is_container, hash, size) VALUES (?, ?, ?, ?, ?, ?, ?)" [toSql id, parent_id', type', extra', toSql "1", SqlNull, SqlNull]
     commit c
     return $ PO (id, i, Container oa)
    where -- TODO: Duplicate
      id = "fa768fa6-2121-f90a-3902-307297203972"
      parent_id' :: SqlValue
      parent_id' = case i of
        Just x -> toSql (show x)
        Nothing -> SqlNull
      type' :: SqlValue
      type' = case objectType oa of
        Just x -> toSql (show x)
        Nothing -> SqlNull
      extra' :: SqlValue
      extra' = case objectExtraMetadata oa of
        Just x -> toSql (show x)
        Nothing -> SqlNull


-- | Update the properties and/or change the parent of a 'PersistedObject'.

update :: ObjectID -> Object -> Maybe ObjectID -> PersistedObject
update i o p = update i o p


-- | Get the elements that are in the root (does not have a parent).

getRoot :: IConnection c => c -> IO [PersistedObject]
getRoot c =
  do result <- quickQuery' c "SELECT * FROM objects WHERE parent = NULL" []
     return $ map resultToObject result


-- | Get the elements with the given parent.

getChildren :: IConnection c => c -> ObjectID -> IO [PersistedObject]
getChildren c o =
  do result <- quickQuery' c ("SELECT * FROM objects WHERE parent = '" ++ o ++
               "'") []
     return $ map resultToObject result


-- | Get the object with the given 'ObjectID'.

getObject :: IConnection c => c -> ObjectID -> IO PersistedObject
getObject c o =
  do result <- quickQuery' c ("SELECT * FROM objects WHERE id = '" ++ o ++ "'")
               []
     return $ resultToObject $ head result


-- Inserts two "empty" objects, one container and one item, in the database.

insertDummyData :: IConnection conn => conn -> IO ()

insertDummyData c =
  do let o0 = container Nothing Nothing
     let o1 = item Nothing Nothing Nothing Nothing
     
     p0 <- persist c o0 Nothing
     p1 <- persist c o1 Nothing
     
     return ()


-- Function to convert a query result to a PersistedObject.

-- resultToObject :: [SqlValue, SqlValue, SqlValue, SqlValue, SqlValue, SqlValue, SqlValue] -> PersistedObject

resultToObject [i, p, t, e, c, h, s]
  | isContainer = persistedObject (Container objectAttributes)
  | otherwise   = persistedObject (Item { itemObjectAttributes = objectAttributes, itemAttributes = ItemAttributes { objectHash = Nothing, objectSize = Nothing } }) -- TODO
    where
      id = let SqlString i' = i in i'
      isContainer = c == SqlString "1"
      objectAttributes = ObjectAttributes { objectType = Nothing
                                          , objectExtraMetadata = Nothing}
      parent = case p of
        SqlNull -> Nothing
        SqlString s -> Just s
      persistedObject o = PO (id, parent, o)