greskell-core-0.1.2.0: test/Data/Greskell/GraphSONSpec.hs
{-# LANGUAGE OverloadedStrings, NoMonomorphismRestriction #-}
module Data.Greskell.GraphSONSpec (main,spec) where
import Data.Aeson (object, (.=), ToJSON(..), FromJSON(..), Value(..))
import qualified Data.Aeson as Aeson
import Data.Aeson.Types (parseEither, Value(..), Parser)
import qualified Data.ByteString.Lazy as BSL
import Data.Either (isLeft)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM
import Data.List (isInfixOf)
import Data.Int (Int32)
import Data.Monoid ((<>))
import Data.Text (Text)
import qualified Data.Vector as V
import Test.Hspec
import Data.Greskell.GMap (GMapEntry(..), unGMapEntry)
import Data.Greskell.GraphSON
( GraphSON, parseTypedGraphSON,
-- parseTypedGraphSON',
typedGraphSON', nonTypedGraphSON,
nonTypedGValue, typedGValue',
GValue, GValueBody(..),
FromGraphSON(..)
)
import Data.Greskell.GraphSON.GValue (unwrapAll, unwrapOne)
main :: IO ()
main = hspec spec
spec :: Spec
spec = do
describe "GrpahSON" $ do
fromJSON_spec
parseTypedGraphSON_spec
-- parseTypedGraphSON'_spec
describe "GValue" $ do
gvalue_spec
fromGraphSON_spec
fromJSON_spec :: Spec
fromJSON_spec = describe "FromJSON (recursive)" $ do
let parse :: Value -> Either String (GraphSON Value)
parse = parseEither parseJSON
isLeftG :: Either String (GraphSON Value) -> Bool
isLeftG = isLeft
specify "bare map (one entry)" $ do
let input = object ["foo" .= String "bar"]
parse input `shouldBe` Right (nonTypedGraphSON input)
specify "bare map (two entries)" $ do
let input = object ["foo" .= String "bar", "quux" .= String "hoge"]
parse input `shouldBe` Right (nonTypedGraphSON input)
specify "wrapped string" $ do
let input = object ["@type" .= String "g:String", "@value" .= String "hogehoge"]
parse input `shouldBe` Right (typedGraphSON' "g:String" $ String "hogehoge")
specify "wrapped object" $ do
let body = object ["foo" .= String "bar"]
input = object ["@type" .= String "g:Map", "@value" .= body]
parse input `shouldBe` Right (typedGraphSON' "g:Map" body)
specify "wrong @type type" $ do
let body = object ["foo" .= String "bar"]
input = object ["@type" .= Number 10, "@value" .= body]
parse input `shouldSatisfy` isLeftG
specify "null @type" $ do
let body = object ["foo" .= String "bar"]
input = object ["@type" .= Null, "@value" .= body]
parse input `shouldSatisfy` isLeftG
specify "no @value field" $ do
let input = object ["@type" .= String "g:String", "foo" .= Null]
parse input `shouldBe` Right (nonTypedGraphSON input)
specify "confusing bare map (three entries)" $ do
let input = object [ "@type" .= String "g:String",
"@value" .= String "hoge",
"@other" .= String "foo"
]
parse input `shouldBe` Right (nonTypedGraphSON input)
parseTypedGraphSON_spec :: Spec
parseTypedGraphSON_spec = describe "parseTypedGraphSON" $ do
let parse = parseEither parseTypedGraphSON
describe "Int32" $ do
specify "invalid bare value" $ do
let (Left got) = parse (String "foo") :: Either String (GraphSON Int32)
got `shouldSatisfy` (isInfixOf "Not a valid typed JSON")
specify "valid bare value" $ do
let (Left got) = parse (Number 255) :: Either String (GraphSON Int32)
got `shouldSatisfy` (isInfixOf "Not a valid typed JSON")
specify "typed JSON with invalid @type field" $ do
let (Left got) = parse (object ["@type" .= String "g:Int64", "@value" .= Number 255]) :: Either String (GraphSON Int32)
got `shouldSatisfy` (isInfixOf "Expected @type")
specify "typed JSON with valid @type field and invalid @value" $ do
let (Left got) = parse (object ["@type" .= String "g:Int32", "@value" .= String "hoge"]) :: Either String (GraphSON Int32)
got `shouldSatisfy` (isInfixOf "expected Int32")
specify "typed JSON with valid @type and @value" $ do
let got = parse (object ["@type" .= String "g:Int32", "@value" .= Number 255]) :: Either String (GraphSON Int32)
got `shouldBe` (Right $ typedGraphSON' "g:Int32" 255)
describe "HashMap" $ do
specify "invalid bare value" $ do
let (Left got) = parse (String "quux") :: Either String (GraphSON (HashMap String String))
got `shouldSatisfy` (isInfixOf "Not a valid typed JSON")
specify "valid bare value" $ do
let (Left got) = parse (object ["hoge" .= String "HOGE", "foo" .= String "FOO"]) :: Either String (GraphSON (HashMap String String))
got `shouldSatisfy` (isInfixOf "Not a valid typed JSON")
specify "typed JSON with invalid @type field" $ do
let (Left got) = parse (object [ "@type" .= String "g:Array",
"@value" .= object ["hoge" .= String "HOGE", "foo" .= String "FOO"]
]) :: Either String (GraphSON (HashMap String String))
got `shouldSatisfy` (isInfixOf "Expected @type")
specify "typed JSON with valid @type field and invalid @value field" $ do
let (Left got) = parse (object [ "@type" .= String "g:Array",
"@value" .= Number 100
]) :: Either String (GraphSON (HashMap String String))
got `shouldSatisfy` (isInfixOf "expected HashMap")
specify "typed JSON with valid @type and @value" $ do
let got = parse (object [ "@type" .= String "g:Map",
"@value" .= object ["hoge" .= String "HOGE", "foo" .= String "FOO"]
]) :: Either String (GraphSON (HashMap String String))
got `shouldBe` (Right $ typedGraphSON' "g:Map" $ HM.fromList [("hoge", "HOGE"), ("foo", "FOO")])
-- parseTypedGraphSON'_spec :: Spec
-- parseTypedGraphSON'_spec = describe "parseTypedGraphSON'" $ do
-- let parse = parseEither parseTypedGraphSON'
-- describe "Int32" $ do
-- specify "invalid bare value" $ do
-- let (Right (Left got)) = parse (String "foo") :: Either String (Either String (GraphSON Int32))
-- got `shouldSatisfy` (isInfixOf "Not a valid typed JSON")
-- specify "valid bare value" $ do
-- let (Right (Left got)) = parse (Number 255) :: Either String (Either String (GraphSON Int32))
-- got `shouldSatisfy` (isInfixOf "Not a valid typed JSON")
-- specify "typed JSON with invalid @type field" $ do
-- let (Left got) = parse (object ["@type" .= String "g:Int64", "@value" .= Number 255]) :: Either String (Either String (GraphSON Int32))
-- got `shouldSatisfy` (isInfixOf "Expected @type")
-- specify "typed JSON with valid @type field and invalid @value" $ do
-- let (Left got) = parse (object ["@type" .= String "g:Int32", "@value" .= String "hoge"]) :: Either String (Either String (GraphSON Int32))
-- got `shouldSatisfy` (isInfixOf "expected Int32")
-- specify "typed JSON with valid @type and @value" $ do
-- let got = parse (object ["@type" .= String "g:Int32", "@value" .= Number 255]) :: Either String (Either String (GraphSON Int32))
-- got `shouldBe` (Right $ Right $ typedGraphSON' "g:Int32" 255)
-- describe "HashMap" $ do
-- specify "invalid bare value" $ do
-- let (Right (Left got)) = parse (String "quux") :: Either String (Either String (GraphSON (HashMap String String)))
-- got `shouldSatisfy` (isInfixOf "Not a valid typed JSON")
-- specify "valid bare value" $ do
-- let (Right (Left got)) = parse (object ["hoge" .= String "HOGE", "foo" .= String "FOO"])
-- :: Either String (Either String (GraphSON (HashMap String String)))
-- got `shouldSatisfy` (isInfixOf "Not a valid typed JSON")
-- specify "typed JSON with invalid @type field" $ do
-- let (Left got) = parse (object [ "@type" .= String "g:Array",
-- "@value" .= object ["hoge" .= String "HOGE", "foo" .= String "FOO"]
-- ]) :: Either String (Either String (GraphSON (HashMap String String)))
-- got `shouldSatisfy` (isInfixOf "Expected @type")
-- specify "typed JSON with valid @type field and invalid @value field" $ do
-- let (Left got) = parse (object [ "@type" .= String "g:Array",
-- "@value" .= Number 100
-- ]) :: Either String (Either String (GraphSON (HashMap String String)))
-- got `shouldSatisfy` (isInfixOf "expected HashMap")
-- specify "typed JSON with valid @type and @value" $ do
-- let got = parse (object [ "@type" .= String "g:Map",
-- "@value" .= object ["hoge" .= String "HOGE", "foo" .= String "FOO"]
-- ]) :: Either String (Either String (GraphSON (HashMap String String)))
-- got `shouldBe` (Right $ Right $ typedGraphSON' "g:Map" $ HM.fromList [("hoge", "HOGE"), ("foo", "FOO")])
gvalue_spec :: Spec
gvalue_spec = do
describe "FromJSON and ToJSON" $ do
fromToJSON "bare null" "null" (bare GNull)
fromToJSON "wrapped null" (gson "g:Int" "null") (wrapped "g:Int" GNull)
fromToJSON "bare number" "100" (bare $ GNumber 100)
fromToJSON "wrapped number" (gson "g:Int" "100") (wrapped "g:Int" $ GNumber 100)
fromToJSON "bare bool" "true" (bare $ GBool True)
fromToJSON "wrapped bool" (gson "g:Boolean" "true") (wrapped "g:Boolean" $ GBool True)
fromToJSON "bare str" "\"hoge\"" (bare $ GString "hoge")
fromToJSON "wrapped str" (gson "g:String" "\"hoge\"") (wrapped "g:String" $ GString "hoge")
fromToJSON "bare array" "[null, \"foo\", 100]"
(bare $ GArray $ fmap bare $ V.fromList [GNull, GString "foo", GNumber 100])
fromToJSON "wrapped array" (gson "g:List" "[null, \"foo\", 100]")
(wrapped "g:List" $ GArray $ fmap bare $ V.fromList [GNull, GString "foo", GNumber 100])
fromToJSON "bare object" "{\"foo\": \"bar\", \"hoge\": 99, \"quux\": null}"
(bare $ GObject $ fmap bare $ HM.fromList [("foo", GString "bar"), ("hoge", GNumber 99), ("quux", GNull)])
fromToJSON "wrapped object" (gson "g:Map" "{\"foo\": \"bar\", \"hoge\": 99, \"quux\": null}")
(wrapped "g:Map" $ GObject $ fmap bare $ HM.fromList [("foo", GString "bar"), ("hoge", GNumber 99), ("quux", GNull)])
nested_spec
double_wrap_spec
decode_error_spec
unwrap_spec
nestedSample :: BSL.ByteString
nestedSample = gson "g:List" ("[100, " <> elem_a <> ", " <> elem_b <> "]")
where
elem_a = gson "g:Map" ("{\"foo\": 100, \"bar\":" <> (gson "g:Int" "200") <> "}")
elem_b = gson "g:List" ("[null, " <> (gson "g:Object" "null") <> ", " <> elem_c <> ", " <> (gson "g:Boolean" "false") <> "]")
elem_c = "{\"xxx\": " <> (gson "g:Int" "200") <> ", \"yyy\": true}"
nested_spec :: Spec
nested_spec = fromToJSON "mixed nested" nestedSample expected
where
expected = wrapped "g:List" $ GArray $ V.fromList [ bare $ GNumber 100, exp_a, exp_b ]
exp_a = wrapped "g:Map" $ GObject $ HM.fromList
[ ("foo", bare $ GNumber 100),
("bar", wrapped "g:Int" $ GNumber 200)
]
exp_b = wrapped "g:List" $ GArray $ V.fromList
[ bare GNull,
wrapped "g:Object" GNull,
exp_c,
wrapped "g:Boolean" $ GBool False
]
exp_c = bare $ GObject $ HM.fromList
[ ("xxx", wrapped "g:Int" $ GNumber 200),
("yyy", bare $ GBool True)
]
-- Basically this case should not appear in GraphSON encoding, but
-- GValue can parse it. However, the parsed GValue has a GObject with
-- "@type" and "@value" keys explicitly.
double_wrap_spec :: Spec
double_wrap_spec = fromToJSON "double wrapped" input expected
where
input = gson "g:Object" $ gson "g:Int" "100"
expected = wrapped "g:Object" $ GObject $ HM.fromList
[ ("@type", bare $ GString "g:Int"),
("@value", bare $ GNumber 100)
]
decode_error_spec :: Spec
decode_error_spec = do
specify "wrong @type type" $ do
let got :: Either String GValue
got = Aeson.eitherDecode "{\"@type\": 200, \"@value\": 100}"
got `shouldSatisfy` isLeft
fromLeft' got `shouldSatisfy` (isInfixOf "@type")
specify "null @type" $ do
let got :: Either String GValue
got = Aeson.eitherDecode "{\"@type\": null, \"@value\": 100}"
got `shouldSatisfy` isLeft
fromLeft' got `shouldSatisfy` (isInfixOf "@type")
forceDecode :: FromJSON a => BSL.ByteString -> a
forceDecode json = case Aeson.eitherDecode json of
Left err -> error ("Unexpected decode failure: " <> err)
Right a -> a
fromToJSON :: String -> BSL.ByteString -> GValue -> Spec
fromToJSON label input_json expected = specify label $ do
decoded `shouldBe` expected
encoded `shouldBe` exp_enc
where
decoded :: GValue
decoded = forceDecode input_json
encoded = Aeson.toJSON decoded
exp_enc = forceDecode input_json
bare :: GValueBody -> GValue
bare = nonTypedGValue
wrapped :: Text -> GValueBody -> GValue
wrapped = typedGValue'
gson :: BSL.ByteString -> BSL.ByteString -> BSL.ByteString
gson ftype fvalue = "{\"@type\":\"" <> ftype <> "\",\"@value\":" <> fvalue <> "}"
fromLeft' :: (Show a, Show b) => Either a b -> a
fromLeft' (Left a) = a
fromLeft' e = error ("Expecting Left, but got " ++ show e)
unwrap_spec :: Spec
unwrap_spec = do
specify "unwrapAll" $ do
let expected = Array $ V.fromList [Number 100, exp_a, exp_b]
exp_a = object ["foo" .= Number 100, "bar" .= Number 200]
exp_b = Array $ V.fromList [Null, Null, exp_c, Bool False]
exp_c = object ["xxx" .= Number 200, "yyy" .= Bool True]
(unwrapAll $ forceDecode nestedSample) `shouldBe` expected
specify "unwrapOne" $ do
let expected = Array $ V.fromList [Number 100, exp_a, exp_b]
exp_a = object [ "@type" .= String "g:Map",
"@value" .= object ["foo" .= Number 100,
"bar" .= object [ "@type" .= String "g:Int",
"@value" .= Number 200
]
]
]
exp_b = object
[ "@type" .= String "g:List",
"@value" .= ( Array $ V.fromList [ Null,
object ["@type" .= String "g:Object", "@value" .= Null],
exp_c,
object ["@type" .= String "g:Boolean", "@value" .= Bool False]
]
)
]
exp_c = object [ "xxx" .= object ["@type" .= String "g:Int", "@value" .= Number 200],
"yyy" .= Bool True
]
(unwrapOne $ forceDecode nestedSample) `shouldBe` expected
decodeG :: FromGraphSON a => BSL.ByteString -> Either String a
decodeG = parseEither parseGraphSON . forceDecode
fromGraphSON_spec :: Spec
fromGraphSON_spec = describe "FromGraphSON" $ do
let gint n = gson "g:Int" n
specify "bare Int" $ do
let got :: Either String Int
got = decodeG "199"
got `shouldBe` Right 199
specify "wrapped Int" $ do
let got :: Either String Int
got = decodeG (gson "g:Int" "256")
got `shouldBe` Right 256
specify "bare list" $ do
let got :: Either String [Int]
got = decodeG "[1, 2, 3]"
got `shouldBe` Right [1, 2, 3]
specify "wrapped list" $ do
let got :: Either String [Int]
got = decodeG (gson "g:List" ("[" <> BSL.intercalate "," (map gint ["1","2","3"]) <> "]"))
got `shouldBe` Right [1, 2, 3]
specify "bare map" $ do
let got :: Either String (HashMap Text Int)
got = decodeG "{\"foo\": 100, \"bar\": 200}"
got `shouldBe` Right (HM.fromList [("foo", 100), ("bar", 200)])
specify "wrapped flattened map" $ do
let got :: Either String (HashMap Text Int)
got = decodeG (gson "g:Map" ("[\"foo\", " <> gint "100" <> ", \"bar\", " <> gint "200" <> "]"))
got `shouldBe` Right (HM.fromList [("foo", 100), ("bar", 200)])
specify "wrapped flattend map (both keys and values are wrapped)" $ do
let got :: Either String (HashMap Int Int)
got = decodeG (gson "g:Map" ("[" <> BSL.intercalate "," (map gint ["1","10","2","20"]) <> "]"))
got `shouldBe` Right (HM.fromList [(1, 10), (2, 20)])
specify "bare GMapEntry" $ do
let got :: Either String (GMapEntry Int Text)
got = decodeG "{\"123\": \"hoge\"}"
got `shouldBe` Right (GMapEntry False 123 "hoge")
specify "wrapped GMapEntry" $ do
let got :: Either String (GMapEntry Int Text)
got = decodeG (gson "g:Map" ("[" <> gint "123" <> ", \"hoge\"]"))
got `shouldBe` Right (GMapEntry True 123 "hoge")
specify "bare key-value object for GMapEntry" $ do
let got :: Either String (GMapEntry Int Text)
got = decodeG "{\"key\": 123, \"value\": \"hoge\"}"
got `shouldBe` Right (GMapEntry False 123 "hoge")
specify "bare Maybe" $ do
let got :: Either String (Maybe Int)
got = decodeG "null"
got `shouldBe` Right Nothing
specify "wrapped Maybe" $ do
let got :: Either String (Maybe Int)
got = decodeG (gson "g:Int" "null")
got `shouldBe` Right Nothing
specify "bare nested" $ do
let got :: Either String (HashMap Int [Int])
got = decodeG "{\"99\": [], \"33\": [1, 2, 3]}"
got `shouldBe` Right (HM.fromList [(99, []), (33, [1,2,3])])
specify "wrapped nested" $ do
let got :: Either String (HashMap [Int] [Int])
got = decodeG input
input = gson "g:Map" $ "[" <> key_a <> "," <> val_a <> ", " <> key_b <> ", " <> val_b <> "]"
key_a = gson "g:List" $ "[" <> gint "1" <> "," <> gint "2" <> "]"
val_a = gson "g:List" $ "[]"
key_b = gson "g:List" $ "[" <> gint "3" <> "," <> gint "4" <> ", " <> gint "5" <> "]"
val_b = gson "g:List" $ "[" <> gint "6" <> "]"
got `shouldBe` Right (HM.fromList [ ([1,2], []), ([3,4,5], [6])])