-
Notifications
You must be signed in to change notification settings - Fork 19
/
JSON.hs
103 lines (86 loc) · 3.14 KB
/
JSON.hs
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
98
99
100
101
102
103
{-# LANGUAGE OverloadedStrings, FlexibleInstances, CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module JSON (
Test(..)
, Case(..)
, HeaderList
) where
#if __GLASGOW_HASKELL__ < 709
import Control.Applicative
#endif
import Control.Monad (mzero)
import Data.Aeson
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as B8
import qualified Data.Aeson.KeyMap as H
import qualified Data.Aeson.Key as Key
import Data.Text (Text)
import qualified Data.Text as T
import Data.Vector ((!))
import qualified Data.Vector as V
import Network.HPACK
{-
import Data.Aeson.Encode.Pretty (encodePretty)
import qualified Data.ByteString.Lazy as BL
main :: IO ()
main = do
bs <- BL.getContents
let Right x = eitherDecode bs :: Either String Test
BL.putStr $ encodePretty x
-}
data Test = Test {
description :: String
, cases :: [Case]
} deriving Show
data Case = Case {
size :: Maybe Int
, wire :: ByteString
, headers :: HeaderList
, seqno :: Maybe Int
} deriving Show
instance FromJSON Test where
parseJSON (Object o) = Test <$> o .: "description"
<*> o .: "cases"
parseJSON _ = mzero
instance ToJSON Test where
toJSON (Test desc cs) = object ["description" .= desc
,"cases" .= cs
]
instance FromJSON Case where
parseJSON (Object o) = Case <$> o .:? "header_table_size"
<*> (textToByteString <$> (o .: "wire"))
<*> o .: "headers"
<*> o .:? "seqno"
parseJSON _ = mzero
instance ToJSON Case where
toJSON (Case (Just siz) w hs no) = object ["header_table_size" .= siz
,"wire" .= byteStringToText w
,"headers" .= hs
,"seqno" .= no
]
toJSON (Case Nothing w hs no) = object ["wire" .= byteStringToText w
,"headers" .= hs
,"seqno" .= no
]
instance {-# OVERLAPPING #-} FromJSON HeaderList where
parseJSON (Array a) = mapM parseJSON $ V.toList a
parseJSON _ = mzero
instance {-# OVERLAPPING #-} ToJSON HeaderList where
toJSON hs = toJSON $ map toJSON hs
instance {-# OVERLAPPING #-} FromJSON Header where
parseJSON (Array a) = pure (toKey (a ! 0), toValue (a ! 1)) -- old
where
toKey = toValue
parseJSON (Object o) = pure (textToByteString (Key.toText k), toValue v) -- new
where
(k,v) = head $ H.toList o
parseJSON _ = mzero
instance {-# OVERLAPPING #-} ToJSON Header where
toJSON (k,v) = object [ Key.fromText (byteStringToText k) .= byteStringToText v ]
textToByteString :: Text -> ByteString
textToByteString = B8.pack . T.unpack
byteStringToText :: ByteString -> Text
byteStringToText = T.pack . B8.unpack
toValue :: Value -> ByteString
toValue (String s) = textToByteString s
toValue _ = error "toValue"