{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}

--------------------------------------------------------------------
-- |
-- Module    : Data.MessagePack.Object
-- Copyright : (c) Hideyuki Tanaka, 2009-2010
-- License   : BSD3
--
-- Maintainer:  tanaka.hideyuki@gmail.com
-- Stability :  experimental
-- Portability: portable
--
-- MessagePack object definition
--
--------------------------------------------------------------------

module Data.MessagePack.Object(
  -- * MessagePack Object
  Object(..),
  
  -- * Serialization to and from Object
  OBJECT(..),
  Result,
  ) where

import Control.Monad
import Control.Monad.Trans.Error ()
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C8

-- | Object Representation of MessagePack data.
data Object =
  ObjectNil
  | ObjectBool Bool
  | ObjectInteger Int
  | ObjectDouble Double
  | ObjectRAW B.ByteString
  | ObjectArray [Object]
  | ObjectMap [(Object, Object)]
  deriving (Show)

-- | The class of types serializable to and from MessagePack object
class OBJECT a where
  -- | Encode a value to MessagePack object
  toObject :: a -> Object
  -- | Decode a value from MessagePack object
  fromObject :: Object -> Result a

-- | A type for parser results
type Result a = Either String a

instance OBJECT Object where
  toObject = id
  fromObject = Right

fromObjectError :: String
fromObjectError = "fromObject: cannot cast"

instance OBJECT () where
  toObject = const ObjectNil
  fromObject ObjectNil = Right ()
  fromObject _ = Left fromObjectError

instance OBJECT Int where
  toObject = ObjectInteger
  fromObject (ObjectInteger n) = Right n
  fromObject _ = Left fromObjectError

instance OBJECT Bool where
  toObject = ObjectBool
  fromObject (ObjectBool b) = Right b
  fromObject _ = Left fromObjectError

instance OBJECT Double where
  toObject = ObjectDouble
  fromObject (ObjectDouble d) = Right d
  fromObject _ = Left fromObjectError

instance OBJECT B.ByteString where
  toObject = ObjectRAW
  fromObject (ObjectRAW bs) = Right bs
  fromObject _ = Left fromObjectError

instance OBJECT String where
  toObject = toObject . C8.pack
  fromObject obj = liftM C8.unpack $ fromObject obj

instance OBJECT a => OBJECT [a] where
  toObject = ObjectArray . map toObject
  fromObject (ObjectArray arr) =
    mapM fromObject arr
  fromObject _ =
    Left fromObjectError

instance (OBJECT a, OBJECT b) => OBJECT [(a, b)] where
  toObject =
    ObjectMap . map (\(a, b) -> (toObject a, toObject b))
  fromObject (ObjectMap mem) = do
    mapM (\(a, b) -> liftM2 (,) (fromObject a) (fromObject b)) mem
  fromObject _ =
    Left fromObjectError

instance OBJECT a => OBJECT (Maybe a) where
  toObject (Just a) = toObject a
  toObject Nothing = ObjectNil
  
  fromObject ObjectNil = return Nothing
  fromObject obj = liftM Just $ fromObject obj