{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
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
clientMessageVersion :: Word
clientMessageVersion :: Word
clientMessageVersion = Word
2
data ErrorCode = ERROR_UNKNOWN
| ERROR_INIT
| ERROR_PING
| ERROR_MSG
| ERROR_DEVICE
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)
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
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
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
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")
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" }
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" }
data Message =
MsgOk { Message -> Word
msgId :: Word }
| MsgError { msgId :: Word
, Message -> Text
msgErrorMessage :: Text
, Message -> ErrorCode
msgErrorCode :: ErrorCode
}
| MsgPing { msgId :: Word }
| MsgRequestServerInfo { msgId :: Word
, Message -> Text
msgClientName :: Text
, Message -> Word
msgMessageVersion :: Word
}
| MsgServerInfo { msgId :: Word
, Message -> Text
msgServerName :: Text
, msgMessageVersion :: Word
, Message -> Word
msgMaxPingTime :: Word
}
| 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
}
| 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 }
| 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 ]
}
| MsgBatteryLevelCmd { msgId :: Word
, msgDeviceIndex :: Word
}
| MsgBatteryLevelReading { msgId :: Word
, msgDeviceIndex :: Word
, Message -> Double
msgBatteryLevel :: Double
}
| { msgId :: Word
, msgDeviceIndex :: Word
}
| { msgId :: Word
, msgDeviceIndex :: Word
, :: 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" }