Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 115 lines (88 sloc) 3.427 kb
cabae3c @lpsmith Proof-of-concept for json-builder
authored
1 -----------------------------------------------------------------------------
2 -- |
3 -- Module : Json
4 -- Copyright : (c) 2011 Leon P Smith
5 -- License : BSD3
6 --
7 -- Maintainer : Leon P Smith <leon@melding-monads.com>
8 --
9 -- Data structure agnostic JSON serialization
10 --
11 -----------------------------------------------------------------------------
12
13 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
14 {-# LANGUAGE OverloadedStrings #-}
15
16 module Json
17 ( Value(..)
18 , Object
19 , row
20 , Array
21 , element
22 ) where
23
24 import Blaze.ByteString.Builder as Blaze
25 import Data.Monoid
26 import Blaze.ByteString.Builder.ByteString
27 import Blaze.ByteString.Builder.Char8
28 import qualified Data.ByteString as BS
29 import qualified Data.ByteString.Lazy as BL
30 import Data.ByteString.Char8()
31
32 ---- The "core" of json-builder
33
34 class Value a where
35 toBuilder :: a -> Blaze.Builder
36 toByteString :: a -> BS.ByteString
37 toLazyByteString :: a -> BL.ByteString
38 toByteString = Blaze.toByteString . toBuilder
39 toLazyByteString = Blaze.toLazyByteString . toBuilder
40
41 data Pair = Pair !Blaze.Builder !Bool
42
43 newtype Object = Object (Bool -> Pair)
44
45 instance Value Object where
46 toBuilder (Object f) = case f True of
47 Pair fb _ -> mconcat [fromChar '{', fb, fromChar '}']
48
49 instance Monoid Object where
50 mempty = Object $ \x -> Pair mempty x
51 mappend (Object f) (Object g)
52 = Object $ \x -> case f x of
53 Pair fb x' -> case g x' of
54 Pair gb x'' -> Pair (fb `mappend` gb) x''
55
56 row :: Value a => BS.ByteString -> a -> Object
57 row str a = Object $ comma (mconcat [ toBuilder str, fromChar ':', toBuilder a ])
58 where
59 comma b True = Pair b False
60 comma b False = Pair (fromChar ',' `mappend` b) False
61
62
63 newtype Array = Array (Bool -> Pair)
64
65 instance Value Array where
66 toBuilder (Array f) = case f True of
67 Pair fb _ -> mconcat [fromChar '[', fb, fromChar ']']
68
69 instance Monoid Array where
70 mempty = Array $ \x -> Pair mempty x
71 mappend (Array f) (Array g)
72 = Array $ \x -> case f x of
73 Pair fb x' -> case g x' of
74 Pair gb x'' -> Pair (fb `mappend` gb) x''
75
76 element :: Value a => a -> Array
77 element a = Array $ comma (toBuilder a)
78 where
79 comma b True = Pair b False
80 comma b False = Pair (fromChar ',' `mappend` b) False
81
82
83 -- Primitive instances for json-builder
84
85 instance Value () where
86 toBuilder _ = fromByteString "null"
87
88 instance Value Integer where
89 -- FIXME: Do we emit the correct syntax?
90 -- FIXME: Can this be more efficient?
91 toBuilder x = fromString (show x)
92
93 instance Value Double where
94 -- FIXME: Do we emit the correct syntax?
95 -- FIXME: Can this be more efficient?
96 toBuilder x = fromString (show x)
97
98 instance Value Bool where
99 toBuilder True = fromByteString "true"
100 toBuilder False = fromByteString "false"
101
102 instance Value BS.ByteString where
103 -- FIXME! Quote chars as needed
104 toBuilder x = fromWrite (mconcat [writeChar '"', writeByteString x, writeChar '"'])
105
106
107 -- Convenient (?) instances for json-builder
108
109 instance Value a => Value (Maybe a) where
110 toBuilder Nothing = fromByteString "null"
111 toBuilder (Just a) = toBuilder a
112
113 instance Value a => Value [a] where
114 toBuilder = toBuilder . mconcat . map element
Something went wrong with that request. Please try again.