From 88a9ce01d153ad609aa02084de0a93448c29cba4 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Tue, 18 Apr 2017 13:20:49 -0400
Subject: improve JSON, removing "tag" for sum types

---
 Types.hs | 65 ++++++++++++++++++++++++++++++++++++----------------------------
 1 file changed, 37 insertions(+), 28 deletions(-)

(limited to 'Types.hs')

diff --git a/Types.hs b/Types.hs
index 0e918ea..ae37989 100644
--- a/Types.hs
+++ b/Types.hs
@@ -15,6 +15,7 @@ import Val
 
 import GHC.Generics (Generic)
 import Data.Aeson
+import qualified Data.Aeson.Types as Aeson
 import Data.Time.Clock.POSIX
 
 -- | Things that the developer sees.
@@ -23,9 +24,6 @@ data Seen = Seen
 	}
 	deriving (Show, Generic)
 
-instance ToJSON Seen
-instance FromJSON Seen
-
 -- | Things that the developer enters.
 data Entered = Entered
 	{ enteredData :: Val
@@ -35,9 +33,6 @@ data Entered = Entered
 	}
 	deriving (Show, Generic)
 
-instance ToJSON Entered
-instance FromJSON Entered
-
 -- | High level protocol.
 data Proto a
 	= Proto a
@@ -46,11 +41,6 @@ data Proto a
 	-- ^ sent by user to indicate when an Entered value was rejected.
 	deriving (Show, Generic)
 
-instance ToJSON (Proto Seen)
-instance FromJSON (Proto Seen)
-instance ToJSON (Proto Entered)
-instance FromJSON (Proto Entered)
-
 -- | A Proto activity (either Entered or Seen) with a pointer
 -- to the Activity before this one.
 --
@@ -62,19 +52,11 @@ data Activity a = Activity
 	}
 	deriving (Show, Generic)
 
-instance ToJSON (Activity Seen)
-instance FromJSON (Activity Seen)
-instance ToJSON (Activity Entered)
-instance FromJSON (Activity Entered)
-
 data SomeActivity
 	= ActivitySeen (Activity Seen)
 	| ActivityEntered (Activity Entered)
 	deriving (Show, Generic)
 
-instance ToJSON (SomeActivity)
-instance FromJSON (SomeActivity)
-
 -- | A log of Activity both Entered and Seen, which can be recorded to
 -- prove what happened in a debug-me session.
 --
@@ -87,30 +69,57 @@ data ActivityLog = ActivityLog
 	}
 	deriving (Show, Generic)
 
-instance ToJSON (ActivityLog)
-instance FromJSON (ActivityLog)
-
 type Timestamp = POSIXTime
 
 newtype Signature = Signature Val
 	deriving (Show, Generic)
 
-instance ToJSON Signature
-instance FromJSON Signature
-
 data Hash = Hash
 	{ hashMethod :: HashMethod
 	, hashValue :: Val
 	}
 	deriving (Show, Generic, Eq)
 
-instance ToJSON Hash
-instance FromJSON Hash
-
 -- | We use SHA256. (SHA3 is included to future proof, and because it
 -- improves the generated JSON.)
 data HashMethod = SHA256 | SHA3
 	deriving (Show, Generic, Eq)
 
+instance ToJSON Seen
+instance FromJSON Seen
+instance ToJSON Entered
+instance FromJSON Entered
+instance ToJSON (Activity Seen)
+instance FromJSON (Activity Seen)
+instance ToJSON (Activity Entered)
+instance FromJSON (Activity Entered)
+instance ToJSON (ActivityLog)
+instance FromJSON (ActivityLog)
+instance ToJSON Signature
+instance FromJSON Signature
+instance ToJSON Hash
+instance FromJSON Hash
 instance ToJSON HashMethod
 instance FromJSON HashMethod
+
+-- | Nicer JSON encoding for sum types.
+sumOptions :: Aeson.Options
+sumOptions = defaultOptions { Aeson.sumEncoding = Aeson.ObjectWithSingleField }
+
+instance ToJSON (Proto Seen) where
+	toJSON = genericToJSON sumOptions
+	toEncoding = genericToEncoding sumOptions
+instance FromJSON (Proto Seen) where
+	parseJSON = genericParseJSON sumOptions
+
+instance ToJSON (Proto Entered) where
+	toJSON = genericToJSON sumOptions
+	toEncoding = genericToEncoding sumOptions
+instance FromJSON (Proto Entered) where
+	parseJSON = genericParseJSON sumOptions
+
+instance ToJSON SomeActivity where
+	toJSON = genericToJSON sumOptions
+	toEncoding = genericToEncoding sumOptions
+instance FromJSON SomeActivity where
+	parseJSON = genericParseJSON sumOptions
-- 
cgit v1.2.3