@@ -0,0 +1,107 @@
1+--create a bunch of orphan instances for use with the websocket server
2+{-# LANGUAGE OverloadedStrings #-}
3+{-# OPTIONS_GHC -fno-warn-orphans #-}
4+module ProjectM36.Server.RemoteCallTypes.Json where
5+import ProjectM36.Server.RemoteCallTypes
6+import ProjectM36.Base
7+import ProjectM36.ConcreteTypeRep
8+import Data.Aeson
9+import Data.UUID.Aeson ()
10+import Data.Proxy
11+import Data.Typeable
12+import Data.Text
13+import Data.Time.Calendar
14+import ProjectM36.Atom
15+import Data.ByteString
16+
17+instance ToJSON RelationalExpr
18+instance FromJSON RelationalExpr
19+
20+instance ToJSON TupleExpr
21+instance FromJSON TupleExpr
22+
23+instance ToJSON RestrictionPredicateExpr
24+instance FromJSON RestrictionPredicateExpr
25+
26+instance ToJSON AtomExpr
27+instance FromJSON AtomExpr
28+
29+instance ToJSON RelationTupleSet
30+instance FromJSON RelationTupleSet
31+
32+instance ToJSON RelationTuple
33+instance FromJSON RelationTuple
34+
35+instance ToJSON ExecuteRelationalExpr
36+instance FromJSON ExecuteRelationalExpr
37+
38+instance ToJSON Relation
39+instance FromJSON Relation
40+
41+instance ToJSON Attribute
42+instance FromJSON Attribute
43+
44+instance ToJSON ExtendTupleExpr
45+instance FromJSON ExtendTupleExpr
46+
47+instance ToJSON AttributeNames
48+instance FromJSON AttributeNames
49+
50+instance ToJSON AttributeExpr
51+instance FromJSON AttributeExpr
52+
53+instance ToJSON AtomType
54+instance FromJSON AtomType
55+
56+instance ToJSON TypeConstructor
57+instance FromJSON TypeConstructor
58+
59+instance ToJSON TypeConstructorArg
60+instance FromJSON TypeConstructorArg
61+
62+instance ToJSON SerialRep
63+instance FromJSON SerialRep
64+
65+instance FromJSON ConcreteTypeRep where
66+ parseJSON = withObject "ctr" $ \o -> do
67+ serialRep <- o .: "serialrep"
68+ pure $ fromSerial serialRep
69+
70+instance ToJSON ConcreteTypeRep where
71+ toJSON ctr = object [
72+ "serialrep" .= toSerial ctr
73+ ]
74+
75+instance ToJSON Atom where
76+ toJSON atom@(Atom val) = object [
77+ "type" .= toJSON (atomTypeForAtom atom),
78+ "val" .= toText val]
79+ toJSON (ConstructedAtom dConsName atomtype atomlist) = object [
80+ "dataconstructorname" .= dConsName,
81+ "atomtype" .= toJSON atomtype,
82+ "atomlist" .= toJSON atomlist
83+ ]
84+
85+instance FromJSON Atom where
86+ parseJSON = withObject "atom" $ \o -> do
87+ atype <- o .: "type"
88+ case atype of
89+ AnyAtomType -> fail "cannot pass AnyAtomType over the wire"
90+ caType@(ConstructedAtomType _ _) -> ConstructedAtom <$> o .: "dataconstructorname" <*> pure caType <*> o .: "atom"
91+ RelationAtomType _ -> undefined
92+ AtomType cTypeRep -> if unCTR cTypeRep == typeRep (Proxy :: Proxy Int) then
93+ intAtom <$> o .: "val"
94+ else if unCTR cTypeRep == typeRep (Proxy :: Proxy Text) then
95+ textAtom <$> o .: "val"
96+ else if unCTR cTypeRep == typeRep (Proxy :: Proxy Double) then
97+ textAtom <$> o .: "val"
98+ else if unCTR cTypeRep == typeRep (Proxy :: Proxy Day) then
99+ undefined
100+ else if unCTR cTypeRep == typeRep (Proxy :: Proxy ByteString) then
101+ undefined
102+ else if unCTR cTypeRep == typeRep (Proxy :: Proxy Bool) then
103+ undefined
104+ else
105+ error "unsupported typerep serialization"
106+
107+