{-# LANGUAGE OverloadedStrings      #-}
{-# LANGUAGE MultiWayIf             #-}
{-# LANGUAGE ScopedTypeVariables    #-}
{-# LANGUAGE TypeFamilies           #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE AllowAmbiguousTypes    #-}
{-# LANGUAGE InstanceSigs           #-}
{-# LANGUAGE BlockArguments         #-}
{-# LANGUAGE DeriveGeneric          #-}
{-# LANGUAGE LambdaCase             #-}

{- |
Module      : Buttplug.Core.Message
Copyright   : (c) James Sully, 2020-2021
License     : BSD 3-Clause
Maintainer  : sullyj3@gmail.com
Stability   : experimental
Portability : untested

Contains the Message type, representing Buttplug protocol messages
(<https://buttplug-spec.docs.buttplug.io/messages.html>)
-}
module Buttplug.Core.Message where

import           GHC.Generics
import           Data.Text                    ( Text )
import           Data.ByteString              ( ByteString )
import qualified Data.ByteString              as BS
import           Data.Aeson                   ( ToJSON(..)
                                              , FromJSON(..)
                                              , genericToJSON
                                              , Options(..)
                                              , SumEncoding(..)
                                              , genericParseJSON 
                                              )
import           Data.Map.Strict              ( Map )

import qualified Buttplug.Core.Device              as Dev
import           Buttplug.Core.Device              ( Device(..) )
import           Buttplug.Core.Internal.JSONUtils


-- | The version of the Buttplug message protocol that the client speaks.
-- (currently version 2)
clientMessageVersion :: Word
clientMessageVersion :: Word
clientMessageVersion = Word
2
------------------------------------------------


-- | Errors from the server, used in the Error message.
--
-- (<https://buttplug-spec.docs.buttplug.io/status.html#error>)
data ErrorCode = ERROR_UNKNOWN  -- ^ An unknown error occurred. 
               | ERROR_INIT     -- ^ Handshake did not succeed.
               | ERROR_PING     -- ^ A ping was not sent in the expected time.
               | ERROR_MSG      -- ^ A message parsing or permission error occurred.
               | ERROR_DEVICE   -- ^ A command sent to a device returned an error.
               deriving (Int -> ErrorCode
ErrorCode -> Int
ErrorCode -> [ErrorCode]
ErrorCode -> ErrorCode
ErrorCode -> ErrorCode -> [ErrorCode]
ErrorCode -> ErrorCode -> ErrorCode -> [ErrorCode]
(ErrorCode -> ErrorCode)
-> (ErrorCode -> ErrorCode)
-> (Int -> ErrorCode)
-> (ErrorCode -> Int)
-> (ErrorCode -> [ErrorCode])
-> (ErrorCode -> ErrorCode -> [ErrorCode])
-> (ErrorCode -> ErrorCode -> [ErrorCode])
-> (ErrorCode -> ErrorCode -> ErrorCode -> [ErrorCode])
-> Enum ErrorCode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ErrorCode -> ErrorCode -> ErrorCode -> [ErrorCode]
$cenumFromThenTo :: ErrorCode -> ErrorCode -> ErrorCode -> [ErrorCode]
enumFromTo :: ErrorCode -> ErrorCode -> [ErrorCode]
$cenumFromTo :: ErrorCode -> ErrorCode -> [ErrorCode]
enumFromThen :: ErrorCode -> ErrorCode -> [ErrorCode]
$cenumFromThen :: ErrorCode -> ErrorCode -> [ErrorCode]
enumFrom :: ErrorCode -> [ErrorCode]
$cenumFrom :: ErrorCode -> [ErrorCode]
fromEnum :: ErrorCode -> Int
$cfromEnum :: ErrorCode -> Int
toEnum :: Int -> ErrorCode
$ctoEnum :: Int -> ErrorCode
pred :: ErrorCode -> ErrorCode
$cpred :: ErrorCode -> ErrorCode
succ :: ErrorCode -> ErrorCode
$csucc :: ErrorCode -> ErrorCode
Enum, Int -> ErrorCode -> ShowS
[ErrorCode] -> ShowS
ErrorCode -> String
(Int -> ErrorCode -> ShowS)
-> (ErrorCode -> String)
-> ([ErrorCode] -> ShowS)
-> Show ErrorCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrorCode] -> ShowS
$cshowList :: [ErrorCode] -> ShowS
show :: ErrorCode -> String
$cshow :: ErrorCode -> String
showsPrec :: Int -> ErrorCode -> ShowS
$cshowsPrec :: Int -> ErrorCode -> ShowS
Show, ErrorCode -> ErrorCode -> Bool
(ErrorCode -> ErrorCode -> Bool)
-> (ErrorCode -> ErrorCode -> Bool) -> Eq ErrorCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrorCode -> ErrorCode -> Bool
$c/= :: ErrorCode -> ErrorCode -> Bool
== :: ErrorCode -> ErrorCode -> Bool
$c== :: ErrorCode -> ErrorCode -> Bool
Eq, (forall x. ErrorCode -> Rep ErrorCode x)
-> (forall x. Rep ErrorCode x -> ErrorCode) -> Generic ErrorCode
forall x. Rep ErrorCode x -> ErrorCode
forall x. ErrorCode -> Rep ErrorCode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ErrorCode x -> ErrorCode
$cfrom :: forall x. ErrorCode -> Rep ErrorCode x
Generic)


-- TODO these should probably convert with Word not Int
-- | Parse an 'Int' to an 'ErrorCode'
errCodeFromInt :: Int -> Maybe ErrorCode
errCodeFromInt :: Int -> Maybe ErrorCode
errCodeFromInt = \case
  Int
0 -> ErrorCode -> Maybe ErrorCode
forall a. a -> Maybe a
Just ErrorCode
ERROR_UNKNOWN
  Int
1 -> ErrorCode -> Maybe ErrorCode
forall a. a -> Maybe a
Just ErrorCode
ERROR_INIT
  Int
2 -> ErrorCode -> Maybe ErrorCode
forall a. a -> Maybe a
Just ErrorCode
ERROR_PING
  Int
3 -> ErrorCode -> Maybe ErrorCode
forall a. a -> Maybe a
Just ErrorCode
ERROR_MSG
  Int
4 -> ErrorCode -> Maybe ErrorCode
forall a. a -> Maybe a
Just ErrorCode
ERROR_DEVICE
  Int
_ -> Maybe ErrorCode
forall a. Maybe a
Nothing


-- | Convert an 'ErrorCode' to an 'Int'
fromErrCode :: ErrorCode -> Int
fromErrCode :: ErrorCode -> Int
fromErrCode = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> (ErrorCode -> Int) -> ErrorCode -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorCode -> Int
forall a. Enum a => a -> Int
fromEnum


instance ToJSON ErrorCode where
  toJSON :: ErrorCode -> Value
toJSON = Int -> Value
forall a. ToJSON a => a -> Value
toJSON (Int -> Value) -> (ErrorCode -> Int) -> ErrorCode -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorCode -> Int
fromErrCode


instance FromJSON ErrorCode where
  parseJSON :: Value -> Parser ErrorCode
parseJSON Value
v = do
    Maybe ErrorCode
m <- Int -> Maybe ErrorCode
errCodeFromInt (Int -> Maybe ErrorCode) -> Parser Int -> Parser (Maybe ErrorCode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Int
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    case Maybe ErrorCode
m of
      Maybe ErrorCode
Nothing -> String -> Parser ErrorCode
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Error code should be an int"
      Just ErrorCode
e -> ErrorCode -> Parser ErrorCode
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorCode
e

-- Circumvents the fact that Aeson doesn't
-- have bytestring encoding/decoding in genericToJSON and genericParseJSON

-- | Used for the Raw* messages.
newtype RawData = RawData ByteString
  deriving ((forall x. RawData -> Rep RawData x)
-> (forall x. Rep RawData x -> RawData) -> Generic RawData
forall x. Rep RawData x -> RawData
forall x. RawData -> Rep RawData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RawData x -> RawData
$cfrom :: forall x. RawData -> Rep RawData x
Generic, Int -> RawData -> ShowS
[RawData] -> ShowS
RawData -> String
(Int -> RawData -> ShowS)
-> (RawData -> String) -> ([RawData] -> ShowS) -> Show RawData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RawData] -> ShowS
$cshowList :: [RawData] -> ShowS
show :: RawData -> String
$cshow :: RawData -> String
showsPrec :: Int -> RawData -> ShowS
$cshowsPrec :: Int -> RawData -> ShowS
Show, RawData -> RawData -> Bool
(RawData -> RawData -> Bool)
-> (RawData -> RawData -> Bool) -> Eq RawData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RawData -> RawData -> Bool
$c/= :: RawData -> RawData -> Bool
== :: RawData -> RawData -> Bool
$c== :: RawData -> RawData -> Bool
Eq)


instance ToJSON RawData where
  toJSON :: RawData -> Value
toJSON (RawData ByteString
bs) = [Word8] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Word8] -> Value) -> [Word8] -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
BS.unpack ByteString
bs


instance FromJSON RawData where
  parseJSON :: Value -> Parser RawData
parseJSON Value
j = ByteString -> RawData
RawData (ByteString -> RawData)
-> ([Word8] -> ByteString) -> [Word8] -> RawData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> RawData) -> Parser [Word8] -> Parser RawData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser [Word8]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
j

-- | Used in VibrateCmd to specify the speed of the motor at the given index
data Vibrate = Vibrate { Vibrate -> Word
vibrateIndex :: Word
                       , Vibrate -> Double
vibrateSpeed :: Double
                       }
  deriving ((forall x. Vibrate -> Rep Vibrate x)
-> (forall x. Rep Vibrate x -> Vibrate) -> Generic Vibrate
forall x. Rep Vibrate x -> Vibrate
forall x. Vibrate -> Rep Vibrate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Vibrate x -> Vibrate
$cfrom :: forall x. Vibrate -> Rep Vibrate x
Generic, Int -> Vibrate -> ShowS
[Vibrate] -> ShowS
Vibrate -> String
(Int -> Vibrate -> ShowS)
-> (Vibrate -> String) -> ([Vibrate] -> ShowS) -> Show Vibrate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Vibrate] -> ShowS
$cshowList :: [Vibrate] -> ShowS
show :: Vibrate -> String
$cshow :: Vibrate -> String
showsPrec :: Int -> Vibrate -> ShowS
$cshowsPrec :: Int -> Vibrate -> ShowS
Show, Vibrate -> Vibrate -> Bool
(Vibrate -> Vibrate -> Bool)
-> (Vibrate -> Vibrate -> Bool) -> Eq Vibrate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Vibrate -> Vibrate -> Bool
$c/= :: Vibrate -> Vibrate -> Bool
== :: Vibrate -> Vibrate -> Bool
$c== :: Vibrate -> Vibrate -> Bool
Eq)


instance ToJSON Vibrate where
  toJSON :: Vibrate -> Value
toJSON = Options -> Vibrate -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (String -> Options
stripPrefixOptions String
"vibrate")


instance FromJSON Vibrate where
  parseJSON :: Value -> Parser Vibrate
parseJSON = Options -> Value -> Parser Vibrate
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (String -> Options
stripPrefixOptions String
"vibrate")


-- | Used in RotateCmd to specify the speed and direction of rotation of the
-- motor at the given index
data Rotate = Rotate
  { Rotate -> Word
rotateIndex :: Word
  , Rotate -> Double
rotateSpeed :: Double
  , Rotate -> Bool
rotateClockwise :: Bool
  }
  deriving ((forall x. Rotate -> Rep Rotate x)
-> (forall x. Rep Rotate x -> Rotate) -> Generic Rotate
forall x. Rep Rotate x -> Rotate
forall x. Rotate -> Rep Rotate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Rotate x -> Rotate
$cfrom :: forall x. Rotate -> Rep Rotate x
Generic, Int -> Rotate -> ShowS
[Rotate] -> ShowS
Rotate -> String
(Int -> Rotate -> ShowS)
-> (Rotate -> String) -> ([Rotate] -> ShowS) -> Show Rotate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rotate] -> ShowS
$cshowList :: [Rotate] -> ShowS
show :: Rotate -> String
$cshow :: Rotate -> String
showsPrec :: Int -> Rotate -> ShowS
$cshowsPrec :: Int -> Rotate -> ShowS
Show, Rotate -> Rotate -> Bool
(Rotate -> Rotate -> Bool)
-> (Rotate -> Rotate -> Bool) -> Eq Rotate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rotate -> Rotate -> Bool
$c/= :: Rotate -> Rotate -> Bool
== :: Rotate -> Rotate -> Bool
$c== :: Rotate -> Rotate -> Bool
Eq)

instance ToJSON Rotate where
  toJSON :: Rotate -> Value
toJSON = Options -> Rotate -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
pascalCaseOptions { fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
stripPrefix String
"rotate" }


instance FromJSON Rotate where
  parseJSON :: Value -> Parser Rotate
parseJSON = Options -> Value -> Parser Rotate
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
pascalCaseOptions { fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
stripPrefix String
"rotate" }


-- | Used in LinearCmd to specify how to move the linear actuator at the given
-- index
data LinearActuate = LinearActuate
  { LinearActuate -> Word
linActIndex :: Word
  , LinearActuate -> Word
linActDuration :: Word
  , LinearActuate -> Double
linActPosition :: Double
  }
  deriving ((forall x. LinearActuate -> Rep LinearActuate x)
-> (forall x. Rep LinearActuate x -> LinearActuate)
-> Generic LinearActuate
forall x. Rep LinearActuate x -> LinearActuate
forall x. LinearActuate -> Rep LinearActuate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LinearActuate x -> LinearActuate
$cfrom :: forall x. LinearActuate -> Rep LinearActuate x
Generic, Int -> LinearActuate -> ShowS
[LinearActuate] -> ShowS
LinearActuate -> String
(Int -> LinearActuate -> ShowS)
-> (LinearActuate -> String)
-> ([LinearActuate] -> ShowS)
-> Show LinearActuate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LinearActuate] -> ShowS
$cshowList :: [LinearActuate] -> ShowS
show :: LinearActuate -> String
$cshow :: LinearActuate -> String
showsPrec :: Int -> LinearActuate -> ShowS
$cshowsPrec :: Int -> LinearActuate -> ShowS
Show, LinearActuate -> LinearActuate -> Bool
(LinearActuate -> LinearActuate -> Bool)
-> (LinearActuate -> LinearActuate -> Bool) -> Eq LinearActuate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LinearActuate -> LinearActuate -> Bool
$c/= :: LinearActuate -> LinearActuate -> Bool
== :: LinearActuate -> LinearActuate -> Bool
$c== :: LinearActuate -> LinearActuate -> Bool
Eq)


instance ToJSON LinearActuate where
  toJSON :: LinearActuate -> Value
toJSON = Options -> LinearActuate -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
pascalCaseOptions { fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
stripPrefix String
"linAct" }


instance FromJSON LinearActuate where
  parseJSON :: Value -> Parser LinearActuate
parseJSON = Options -> Value -> Parser LinearActuate
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
pascalCaseOptions { fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
stripPrefix String
"linAct" }


-- TODO technically Ids should be Word32, since the maximum id is 4294967295.
-- Not sure whether this applies to other unsigned fields, should find out

-- | The type of Buttplug protocol messages. See
-- (<https://buttplug-spec.docs.buttplug.io/messages.html>) for the protocol
-- specification and an explanation of the purpose of each message.
data Message =
               -- status messages
               MsgOk { Message -> Word
msgId :: Word }
             | MsgError { msgId :: Word
                        , Message -> Text
msgErrorMessage :: Text
                        , Message -> ErrorCode
msgErrorCode :: ErrorCode
                        }
             | MsgPing { msgId :: Word }
               -- handshake messages
             | MsgRequestServerInfo { msgId :: Word
                                    , Message -> Text
msgClientName :: Text
                                    , Message -> Word
msgMessageVersion :: Word
                                    }
             | MsgServerInfo { msgId :: Word
                             , Message -> Text
msgServerName :: Text
                             , msgMessageVersion :: Word
                             , Message -> Word
msgMaxPingTime :: Word
                             }
               -- enumeration messages
             | MsgStartScanning { msgId :: Word }
             | MsgStopScanning { msgId :: Word }
             | MsgScanningFinished { msgId :: Word }
             | MsgRequestDeviceList { msgId :: Word }
             | MsgDeviceList { msgId :: Word
                             , Message -> [Device]
msgDevices :: [ Device ]
                             }
             | MsgDeviceAdded { msgId :: Word
                              , Message -> Text
msgDeviceName :: Text
                              , Message -> Word
msgDeviceIndex :: Word
                              , Message -> Map DeviceMessageType MessageAttributes
msgDeviceMessages :: Map Dev.DeviceMessageType Dev.MessageAttributes
                              }
             | MsgDeviceRemoved { msgId :: Word
                                , msgDeviceIndex :: Word
                                }
               -- raw device messages
             | MsgRawWriteCmd { msgId :: Word
                              , msgDeviceIndex :: Word
                              , Message -> Text
msgEndpoint :: Text
                              , Message -> RawData
msgData :: RawData
                              , Message -> Bool
msgWriteWithResponse :: Bool }
             | MsgRawReadCmd { msgId :: Word
                             , msgDeviceIndex :: Word
                             , msgEndpoint :: Text
                             , Message -> Word
msgExpectedLength :: Word
                             , Message -> Bool
msgWaitForData :: Bool }
             | MsgRawReading { msgId :: Word
                             , msgDeviceIndex :: Word
                             , msgEndpoint :: Text
                             , msgData :: RawData }
             | MsgRawSubscribeCmd { msgId :: Word
                                  , msgDeviceIndex :: Word
                                  , msgEndpoint :: Text }
             | MsgRawUnsubscribeCmd { msgId :: Word
                                    , msgDeviceIndex :: Word
                                    , msgEndpoint :: Text }
               -- generic device messages
             | MsgStopDeviceCmd { msgId :: Word
                                , msgDeviceIndex :: Word
                                }
             | MsgStopAllDevices { msgId :: Word }
             | MsgVibrateCmd { msgId :: Word
                             , msgDeviceIndex :: Word
                             , Message -> [Vibrate]
msgSpeeds :: [ Vibrate ]
                             }
             | MsgLinearCmd { msgId :: Word
                            , msgDeviceIndex :: Word
                            , Message -> [LinearActuate]
msgVectors :: [ LinearActuate ]
                            }
             | MsgRotateCmd { msgId :: Word
                            , msgDeviceIndex :: Word
                            , Message -> [Rotate]
msgRotations :: [ Rotate ]
                            }
               -- generic sensor messages
             | MsgBatteryLevelCmd { msgId :: Word
                                  , msgDeviceIndex :: Word
                                  }
             | MsgBatteryLevelReading { msgId :: Word
                                      , msgDeviceIndex :: Word
                                      , Message -> Double
msgBatteryLevel :: Double
                                      }
             | MsgRSSILevelCmd { msgId :: Word
                               , msgDeviceIndex :: Word
                               }
             | MsgRSSILevelReading { msgId :: Word
                                   , msgDeviceIndex :: Word
                                   , Message -> Int
msgRSSILevel :: Int
                                   }
  deriving (Int -> Message -> ShowS
[Message] -> ShowS
Message -> String
(Int -> Message -> ShowS)
-> (Message -> String) -> ([Message] -> ShowS) -> Show Message
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Message] -> ShowS
$cshowList :: [Message] -> ShowS
show :: Message -> String
$cshow :: Message -> String
showsPrec :: Int -> Message -> ShowS
$cshowsPrec :: Int -> Message -> ShowS
Show, Message -> Message -> Bool
(Message -> Message -> Bool)
-> (Message -> Message -> Bool) -> Eq Message
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Message -> Message -> Bool
$c/= :: Message -> Message -> Bool
== :: Message -> Message -> Bool
$c== :: Message -> Message -> Bool
Eq, (forall x. Message -> Rep Message x)
-> (forall x. Rep Message x -> Message) -> Generic Message
forall x. Rep Message x -> Message
forall x. Message -> Rep Message x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Message x -> Message
$cfrom :: forall x. Message -> Rep Message x
Generic)


instance ToJSON Message where
  toJSON :: Message -> Value
toJSON = Options -> Message -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> Message -> Value) -> Options -> Message -> Value
forall a b. (a -> b) -> a -> b
$ Options
pascalCaseOptions { sumEncoding :: SumEncoding
sumEncoding = SumEncoding
ObjectWithSingleField
                                             , fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
stripPrefix String
"msg"
                                             , constructorTagModifier :: ShowS
constructorTagModifier = String -> ShowS
stripPrefix String
"Msg" }


instance FromJSON Message where
  parseJSON :: Value -> Parser Message
parseJSON = Options -> Value -> Parser Message
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser Message)
-> Options -> Value -> Parser Message
forall a b. (a -> b) -> a -> b
$ Options
pascalCaseOptions { sumEncoding :: SumEncoding
sumEncoding = SumEncoding
ObjectWithSingleField
                                                   , fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
stripPrefix String
"msg"
                                                   , constructorTagModifier :: ShowS
constructorTagModifier = String -> ShowS
stripPrefix String
"Msg" }