blob: f50a4d82d10953f6e4fe1b62792cb924dec15194 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
|
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE IncoherentInstances #-}
--------------------------------------------------------------------
-- |
-- Module : Data.MessagePack.Class
-- Copyright : (c) Hideyuki Tanaka, 2009
-- License : BSD3
--
-- Maintainer: tanaka.hideyuki@gmail.com
-- Stability : experimental
-- Portability: portable
--
-- Serializing Haskell values to and from MessagePack Objects.
--
--------------------------------------------------------------------
module Data.MessagePack.Class(
-- * Serialization to and from Object
OBJECT(..),
Result,
pack,
) where
import Control.Monad.Error
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as C8
import Data.Either
import Data.MessagePack.Base
-- | The class of types serializable to and from MessagePack object
class OBJECT a where
toObject :: a -> 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 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 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
-- | Pack a serializable Haskell value.
pack :: OBJECT a => Packer -> a -> IO ()
pack pc = packObject pc . toObject
|
