summaryrefslogtreecommitdiffhomepage
path: root/Types.hs
diff options
context:
space:
mode:
authorJoey Hess <joeyh@joeyh.name>2017-04-18 13:20:49 -0400
committerJoey Hess <joeyh@joeyh.name>2017-04-18 13:20:49 -0400
commit88a9ce01d153ad609aa02084de0a93448c29cba4 (patch)
tree5d8fb900d39ded010c23d3f9c4c8518e721cf01d /Types.hs
parent1d18dcbe796820b30e0c8c1db241da95ee7566cb (diff)
downloaddebug-me-88a9ce01d153ad609aa02084de0a93448c29cba4.tar.gz
improve JSON, removing "tag" for sum types
Diffstat (limited to 'Types.hs')
-rw-r--r--Types.hs65
1 files changed, 37 insertions, 28 deletions
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