{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# LANGUAGE NoImplicitPrelude           #-}
{-# LANGUAGE TemplateHaskell             #-}
{-# LANGUAGE RecordWildCards             #-}

-- |
-- Module:      SwiftNav.SBP.Piksi
-- Copyright:   Copyright (C) 2015-2021 Swift Navigation, Inc.
-- License:     MIT
-- Contact:     https://support.swiftnav.com
-- Stability:   experimental
-- Portability: portable
--
-- \< System health, configuration, and diagnostic messages specific to the Piksi
-- L1 receiver, including a variety of legacy messages that may no longer be
-- used. \>

module SwiftNav.SBP.Piksi
  ( module SwiftNav.SBP.Piksi
  ) where

import BasicPrelude
import Control.Lens
import Control.Monad.Loops
import Data.Binary
import Data.Binary.Get
import Data.Binary.IEEE754
import Data.Binary.Put
import Data.ByteString.Lazy    hiding (ByteString)
import Data.Int
import Data.Word
import SwiftNav.SBP.TH
import SwiftNav.SBP.Types
import SwiftNav.SBP.Gnss

{-# ANN module ("HLint: ignore Use camelCase"::String) #-}
{-# ANN module ("HLint: ignore Redundant do"::String) #-}
{-# ANN module ("HLint: ignore Use newtype instead of data"::String) #-}


msgAlmanac :: Word16
msgAlmanac :: Word16
msgAlmanac = Word16
0x0069

-- | SBP class for message MSG_ALMANAC (0x0069).
--
-- This is a legacy message for sending and loading a satellite alamanac onto
-- the Piksi's flash memory from the host.
data MsgAlmanac = MsgAlmanac
  deriving ( Int -> MsgAlmanac -> ShowS
[MsgAlmanac] -> ShowS
MsgAlmanac -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgAlmanac] -> ShowS
$cshowList :: [MsgAlmanac] -> ShowS
show :: MsgAlmanac -> String
$cshow :: MsgAlmanac -> String
showsPrec :: Int -> MsgAlmanac -> ShowS
$cshowsPrec :: Int -> MsgAlmanac -> ShowS
Show, ReadPrec [MsgAlmanac]
ReadPrec MsgAlmanac
Int -> ReadS MsgAlmanac
ReadS [MsgAlmanac]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgAlmanac]
$creadListPrec :: ReadPrec [MsgAlmanac]
readPrec :: ReadPrec MsgAlmanac
$creadPrec :: ReadPrec MsgAlmanac
readList :: ReadS [MsgAlmanac]
$creadList :: ReadS [MsgAlmanac]
readsPrec :: Int -> ReadS MsgAlmanac
$creadsPrec :: Int -> ReadS MsgAlmanac
Read, MsgAlmanac -> MsgAlmanac -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgAlmanac -> MsgAlmanac -> Bool
$c/= :: MsgAlmanac -> MsgAlmanac -> Bool
== :: MsgAlmanac -> MsgAlmanac -> Bool
$c== :: MsgAlmanac -> MsgAlmanac -> Bool
Eq )

instance Binary MsgAlmanac where
  get :: Get MsgAlmanac
get =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgAlmanac
MsgAlmanac

  put :: MsgAlmanac -> Put
put MsgAlmanac
MsgAlmanac =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
$(makeSBP 'msgAlmanac ''MsgAlmanac)
$(makeJSON "_msgAlmanac_" ''MsgAlmanac)
$(makeLenses ''MsgAlmanac)

msgSetTime :: Word16
msgSetTime :: Word16
msgSetTime = Word16
0x0068

-- | SBP class for message MSG_SET_TIME (0x0068).
--
-- This message sets up timing functionality using a coarse GPS time estimate
-- sent by the host.
data MsgSetTime = MsgSetTime
  deriving ( Int -> MsgSetTime -> ShowS
[MsgSetTime] -> ShowS
MsgSetTime -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgSetTime] -> ShowS
$cshowList :: [MsgSetTime] -> ShowS
show :: MsgSetTime -> String
$cshow :: MsgSetTime -> String
showsPrec :: Int -> MsgSetTime -> ShowS
$cshowsPrec :: Int -> MsgSetTime -> ShowS
Show, ReadPrec [MsgSetTime]
ReadPrec MsgSetTime
Int -> ReadS MsgSetTime
ReadS [MsgSetTime]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgSetTime]
$creadListPrec :: ReadPrec [MsgSetTime]
readPrec :: ReadPrec MsgSetTime
$creadPrec :: ReadPrec MsgSetTime
readList :: ReadS [MsgSetTime]
$creadList :: ReadS [MsgSetTime]
readsPrec :: Int -> ReadS MsgSetTime
$creadsPrec :: Int -> ReadS MsgSetTime
Read, MsgSetTime -> MsgSetTime -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgSetTime -> MsgSetTime -> Bool
$c/= :: MsgSetTime -> MsgSetTime -> Bool
== :: MsgSetTime -> MsgSetTime -> Bool
$c== :: MsgSetTime -> MsgSetTime -> Bool
Eq )

instance Binary MsgSetTime where
  get :: Get MsgSetTime
get =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgSetTime
MsgSetTime

  put :: MsgSetTime -> Put
put MsgSetTime
MsgSetTime =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
$(makeSBP 'msgSetTime ''MsgSetTime)
$(makeJSON "_msgSetTime_" ''MsgSetTime)
$(makeLenses ''MsgSetTime)

msgReset :: Word16
msgReset :: Word16
msgReset = Word16
0x00B6

-- | SBP class for message MSG_RESET (0x00B6).
--
-- This message from the host resets the Piksi back into the bootloader.
data MsgReset = MsgReset
  { MsgReset -> Word32
_msgReset_flags :: !Word32
    -- ^ Reset flags
  } deriving ( Int -> MsgReset -> ShowS
[MsgReset] -> ShowS
MsgReset -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgReset] -> ShowS
$cshowList :: [MsgReset] -> ShowS
show :: MsgReset -> String
$cshow :: MsgReset -> String
showsPrec :: Int -> MsgReset -> ShowS
$cshowsPrec :: Int -> MsgReset -> ShowS
Show, ReadPrec [MsgReset]
ReadPrec MsgReset
Int -> ReadS MsgReset
ReadS [MsgReset]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgReset]
$creadListPrec :: ReadPrec [MsgReset]
readPrec :: ReadPrec MsgReset
$creadPrec :: ReadPrec MsgReset
readList :: ReadS [MsgReset]
$creadList :: ReadS [MsgReset]
readsPrec :: Int -> ReadS MsgReset
$creadsPrec :: Int -> ReadS MsgReset
Read, MsgReset -> MsgReset -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgReset -> MsgReset -> Bool
$c/= :: MsgReset -> MsgReset -> Bool
== :: MsgReset -> MsgReset -> Bool
$c== :: MsgReset -> MsgReset -> Bool
Eq )

instance Binary MsgReset where
  get :: Get MsgReset
get = do
    Word32
_msgReset_flags <- Get Word32
getWord32le
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgReset {Word32
_msgReset_flags :: Word32
_msgReset_flags :: Word32
..}

  put :: MsgReset -> Put
put MsgReset {Word32
_msgReset_flags :: Word32
_msgReset_flags :: MsgReset -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgReset_flags

$(makeSBP 'msgReset ''MsgReset)
$(makeJSON "_msgReset_" ''MsgReset)
$(makeLenses ''MsgReset)

msgResetDep :: Word16
msgResetDep :: Word16
msgResetDep = Word16
0x00B2

-- | SBP class for message MSG_RESET_DEP (0x00B2).
--
-- Deprecated.
data MsgResetDep = MsgResetDep
  deriving ( Int -> MsgResetDep -> ShowS
[MsgResetDep] -> ShowS
MsgResetDep -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgResetDep] -> ShowS
$cshowList :: [MsgResetDep] -> ShowS
show :: MsgResetDep -> String
$cshow :: MsgResetDep -> String
showsPrec :: Int -> MsgResetDep -> ShowS
$cshowsPrec :: Int -> MsgResetDep -> ShowS
Show, ReadPrec [MsgResetDep]
ReadPrec MsgResetDep
Int -> ReadS MsgResetDep
ReadS [MsgResetDep]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgResetDep]
$creadListPrec :: ReadPrec [MsgResetDep]
readPrec :: ReadPrec MsgResetDep
$creadPrec :: ReadPrec MsgResetDep
readList :: ReadS [MsgResetDep]
$creadList :: ReadS [MsgResetDep]
readsPrec :: Int -> ReadS MsgResetDep
$creadsPrec :: Int -> ReadS MsgResetDep
Read, MsgResetDep -> MsgResetDep -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgResetDep -> MsgResetDep -> Bool
$c/= :: MsgResetDep -> MsgResetDep -> Bool
== :: MsgResetDep -> MsgResetDep -> Bool
$c== :: MsgResetDep -> MsgResetDep -> Bool
Eq )

instance Binary MsgResetDep where
  get :: Get MsgResetDep
get =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgResetDep
MsgResetDep

  put :: MsgResetDep -> Put
put MsgResetDep
MsgResetDep =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
$(makeSBP 'msgResetDep ''MsgResetDep)
$(makeJSON "_msgResetDep_" ''MsgResetDep)
$(makeLenses ''MsgResetDep)

msgCwResults :: Word16
msgCwResults :: Word16
msgCwResults = Word16
0x00C0

-- | SBP class for message MSG_CW_RESULTS (0x00C0).
--
-- This is an unused legacy message for result reporting from the CW
-- interference channel on the SwiftNAP. This message will be removed in a
-- future release.
data MsgCwResults = MsgCwResults
  deriving ( Int -> MsgCwResults -> ShowS
[MsgCwResults] -> ShowS
MsgCwResults -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgCwResults] -> ShowS
$cshowList :: [MsgCwResults] -> ShowS
show :: MsgCwResults -> String
$cshow :: MsgCwResults -> String
showsPrec :: Int -> MsgCwResults -> ShowS
$cshowsPrec :: Int -> MsgCwResults -> ShowS
Show, ReadPrec [MsgCwResults]
ReadPrec MsgCwResults
Int -> ReadS MsgCwResults
ReadS [MsgCwResults]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgCwResults]
$creadListPrec :: ReadPrec [MsgCwResults]
readPrec :: ReadPrec MsgCwResults
$creadPrec :: ReadPrec MsgCwResults
readList :: ReadS [MsgCwResults]
$creadList :: ReadS [MsgCwResults]
readsPrec :: Int -> ReadS MsgCwResults
$creadsPrec :: Int -> ReadS MsgCwResults
Read, MsgCwResults -> MsgCwResults -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgCwResults -> MsgCwResults -> Bool
$c/= :: MsgCwResults -> MsgCwResults -> Bool
== :: MsgCwResults -> MsgCwResults -> Bool
$c== :: MsgCwResults -> MsgCwResults -> Bool
Eq )

instance Binary MsgCwResults where
  get :: Get MsgCwResults
get =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgCwResults
MsgCwResults

  put :: MsgCwResults -> Put
put MsgCwResults
MsgCwResults =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
$(makeSBP 'msgCwResults ''MsgCwResults)
$(makeJSON "_msgCwResults_" ''MsgCwResults)
$(makeLenses ''MsgCwResults)

msgCwStart :: Word16
msgCwStart :: Word16
msgCwStart = Word16
0x00C1

-- | SBP class for message MSG_CW_START (0x00C1).
--
-- This is an unused legacy message from the host for starting the CW
-- interference channel on the SwiftNAP. This message will be removed in a
-- future release.
data MsgCwStart = MsgCwStart
  deriving ( Int -> MsgCwStart -> ShowS
[MsgCwStart] -> ShowS
MsgCwStart -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgCwStart] -> ShowS
$cshowList :: [MsgCwStart] -> ShowS
show :: MsgCwStart -> String
$cshow :: MsgCwStart -> String
showsPrec :: Int -> MsgCwStart -> ShowS
$cshowsPrec :: Int -> MsgCwStart -> ShowS
Show, ReadPrec [MsgCwStart]
ReadPrec MsgCwStart
Int -> ReadS MsgCwStart
ReadS [MsgCwStart]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgCwStart]
$creadListPrec :: ReadPrec [MsgCwStart]
readPrec :: ReadPrec MsgCwStart
$creadPrec :: ReadPrec MsgCwStart
readList :: ReadS [MsgCwStart]
$creadList :: ReadS [MsgCwStart]
readsPrec :: Int -> ReadS MsgCwStart
$creadsPrec :: Int -> ReadS MsgCwStart
Read, MsgCwStart -> MsgCwStart -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgCwStart -> MsgCwStart -> Bool
$c/= :: MsgCwStart -> MsgCwStart -> Bool
== :: MsgCwStart -> MsgCwStart -> Bool
$c== :: MsgCwStart -> MsgCwStart -> Bool
Eq )

instance Binary MsgCwStart where
  get :: Get MsgCwStart
get =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgCwStart
MsgCwStart

  put :: MsgCwStart -> Put
put MsgCwStart
MsgCwStart =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
$(makeSBP 'msgCwStart ''MsgCwStart)
$(makeJSON "_msgCwStart_" ''MsgCwStart)
$(makeLenses ''MsgCwStart)

msgResetFilters :: Word16
msgResetFilters :: Word16
msgResetFilters = Word16
0x0022

-- | SBP class for message MSG_RESET_FILTERS (0x0022).
--
-- This message resets either the DGNSS Kalman filters or Integer Ambiguity
-- Resolution (IAR) process.
data MsgResetFilters = MsgResetFilters
  { MsgResetFilters -> Word8
_msgResetFilters_filter :: !Word8
    -- ^ Filter flags
  } deriving ( Int -> MsgResetFilters -> ShowS
[MsgResetFilters] -> ShowS
MsgResetFilters -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgResetFilters] -> ShowS
$cshowList :: [MsgResetFilters] -> ShowS
show :: MsgResetFilters -> String
$cshow :: MsgResetFilters -> String
showsPrec :: Int -> MsgResetFilters -> ShowS
$cshowsPrec :: Int -> MsgResetFilters -> ShowS
Show, ReadPrec [MsgResetFilters]
ReadPrec MsgResetFilters
Int -> ReadS MsgResetFilters
ReadS [MsgResetFilters]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgResetFilters]
$creadListPrec :: ReadPrec [MsgResetFilters]
readPrec :: ReadPrec MsgResetFilters
$creadPrec :: ReadPrec MsgResetFilters
readList :: ReadS [MsgResetFilters]
$creadList :: ReadS [MsgResetFilters]
readsPrec :: Int -> ReadS MsgResetFilters
$creadsPrec :: Int -> ReadS MsgResetFilters
Read, MsgResetFilters -> MsgResetFilters -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgResetFilters -> MsgResetFilters -> Bool
$c/= :: MsgResetFilters -> MsgResetFilters -> Bool
== :: MsgResetFilters -> MsgResetFilters -> Bool
$c== :: MsgResetFilters -> MsgResetFilters -> Bool
Eq )

instance Binary MsgResetFilters where
  get :: Get MsgResetFilters
get = do
    Word8
_msgResetFilters_filter <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgResetFilters {Word8
_msgResetFilters_filter :: Word8
_msgResetFilters_filter :: Word8
..}

  put :: MsgResetFilters -> Put
put MsgResetFilters {Word8
_msgResetFilters_filter :: Word8
_msgResetFilters_filter :: MsgResetFilters -> Word8
..} = do
    Word8 -> Put
putWord8 Word8
_msgResetFilters_filter

$(makeSBP 'msgResetFilters ''MsgResetFilters)
$(makeJSON "_msgResetFilters_" ''MsgResetFilters)
$(makeLenses ''MsgResetFilters)

msgInitBaseDep :: Word16
msgInitBaseDep :: Word16
msgInitBaseDep = Word16
0x0023

-- | SBP class for message MSG_INIT_BASE_DEP (0x0023).
--
-- Deprecated.
data MsgInitBaseDep = MsgInitBaseDep
  deriving ( Int -> MsgInitBaseDep -> ShowS
[MsgInitBaseDep] -> ShowS
MsgInitBaseDep -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgInitBaseDep] -> ShowS
$cshowList :: [MsgInitBaseDep] -> ShowS
show :: MsgInitBaseDep -> String
$cshow :: MsgInitBaseDep -> String
showsPrec :: Int -> MsgInitBaseDep -> ShowS
$cshowsPrec :: Int -> MsgInitBaseDep -> ShowS
Show, ReadPrec [MsgInitBaseDep]
ReadPrec MsgInitBaseDep
Int -> ReadS MsgInitBaseDep
ReadS [MsgInitBaseDep]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgInitBaseDep]
$creadListPrec :: ReadPrec [MsgInitBaseDep]
readPrec :: ReadPrec MsgInitBaseDep
$creadPrec :: ReadPrec MsgInitBaseDep
readList :: ReadS [MsgInitBaseDep]
$creadList :: ReadS [MsgInitBaseDep]
readsPrec :: Int -> ReadS MsgInitBaseDep
$creadsPrec :: Int -> ReadS MsgInitBaseDep
Read, MsgInitBaseDep -> MsgInitBaseDep -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgInitBaseDep -> MsgInitBaseDep -> Bool
$c/= :: MsgInitBaseDep -> MsgInitBaseDep -> Bool
== :: MsgInitBaseDep -> MsgInitBaseDep -> Bool
$c== :: MsgInitBaseDep -> MsgInitBaseDep -> Bool
Eq )

instance Binary MsgInitBaseDep where
  get :: Get MsgInitBaseDep
get =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgInitBaseDep
MsgInitBaseDep

  put :: MsgInitBaseDep -> Put
put MsgInitBaseDep
MsgInitBaseDep =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
$(makeSBP 'msgInitBaseDep ''MsgInitBaseDep)
$(makeJSON "_msgInitBaseDep_" ''MsgInitBaseDep)
$(makeLenses ''MsgInitBaseDep)

msgThreadState :: Word16
msgThreadState :: Word16
msgThreadState = Word16
0x0017

-- | SBP class for message MSG_THREAD_STATE (0x0017).
--
-- The thread usage message from the device reports real-time operating system
-- (RTOS) thread usage statistics for the named thread. The reported
-- percentage values must be normalized.
data MsgThreadState = MsgThreadState
  { MsgThreadState -> Text
_msgThreadState_name     :: !Text
    -- ^ Thread name (NULL terminated)
  , MsgThreadState -> Word16
_msgThreadState_cpu      :: !Word16
    -- ^ Percentage cpu use for this thread. Values range from 0 - 1000 and
    -- needs to be renormalized to 100
  , MsgThreadState -> Word32
_msgThreadState_stack_free :: !Word32
    -- ^ Free stack space for this thread
  } deriving ( Int -> MsgThreadState -> ShowS
[MsgThreadState] -> ShowS
MsgThreadState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgThreadState] -> ShowS
$cshowList :: [MsgThreadState] -> ShowS
show :: MsgThreadState -> String
$cshow :: MsgThreadState -> String
showsPrec :: Int -> MsgThreadState -> ShowS
$cshowsPrec :: Int -> MsgThreadState -> ShowS
Show, ReadPrec [MsgThreadState]
ReadPrec MsgThreadState
Int -> ReadS MsgThreadState
ReadS [MsgThreadState]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgThreadState]
$creadListPrec :: ReadPrec [MsgThreadState]
readPrec :: ReadPrec MsgThreadState
$creadPrec :: ReadPrec MsgThreadState
readList :: ReadS [MsgThreadState]
$creadList :: ReadS [MsgThreadState]
readsPrec :: Int -> ReadS MsgThreadState
$creadsPrec :: Int -> ReadS MsgThreadState
Read, MsgThreadState -> MsgThreadState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgThreadState -> MsgThreadState -> Bool
$c/= :: MsgThreadState -> MsgThreadState -> Bool
== :: MsgThreadState -> MsgThreadState -> Bool
$c== :: MsgThreadState -> MsgThreadState -> Bool
Eq )

instance Binary MsgThreadState where
  get :: Get MsgThreadState
get = do
    Text
_msgThreadState_name <- ByteString -> Text
decodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
20
    Word16
_msgThreadState_cpu <- Get Word16
getWord16le
    Word32
_msgThreadState_stack_free <- Get Word32
getWord32le
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgThreadState {Word16
Word32
Text
_msgThreadState_stack_free :: Word32
_msgThreadState_cpu :: Word16
_msgThreadState_name :: Text
_msgThreadState_stack_free :: Word32
_msgThreadState_cpu :: Word16
_msgThreadState_name :: Text
..}

  put :: MsgThreadState -> Put
put MsgThreadState {Word16
Word32
Text
_msgThreadState_stack_free :: Word32
_msgThreadState_cpu :: Word16
_msgThreadState_name :: Text
_msgThreadState_stack_free :: MsgThreadState -> Word32
_msgThreadState_cpu :: MsgThreadState -> Word16
_msgThreadState_name :: MsgThreadState -> Text
..} = do
    ByteString -> Put
putByteString forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
_msgThreadState_name
    Word16 -> Put
putWord16le Word16
_msgThreadState_cpu
    Word32 -> Put
putWord32le Word32
_msgThreadState_stack_free

$(makeSBP 'msgThreadState ''MsgThreadState)
$(makeJSON "_msgThreadState_" ''MsgThreadState)
$(makeLenses ''MsgThreadState)

-- | UARTChannel.
--
-- Throughput, utilization, and error counts on the RX/TX buffers of this UART
-- channel. The reported percentage values must be normalized.
data UARTChannel = UARTChannel
  { UARTChannel -> Float
_uARTChannel_tx_throughput :: !Float
    -- ^ UART transmit throughput
  , UARTChannel -> Float
_uARTChannel_rx_throughput :: !Float
    -- ^ UART receive throughput
  , UARTChannel -> Word16
_uARTChannel_crc_error_count :: !Word16
    -- ^ UART CRC error count
  , UARTChannel -> Word16
_uARTChannel_io_error_count :: !Word16
    -- ^ UART IO error count
  , UARTChannel -> Word8
_uARTChannel_tx_buffer_level :: !Word8
    -- ^ UART transmit buffer percentage utilization (ranges from 0 to 255)
  , UARTChannel -> Word8
_uARTChannel_rx_buffer_level :: !Word8
    -- ^ UART receive buffer percentage utilization (ranges from 0 to 255)
  } deriving ( Int -> UARTChannel -> ShowS
[UARTChannel] -> ShowS
UARTChannel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UARTChannel] -> ShowS
$cshowList :: [UARTChannel] -> ShowS
show :: UARTChannel -> String
$cshow :: UARTChannel -> String
showsPrec :: Int -> UARTChannel -> ShowS
$cshowsPrec :: Int -> UARTChannel -> ShowS
Show, ReadPrec [UARTChannel]
ReadPrec UARTChannel
Int -> ReadS UARTChannel
ReadS [UARTChannel]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UARTChannel]
$creadListPrec :: ReadPrec [UARTChannel]
readPrec :: ReadPrec UARTChannel
$creadPrec :: ReadPrec UARTChannel
readList :: ReadS [UARTChannel]
$creadList :: ReadS [UARTChannel]
readsPrec :: Int -> ReadS UARTChannel
$creadsPrec :: Int -> ReadS UARTChannel
Read, UARTChannel -> UARTChannel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UARTChannel -> UARTChannel -> Bool
$c/= :: UARTChannel -> UARTChannel -> Bool
== :: UARTChannel -> UARTChannel -> Bool
$c== :: UARTChannel -> UARTChannel -> Bool
Eq )

instance Binary UARTChannel where
  get :: Get UARTChannel
get = do
    Float
_uARTChannel_tx_throughput <- Get Float
getFloat32le
    Float
_uARTChannel_rx_throughput <- Get Float
getFloat32le
    Word16
_uARTChannel_crc_error_count <- Get Word16
getWord16le
    Word16
_uARTChannel_io_error_count <- Get Word16
getWord16le
    Word8
_uARTChannel_tx_buffer_level <- Get Word8
getWord8
    Word8
_uARTChannel_rx_buffer_level <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure UARTChannel {Float
Word8
Word16
_uARTChannel_rx_buffer_level :: Word8
_uARTChannel_tx_buffer_level :: Word8
_uARTChannel_io_error_count :: Word16
_uARTChannel_crc_error_count :: Word16
_uARTChannel_rx_throughput :: Float
_uARTChannel_tx_throughput :: Float
_uARTChannel_rx_buffer_level :: Word8
_uARTChannel_tx_buffer_level :: Word8
_uARTChannel_io_error_count :: Word16
_uARTChannel_crc_error_count :: Word16
_uARTChannel_rx_throughput :: Float
_uARTChannel_tx_throughput :: Float
..}

  put :: UARTChannel -> Put
put UARTChannel {Float
Word8
Word16
_uARTChannel_rx_buffer_level :: Word8
_uARTChannel_tx_buffer_level :: Word8
_uARTChannel_io_error_count :: Word16
_uARTChannel_crc_error_count :: Word16
_uARTChannel_rx_throughput :: Float
_uARTChannel_tx_throughput :: Float
_uARTChannel_rx_buffer_level :: UARTChannel -> Word8
_uARTChannel_tx_buffer_level :: UARTChannel -> Word8
_uARTChannel_io_error_count :: UARTChannel -> Word16
_uARTChannel_crc_error_count :: UARTChannel -> Word16
_uARTChannel_rx_throughput :: UARTChannel -> Float
_uARTChannel_tx_throughput :: UARTChannel -> Float
..} = do
    Float -> Put
putFloat32le Float
_uARTChannel_tx_throughput
    Float -> Put
putFloat32le Float
_uARTChannel_rx_throughput
    Word16 -> Put
putWord16le Word16
_uARTChannel_crc_error_count
    Word16 -> Put
putWord16le Word16
_uARTChannel_io_error_count
    Word8 -> Put
putWord8 Word8
_uARTChannel_tx_buffer_level
    Word8 -> Put
putWord8 Word8
_uARTChannel_rx_buffer_level

$(makeJSON "_uARTChannel_" ''UARTChannel)
$(makeLenses ''UARTChannel)

-- | Period.
--
-- Statistics on the period of observations received from the base station. As
-- complete observation sets are received, their time of reception is compared
-- with the prior set''s time of reception. This measurement provides a proxy
-- for link quality as incomplete or missing sets will increase the period.
-- Long periods can cause momentary RTK solution outages.
data Period = Period
  { Period -> Int32
_period_avg   :: !Int32
    -- ^ Average period
  , Period -> Int32
_period_pmin  :: !Int32
    -- ^ Minimum period
  , Period -> Int32
_period_pmax  :: !Int32
    -- ^ Maximum period
  , Period -> Int32
_period_current :: !Int32
    -- ^ Smoothed estimate of the current period
  } deriving ( Int -> Period -> ShowS
[Period] -> ShowS
Period -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Period] -> ShowS
$cshowList :: [Period] -> ShowS
show :: Period -> String
$cshow :: Period -> String
showsPrec :: Int -> Period -> ShowS
$cshowsPrec :: Int -> Period -> ShowS
Show, ReadPrec [Period]
ReadPrec Period
Int -> ReadS Period
ReadS [Period]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Period]
$creadListPrec :: ReadPrec [Period]
readPrec :: ReadPrec Period
$creadPrec :: ReadPrec Period
readList :: ReadS [Period]
$creadList :: ReadS [Period]
readsPrec :: Int -> ReadS Period
$creadsPrec :: Int -> ReadS Period
Read, Period -> Period -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Period -> Period -> Bool
$c/= :: Period -> Period -> Bool
== :: Period -> Period -> Bool
$c== :: Period -> Period -> Bool
Eq )

instance Binary Period where
  get :: Get Period
get = do
    Int32
_period_avg <- (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le)
    Int32
_period_pmin <- (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le)
    Int32
_period_pmax <- (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le)
    Int32
_period_current <- (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure Period {Int32
_period_current :: Int32
_period_pmax :: Int32
_period_pmin :: Int32
_period_avg :: Int32
_period_current :: Int32
_period_pmax :: Int32
_period_pmin :: Int32
_period_avg :: Int32
..}

  put :: Period -> Put
put Period {Int32
_period_current :: Int32
_period_pmax :: Int32
_period_pmin :: Int32
_period_avg :: Int32
_period_current :: Period -> Int32
_period_pmax :: Period -> Int32
_period_pmin :: Period -> Int32
_period_avg :: Period -> Int32
..} = do
    (Word32 -> Put
putWord32le forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) Int32
_period_avg
    (Word32 -> Put
putWord32le forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) Int32
_period_pmin
    (Word32 -> Put
putWord32le forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) Int32
_period_pmax
    (Word32 -> Put
putWord32le forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) Int32
_period_current

$(makeJSON "_period_" ''Period)
$(makeLenses ''Period)

-- | Latency.
--
-- Statistics on the latency of observations received from the base station.
-- As observation packets are received their GPS time is compared to the
-- current GPS time calculated locally by the receiver to give a precise
-- measurement of the end-to-end communication latency in the system.
data Latency = Latency
  { Latency -> Int32
_latency_avg   :: !Int32
    -- ^ Average latency
  , Latency -> Int32
_latency_lmin  :: !Int32
    -- ^ Minimum latency
  , Latency -> Int32
_latency_lmax  :: !Int32
    -- ^ Maximum latency
  , Latency -> Int32
_latency_current :: !Int32
    -- ^ Smoothed estimate of the current latency
  } deriving ( Int -> Latency -> ShowS
[Latency] -> ShowS
Latency -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Latency] -> ShowS
$cshowList :: [Latency] -> ShowS
show :: Latency -> String
$cshow :: Latency -> String
showsPrec :: Int -> Latency -> ShowS
$cshowsPrec :: Int -> Latency -> ShowS
Show, ReadPrec [Latency]
ReadPrec Latency
Int -> ReadS Latency
ReadS [Latency]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Latency]
$creadListPrec :: ReadPrec [Latency]
readPrec :: ReadPrec Latency
$creadPrec :: ReadPrec Latency
readList :: ReadS [Latency]
$creadList :: ReadS [Latency]
readsPrec :: Int -> ReadS Latency
$creadsPrec :: Int -> ReadS Latency
Read, Latency -> Latency -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Latency -> Latency -> Bool
$c/= :: Latency -> Latency -> Bool
== :: Latency -> Latency -> Bool
$c== :: Latency -> Latency -> Bool
Eq )

instance Binary Latency where
  get :: Get Latency
get = do
    Int32
_latency_avg <- (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le)
    Int32
_latency_lmin <- (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le)
    Int32
_latency_lmax <- (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le)
    Int32
_latency_current <- (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure Latency {Int32
_latency_current :: Int32
_latency_lmax :: Int32
_latency_lmin :: Int32
_latency_avg :: Int32
_latency_current :: Int32
_latency_lmax :: Int32
_latency_lmin :: Int32
_latency_avg :: Int32
..}

  put :: Latency -> Put
put Latency {Int32
_latency_current :: Int32
_latency_lmax :: Int32
_latency_lmin :: Int32
_latency_avg :: Int32
_latency_current :: Latency -> Int32
_latency_lmax :: Latency -> Int32
_latency_lmin :: Latency -> Int32
_latency_avg :: Latency -> Int32
..} = do
    (Word32 -> Put
putWord32le forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) Int32
_latency_avg
    (Word32 -> Put
putWord32le forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) Int32
_latency_lmin
    (Word32 -> Put
putWord32le forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) Int32
_latency_lmax
    (Word32 -> Put
putWord32le forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) Int32
_latency_current

$(makeJSON "_latency_" ''Latency)
$(makeLenses ''Latency)

msgUartState :: Word16
msgUartState :: Word16
msgUartState = Word16
0x001D

-- | SBP class for message MSG_UART_STATE (0x001D).
--
-- The UART message reports data latency and throughput of the UART channels
-- providing SBP I/O. On the default Piksi configuration, UARTs A and B are
-- used for telemetry radios, but can also be host access ports for embedded
-- hosts, or other interfaces in future. The reported percentage values must
-- be normalized. Observations latency and period can be used to assess the
-- health of the differential corrections link. Latency provides the
-- timeliness of received base observations while the period indicates their
-- likelihood of transmission.
data MsgUartState = MsgUartState
  { MsgUartState -> UARTChannel
_msgUartState_uart_a   :: !UARTChannel
    -- ^ State of UART A
  , MsgUartState -> UARTChannel
_msgUartState_uart_b   :: !UARTChannel
    -- ^ State of UART B
  , MsgUartState -> UARTChannel
_msgUartState_uart_ftdi :: !UARTChannel
    -- ^ State of UART FTDI (USB logger)
  , MsgUartState -> Latency
_msgUartState_latency  :: !Latency
    -- ^ UART communication latency
  , MsgUartState -> Period
_msgUartState_obs_period :: !Period
    -- ^ Observation receipt period
  } deriving ( Int -> MsgUartState -> ShowS
[MsgUartState] -> ShowS
MsgUartState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgUartState] -> ShowS
$cshowList :: [MsgUartState] -> ShowS
show :: MsgUartState -> String
$cshow :: MsgUartState -> String
showsPrec :: Int -> MsgUartState -> ShowS
$cshowsPrec :: Int -> MsgUartState -> ShowS
Show, ReadPrec [MsgUartState]
ReadPrec MsgUartState
Int -> ReadS MsgUartState
ReadS [MsgUartState]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgUartState]
$creadListPrec :: ReadPrec [MsgUartState]
readPrec :: ReadPrec MsgUartState
$creadPrec :: ReadPrec MsgUartState
readList :: ReadS [MsgUartState]
$creadList :: ReadS [MsgUartState]
readsPrec :: Int -> ReadS MsgUartState
$creadsPrec :: Int -> ReadS MsgUartState
Read, MsgUartState -> MsgUartState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgUartState -> MsgUartState -> Bool
$c/= :: MsgUartState -> MsgUartState -> Bool
== :: MsgUartState -> MsgUartState -> Bool
$c== :: MsgUartState -> MsgUartState -> Bool
Eq )

instance Binary MsgUartState where
  get :: Get MsgUartState
get = do
    UARTChannel
_msgUartState_uart_a <- forall t. Binary t => Get t
get
    UARTChannel
_msgUartState_uart_b <- forall t. Binary t => Get t
get
    UARTChannel
_msgUartState_uart_ftdi <- forall t. Binary t => Get t
get
    Latency
_msgUartState_latency <- forall t. Binary t => Get t
get
    Period
_msgUartState_obs_period <- forall t. Binary t => Get t
get
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgUartState {UARTChannel
Period
Latency
_msgUartState_obs_period :: Period
_msgUartState_latency :: Latency
_msgUartState_uart_ftdi :: UARTChannel
_msgUartState_uart_b :: UARTChannel
_msgUartState_uart_a :: UARTChannel
_msgUartState_obs_period :: Period
_msgUartState_latency :: Latency
_msgUartState_uart_ftdi :: UARTChannel
_msgUartState_uart_b :: UARTChannel
_msgUartState_uart_a :: UARTChannel
..}

  put :: MsgUartState -> Put
put MsgUartState {UARTChannel
Period
Latency
_msgUartState_obs_period :: Period
_msgUartState_latency :: Latency
_msgUartState_uart_ftdi :: UARTChannel
_msgUartState_uart_b :: UARTChannel
_msgUartState_uart_a :: UARTChannel
_msgUartState_obs_period :: MsgUartState -> Period
_msgUartState_latency :: MsgUartState -> Latency
_msgUartState_uart_ftdi :: MsgUartState -> UARTChannel
_msgUartState_uart_b :: MsgUartState -> UARTChannel
_msgUartState_uart_a :: MsgUartState -> UARTChannel
..} = do
    forall t. Binary t => t -> Put
put UARTChannel
_msgUartState_uart_a
    forall t. Binary t => t -> Put
put UARTChannel
_msgUartState_uart_b
    forall t. Binary t => t -> Put
put UARTChannel
_msgUartState_uart_ftdi
    forall t. Binary t => t -> Put
put Latency
_msgUartState_latency
    forall t. Binary t => t -> Put
put Period
_msgUartState_obs_period

$(makeSBP 'msgUartState ''MsgUartState)
$(makeJSON "_msgUartState_" ''MsgUartState)
$(makeLenses ''MsgUartState)

msgUartStateDepa :: Word16
msgUartStateDepa :: Word16
msgUartStateDepa = Word16
0x0018

-- | SBP class for message MSG_UART_STATE_DEPA (0x0018).
--
-- Deprecated.
data MsgUartStateDepa = MsgUartStateDepa
  { MsgUartStateDepa -> UARTChannel
_msgUartStateDepa_uart_a  :: !UARTChannel
    -- ^ State of UART A
  , MsgUartStateDepa -> UARTChannel
_msgUartStateDepa_uart_b  :: !UARTChannel
    -- ^ State of UART B
  , MsgUartStateDepa -> UARTChannel
_msgUartStateDepa_uart_ftdi :: !UARTChannel
    -- ^ State of UART FTDI (USB logger)
  , MsgUartStateDepa -> Latency
_msgUartStateDepa_latency :: !Latency
    -- ^ UART communication latency
  } deriving ( Int -> MsgUartStateDepa -> ShowS
[MsgUartStateDepa] -> ShowS
MsgUartStateDepa -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgUartStateDepa] -> ShowS
$cshowList :: [MsgUartStateDepa] -> ShowS
show :: MsgUartStateDepa -> String
$cshow :: MsgUartStateDepa -> String
showsPrec :: Int -> MsgUartStateDepa -> ShowS
$cshowsPrec :: Int -> MsgUartStateDepa -> ShowS
Show, ReadPrec [MsgUartStateDepa]
ReadPrec MsgUartStateDepa
Int -> ReadS MsgUartStateDepa
ReadS [MsgUartStateDepa]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgUartStateDepa]
$creadListPrec :: ReadPrec [MsgUartStateDepa]
readPrec :: ReadPrec MsgUartStateDepa
$creadPrec :: ReadPrec MsgUartStateDepa
readList :: ReadS [MsgUartStateDepa]
$creadList :: ReadS [MsgUartStateDepa]
readsPrec :: Int -> ReadS MsgUartStateDepa
$creadsPrec :: Int -> ReadS MsgUartStateDepa
Read, MsgUartStateDepa -> MsgUartStateDepa -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgUartStateDepa -> MsgUartStateDepa -> Bool
$c/= :: MsgUartStateDepa -> MsgUartStateDepa -> Bool
== :: MsgUartStateDepa -> MsgUartStateDepa -> Bool
$c== :: MsgUartStateDepa -> MsgUartStateDepa -> Bool
Eq )

instance Binary MsgUartStateDepa where
  get :: Get MsgUartStateDepa
get = do
    UARTChannel
_msgUartStateDepa_uart_a <- forall t. Binary t => Get t
get
    UARTChannel
_msgUartStateDepa_uart_b <- forall t. Binary t => Get t
get
    UARTChannel
_msgUartStateDepa_uart_ftdi <- forall t. Binary t => Get t
get
    Latency
_msgUartStateDepa_latency <- forall t. Binary t => Get t
get
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgUartStateDepa {UARTChannel
Latency
_msgUartStateDepa_latency :: Latency
_msgUartStateDepa_uart_ftdi :: UARTChannel
_msgUartStateDepa_uart_b :: UARTChannel
_msgUartStateDepa_uart_a :: UARTChannel
_msgUartStateDepa_latency :: Latency
_msgUartStateDepa_uart_ftdi :: UARTChannel
_msgUartStateDepa_uart_b :: UARTChannel
_msgUartStateDepa_uart_a :: UARTChannel
..}

  put :: MsgUartStateDepa -> Put
put MsgUartStateDepa {UARTChannel
Latency
_msgUartStateDepa_latency :: Latency
_msgUartStateDepa_uart_ftdi :: UARTChannel
_msgUartStateDepa_uart_b :: UARTChannel
_msgUartStateDepa_uart_a :: UARTChannel
_msgUartStateDepa_latency :: MsgUartStateDepa -> Latency
_msgUartStateDepa_uart_ftdi :: MsgUartStateDepa -> UARTChannel
_msgUartStateDepa_uart_b :: MsgUartStateDepa -> UARTChannel
_msgUartStateDepa_uart_a :: MsgUartStateDepa -> UARTChannel
..} = do
    forall t. Binary t => t -> Put
put UARTChannel
_msgUartStateDepa_uart_a
    forall t. Binary t => t -> Put
put UARTChannel
_msgUartStateDepa_uart_b
    forall t. Binary t => t -> Put
put UARTChannel
_msgUartStateDepa_uart_ftdi
    forall t. Binary t => t -> Put
put Latency
_msgUartStateDepa_latency

$(makeSBP 'msgUartStateDepa ''MsgUartStateDepa)
$(makeJSON "_msgUartStateDepa_" ''MsgUartStateDepa)
$(makeLenses ''MsgUartStateDepa)

msgIarState :: Word16
msgIarState :: Word16
msgIarState = Word16
0x0019

-- | SBP class for message MSG_IAR_STATE (0x0019).
--
-- This message reports the state of the Integer Ambiguity Resolution (IAR)
-- process, which resolves unknown integer ambiguities from double-differenced
-- carrier-phase measurements from satellite observations.
data MsgIarState = MsgIarState
  { MsgIarState -> Word32
_msgIarState_num_hyps :: !Word32
    -- ^ Number of integer ambiguity hypotheses remaining
  } deriving ( Int -> MsgIarState -> ShowS
[MsgIarState] -> ShowS
MsgIarState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgIarState] -> ShowS
$cshowList :: [MsgIarState] -> ShowS
show :: MsgIarState -> String
$cshow :: MsgIarState -> String
showsPrec :: Int -> MsgIarState -> ShowS
$cshowsPrec :: Int -> MsgIarState -> ShowS
Show, ReadPrec [MsgIarState]
ReadPrec MsgIarState
Int -> ReadS MsgIarState
ReadS [MsgIarState]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgIarState]
$creadListPrec :: ReadPrec [MsgIarState]
readPrec :: ReadPrec MsgIarState
$creadPrec :: ReadPrec MsgIarState
readList :: ReadS [MsgIarState]
$creadList :: ReadS [MsgIarState]
readsPrec :: Int -> ReadS MsgIarState
$creadsPrec :: Int -> ReadS MsgIarState
Read, MsgIarState -> MsgIarState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgIarState -> MsgIarState -> Bool
$c/= :: MsgIarState -> MsgIarState -> Bool
== :: MsgIarState -> MsgIarState -> Bool
$c== :: MsgIarState -> MsgIarState -> Bool
Eq )

instance Binary MsgIarState where
  get :: Get MsgIarState
get = do
    Word32
_msgIarState_num_hyps <- Get Word32
getWord32le
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgIarState {Word32
_msgIarState_num_hyps :: Word32
_msgIarState_num_hyps :: Word32
..}

  put :: MsgIarState -> Put
put MsgIarState {Word32
_msgIarState_num_hyps :: Word32
_msgIarState_num_hyps :: MsgIarState -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgIarState_num_hyps

$(makeSBP 'msgIarState ''MsgIarState)
$(makeJSON "_msgIarState_" ''MsgIarState)
$(makeLenses ''MsgIarState)

msgMaskSatellite :: Word16
msgMaskSatellite :: Word16
msgMaskSatellite = Word16
0x002B

-- | SBP class for message MSG_MASK_SATELLITE (0x002B).
--
-- This message allows setting a mask to prevent a particular satellite from
-- being used in various Piksi subsystems.
data MsgMaskSatellite = MsgMaskSatellite
  { MsgMaskSatellite -> Word8
_msgMaskSatellite_mask :: !Word8
    -- ^ Mask of systems that should ignore this satellite.
  , MsgMaskSatellite -> GnssSignal
_msgMaskSatellite_sid :: !GnssSignal
    -- ^ GNSS signal for which the mask is applied
  } deriving ( Int -> MsgMaskSatellite -> ShowS
[MsgMaskSatellite] -> ShowS
MsgMaskSatellite -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgMaskSatellite] -> ShowS
$cshowList :: [MsgMaskSatellite] -> ShowS
show :: MsgMaskSatellite -> String
$cshow :: MsgMaskSatellite -> String
showsPrec :: Int -> MsgMaskSatellite -> ShowS
$cshowsPrec :: Int -> MsgMaskSatellite -> ShowS
Show, ReadPrec [MsgMaskSatellite]
ReadPrec MsgMaskSatellite
Int -> ReadS MsgMaskSatellite
ReadS [MsgMaskSatellite]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgMaskSatellite]
$creadListPrec :: ReadPrec [MsgMaskSatellite]
readPrec :: ReadPrec MsgMaskSatellite
$creadPrec :: ReadPrec MsgMaskSatellite
readList :: ReadS [MsgMaskSatellite]
$creadList :: ReadS [MsgMaskSatellite]
readsPrec :: Int -> ReadS MsgMaskSatellite
$creadsPrec :: Int -> ReadS MsgMaskSatellite
Read, MsgMaskSatellite -> MsgMaskSatellite -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgMaskSatellite -> MsgMaskSatellite -> Bool
$c/= :: MsgMaskSatellite -> MsgMaskSatellite -> Bool
== :: MsgMaskSatellite -> MsgMaskSatellite -> Bool
$c== :: MsgMaskSatellite -> MsgMaskSatellite -> Bool
Eq )

instance Binary MsgMaskSatellite where
  get :: Get MsgMaskSatellite
get = do
    Word8
_msgMaskSatellite_mask <- Get Word8
getWord8
    GnssSignal
_msgMaskSatellite_sid <- forall t. Binary t => Get t
get
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgMaskSatellite {Word8
GnssSignal
_msgMaskSatellite_sid :: GnssSignal
_msgMaskSatellite_mask :: Word8
_msgMaskSatellite_sid :: GnssSignal
_msgMaskSatellite_mask :: Word8
..}

  put :: MsgMaskSatellite -> Put
put MsgMaskSatellite {Word8
GnssSignal
_msgMaskSatellite_sid :: GnssSignal
_msgMaskSatellite_mask :: Word8
_msgMaskSatellite_sid :: MsgMaskSatellite -> GnssSignal
_msgMaskSatellite_mask :: MsgMaskSatellite -> Word8
..} = do
    Word8 -> Put
putWord8 Word8
_msgMaskSatellite_mask
    forall t. Binary t => t -> Put
put GnssSignal
_msgMaskSatellite_sid

$(makeSBP 'msgMaskSatellite ''MsgMaskSatellite)
$(makeJSON "_msgMaskSatellite_" ''MsgMaskSatellite)
$(makeLenses ''MsgMaskSatellite)

msgMaskSatelliteDep :: Word16
msgMaskSatelliteDep :: Word16
msgMaskSatelliteDep = Word16
0x001B

-- | SBP class for message MSG_MASK_SATELLITE_DEP (0x001B).
--
-- Deprecated.
data MsgMaskSatelliteDep = MsgMaskSatelliteDep
  { MsgMaskSatelliteDep -> Word8
_msgMaskSatelliteDep_mask :: !Word8
    -- ^ Mask of systems that should ignore this satellite.
  , MsgMaskSatelliteDep -> GnssSignalDep
_msgMaskSatelliteDep_sid :: !GnssSignalDep
    -- ^ GNSS signal for which the mask is applied
  } deriving ( Int -> MsgMaskSatelliteDep -> ShowS
[MsgMaskSatelliteDep] -> ShowS
MsgMaskSatelliteDep -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgMaskSatelliteDep] -> ShowS
$cshowList :: [MsgMaskSatelliteDep] -> ShowS
show :: MsgMaskSatelliteDep -> String
$cshow :: MsgMaskSatelliteDep -> String
showsPrec :: Int -> MsgMaskSatelliteDep -> ShowS
$cshowsPrec :: Int -> MsgMaskSatelliteDep -> ShowS
Show, ReadPrec [MsgMaskSatelliteDep]
ReadPrec MsgMaskSatelliteDep
Int -> ReadS MsgMaskSatelliteDep
ReadS [MsgMaskSatelliteDep]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgMaskSatelliteDep]
$creadListPrec :: ReadPrec [MsgMaskSatelliteDep]
readPrec :: ReadPrec MsgMaskSatelliteDep
$creadPrec :: ReadPrec MsgMaskSatelliteDep
readList :: ReadS [MsgMaskSatelliteDep]
$creadList :: ReadS [MsgMaskSatelliteDep]
readsPrec :: Int -> ReadS MsgMaskSatelliteDep
$creadsPrec :: Int -> ReadS MsgMaskSatelliteDep
Read, MsgMaskSatelliteDep -> MsgMaskSatelliteDep -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgMaskSatelliteDep -> MsgMaskSatelliteDep -> Bool
$c/= :: MsgMaskSatelliteDep -> MsgMaskSatelliteDep -> Bool
== :: MsgMaskSatelliteDep -> MsgMaskSatelliteDep -> Bool
$c== :: MsgMaskSatelliteDep -> MsgMaskSatelliteDep -> Bool
Eq )

instance Binary MsgMaskSatelliteDep where
  get :: Get MsgMaskSatelliteDep
get = do
    Word8
_msgMaskSatelliteDep_mask <- Get Word8
getWord8
    GnssSignalDep
_msgMaskSatelliteDep_sid <- forall t. Binary t => Get t
get
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgMaskSatelliteDep {Word8
GnssSignalDep
_msgMaskSatelliteDep_sid :: GnssSignalDep
_msgMaskSatelliteDep_mask :: Word8
_msgMaskSatelliteDep_sid :: GnssSignalDep
_msgMaskSatelliteDep_mask :: Word8
..}

  put :: MsgMaskSatelliteDep -> Put
put MsgMaskSatelliteDep {Word8
GnssSignalDep
_msgMaskSatelliteDep_sid :: GnssSignalDep
_msgMaskSatelliteDep_mask :: Word8
_msgMaskSatelliteDep_sid :: MsgMaskSatelliteDep -> GnssSignalDep
_msgMaskSatelliteDep_mask :: MsgMaskSatelliteDep -> Word8
..} = do
    Word8 -> Put
putWord8 Word8
_msgMaskSatelliteDep_mask
    forall t. Binary t => t -> Put
put GnssSignalDep
_msgMaskSatelliteDep_sid

$(makeSBP 'msgMaskSatelliteDep ''MsgMaskSatelliteDep)
$(makeJSON "_msgMaskSatelliteDep_" ''MsgMaskSatelliteDep)
$(makeLenses ''MsgMaskSatelliteDep)

msgDeviceMonitor :: Word16
msgDeviceMonitor :: Word16
msgDeviceMonitor = Word16
0x00B5

-- | SBP class for message MSG_DEVICE_MONITOR (0x00B5).
--
-- This message contains temperature and voltage level measurements from the
-- processor's monitoring system and the RF frontend die temperature if
-- available.
data MsgDeviceMonitor = MsgDeviceMonitor
  { MsgDeviceMonitor -> Int16
_msgDeviceMonitor_dev_vin       :: !Int16
    -- ^ Device V_in
  , MsgDeviceMonitor -> Int16
_msgDeviceMonitor_cpu_vint      :: !Int16
    -- ^ Processor V_int
  , MsgDeviceMonitor -> Int16
_msgDeviceMonitor_cpu_vaux      :: !Int16
    -- ^ Processor V_aux
  , MsgDeviceMonitor -> Int16
_msgDeviceMonitor_cpu_temperature :: !Int16
    -- ^ Processor temperature
  , MsgDeviceMonitor -> Int16
_msgDeviceMonitor_fe_temperature :: !Int16
    -- ^ Frontend temperature (if available)
  } deriving ( Int -> MsgDeviceMonitor -> ShowS
[MsgDeviceMonitor] -> ShowS
MsgDeviceMonitor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgDeviceMonitor] -> ShowS
$cshowList :: [MsgDeviceMonitor] -> ShowS
show :: MsgDeviceMonitor -> String
$cshow :: MsgDeviceMonitor -> String
showsPrec :: Int -> MsgDeviceMonitor -> ShowS
$cshowsPrec :: Int -> MsgDeviceMonitor -> ShowS
Show, ReadPrec [MsgDeviceMonitor]
ReadPrec MsgDeviceMonitor
Int -> ReadS MsgDeviceMonitor
ReadS [MsgDeviceMonitor]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgDeviceMonitor]
$creadListPrec :: ReadPrec [MsgDeviceMonitor]
readPrec :: ReadPrec MsgDeviceMonitor
$creadPrec :: ReadPrec MsgDeviceMonitor
readList :: ReadS [MsgDeviceMonitor]
$creadList :: ReadS [MsgDeviceMonitor]
readsPrec :: Int -> ReadS MsgDeviceMonitor
$creadsPrec :: Int -> ReadS MsgDeviceMonitor
Read, MsgDeviceMonitor -> MsgDeviceMonitor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgDeviceMonitor -> MsgDeviceMonitor -> Bool
$c/= :: MsgDeviceMonitor -> MsgDeviceMonitor -> Bool
== :: MsgDeviceMonitor -> MsgDeviceMonitor -> Bool
$c== :: MsgDeviceMonitor -> MsgDeviceMonitor -> Bool
Eq )

instance Binary MsgDeviceMonitor where
  get :: Get MsgDeviceMonitor
get = do
    Int16
_msgDeviceMonitor_dev_vin <- (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le)
    Int16
_msgDeviceMonitor_cpu_vint <- (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le)
    Int16
_msgDeviceMonitor_cpu_vaux <- (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le)
    Int16
_msgDeviceMonitor_cpu_temperature <- (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le)
    Int16
_msgDeviceMonitor_fe_temperature <- (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgDeviceMonitor {Int16
_msgDeviceMonitor_fe_temperature :: Int16
_msgDeviceMonitor_cpu_temperature :: Int16
_msgDeviceMonitor_cpu_vaux :: Int16
_msgDeviceMonitor_cpu_vint :: Int16
_msgDeviceMonitor_dev_vin :: Int16
_msgDeviceMonitor_fe_temperature :: Int16
_msgDeviceMonitor_cpu_temperature :: Int16
_msgDeviceMonitor_cpu_vaux :: Int16
_msgDeviceMonitor_cpu_vint :: Int16
_msgDeviceMonitor_dev_vin :: Int16
..}

  put :: MsgDeviceMonitor -> Put
put MsgDeviceMonitor {Int16
_msgDeviceMonitor_fe_temperature :: Int16
_msgDeviceMonitor_cpu_temperature :: Int16
_msgDeviceMonitor_cpu_vaux :: Int16
_msgDeviceMonitor_cpu_vint :: Int16
_msgDeviceMonitor_dev_vin :: Int16
_msgDeviceMonitor_fe_temperature :: MsgDeviceMonitor -> Int16
_msgDeviceMonitor_cpu_temperature :: MsgDeviceMonitor -> Int16
_msgDeviceMonitor_cpu_vaux :: MsgDeviceMonitor -> Int16
_msgDeviceMonitor_cpu_vint :: MsgDeviceMonitor -> Int16
_msgDeviceMonitor_dev_vin :: MsgDeviceMonitor -> Int16
..} = do
    (Word16 -> Put
putWord16le forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) Int16
_msgDeviceMonitor_dev_vin
    (Word16 -> Put
putWord16le forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) Int16
_msgDeviceMonitor_cpu_vint
    (Word16 -> Put
putWord16le forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) Int16
_msgDeviceMonitor_cpu_vaux
    (Word16 -> Put
putWord16le forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) Int16
_msgDeviceMonitor_cpu_temperature
    (Word16 -> Put
putWord16le forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) Int16
_msgDeviceMonitor_fe_temperature

$(makeSBP 'msgDeviceMonitor ''MsgDeviceMonitor)
$(makeJSON "_msgDeviceMonitor_" ''MsgDeviceMonitor)
$(makeLenses ''MsgDeviceMonitor)

msgCommandReq :: Word16
msgCommandReq :: Word16
msgCommandReq = Word16
0x00B8

-- | SBP class for message MSG_COMMAND_REQ (0x00B8).
--
-- Request the recipient to execute an command. Output will be sent in MSG_LOG
-- messages, and the exit code will be returned with MSG_COMMAND_RESP.
data MsgCommandReq = MsgCommandReq
  { MsgCommandReq -> Word32
_msgCommandReq_sequence :: !Word32
    -- ^ Sequence number
  , MsgCommandReq -> Text
_msgCommandReq_command :: !Text
    -- ^ Command line to execute
  } deriving ( Int -> MsgCommandReq -> ShowS
[MsgCommandReq] -> ShowS
MsgCommandReq -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgCommandReq] -> ShowS
$cshowList :: [MsgCommandReq] -> ShowS
show :: MsgCommandReq -> String
$cshow :: MsgCommandReq -> String
showsPrec :: Int -> MsgCommandReq -> ShowS
$cshowsPrec :: Int -> MsgCommandReq -> ShowS
Show, ReadPrec [MsgCommandReq]
ReadPrec MsgCommandReq
Int -> ReadS MsgCommandReq
ReadS [MsgCommandReq]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgCommandReq]
$creadListPrec :: ReadPrec [MsgCommandReq]
readPrec :: ReadPrec MsgCommandReq
$creadPrec :: ReadPrec MsgCommandReq
readList :: ReadS [MsgCommandReq]
$creadList :: ReadS [MsgCommandReq]
readsPrec :: Int -> ReadS MsgCommandReq
$creadsPrec :: Int -> ReadS MsgCommandReq
Read, MsgCommandReq -> MsgCommandReq -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgCommandReq -> MsgCommandReq -> Bool
$c/= :: MsgCommandReq -> MsgCommandReq -> Bool
== :: MsgCommandReq -> MsgCommandReq -> Bool
$c== :: MsgCommandReq -> MsgCommandReq -> Bool
Eq )

instance Binary MsgCommandReq where
  get :: Get MsgCommandReq
get = do
    Word32
_msgCommandReq_sequence <- Get Word32
getWord32le
    Text
_msgCommandReq_command <- ByteString -> Text
decodeUtf8 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> ByteString
toStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getRemainingLazyByteString
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgCommandReq {Word32
Text
_msgCommandReq_command :: Text
_msgCommandReq_sequence :: Word32
_msgCommandReq_command :: Text
_msgCommandReq_sequence :: Word32
..}

  put :: MsgCommandReq -> Put
put MsgCommandReq {Word32
Text
_msgCommandReq_command :: Text
_msgCommandReq_sequence :: Word32
_msgCommandReq_command :: MsgCommandReq -> Text
_msgCommandReq_sequence :: MsgCommandReq -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgCommandReq_sequence
    ByteString -> Put
putByteString forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
_msgCommandReq_command

$(makeSBP 'msgCommandReq ''MsgCommandReq)
$(makeJSON "_msgCommandReq_" ''MsgCommandReq)
$(makeLenses ''MsgCommandReq)

msgCommandResp :: Word16
msgCommandResp :: Word16
msgCommandResp = Word16
0x00B9

-- | SBP class for message MSG_COMMAND_RESP (0x00B9).
--
-- The response to MSG_COMMAND_REQ with the return code of the command.  A
-- return code of zero indicates success.
data MsgCommandResp = MsgCommandResp
  { MsgCommandResp -> Word32
_msgCommandResp_sequence :: !Word32
    -- ^ Sequence number
  , MsgCommandResp -> Int32
_msgCommandResp_code   :: !Int32
    -- ^ Exit code
  } deriving ( Int -> MsgCommandResp -> ShowS
[MsgCommandResp] -> ShowS
MsgCommandResp -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgCommandResp] -> ShowS
$cshowList :: [MsgCommandResp] -> ShowS
show :: MsgCommandResp -> String
$cshow :: MsgCommandResp -> String
showsPrec :: Int -> MsgCommandResp -> ShowS
$cshowsPrec :: Int -> MsgCommandResp -> ShowS
Show, ReadPrec [MsgCommandResp]
ReadPrec MsgCommandResp
Int -> ReadS MsgCommandResp
ReadS [MsgCommandResp]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgCommandResp]
$creadListPrec :: ReadPrec [MsgCommandResp]
readPrec :: ReadPrec MsgCommandResp
$creadPrec :: ReadPrec MsgCommandResp
readList :: ReadS [MsgCommandResp]
$creadList :: ReadS [MsgCommandResp]
readsPrec :: Int -> ReadS MsgCommandResp
$creadsPrec :: Int -> ReadS MsgCommandResp
Read, MsgCommandResp -> MsgCommandResp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgCommandResp -> MsgCommandResp -> Bool
$c/= :: MsgCommandResp -> MsgCommandResp -> Bool
== :: MsgCommandResp -> MsgCommandResp -> Bool
$c== :: MsgCommandResp -> MsgCommandResp -> Bool
Eq )

instance Binary MsgCommandResp where
  get :: Get MsgCommandResp
get = do
    Word32
_msgCommandResp_sequence <- Get Word32
getWord32le
    Int32
_msgCommandResp_code <- (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgCommandResp {Int32
Word32
_msgCommandResp_code :: Int32
_msgCommandResp_sequence :: Word32
_msgCommandResp_code :: Int32
_msgCommandResp_sequence :: Word32
..}

  put :: MsgCommandResp -> Put
put MsgCommandResp {Int32
Word32
_msgCommandResp_code :: Int32
_msgCommandResp_sequence :: Word32
_msgCommandResp_code :: MsgCommandResp -> Int32
_msgCommandResp_sequence :: MsgCommandResp -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgCommandResp_sequence
    (Word32 -> Put
putWord32le forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) Int32
_msgCommandResp_code

$(makeSBP 'msgCommandResp ''MsgCommandResp)
$(makeJSON "_msgCommandResp_" ''MsgCommandResp)
$(makeLenses ''MsgCommandResp)

msgCommandOutput :: Word16
msgCommandOutput :: Word16
msgCommandOutput = Word16
0x00BC

-- | SBP class for message MSG_COMMAND_OUTPUT (0x00BC).
--
-- Returns the standard output and standard error of the command requested by
-- MSG_COMMAND_REQ. The sequence number can be used to filter for filtering
-- the correct command.
data MsgCommandOutput = MsgCommandOutput
  { MsgCommandOutput -> Word32
_msgCommandOutput_sequence :: !Word32
    -- ^ Sequence number
  , MsgCommandOutput -> Text
_msgCommandOutput_line   :: !Text
    -- ^ Line of standard output or standard error
  } deriving ( Int -> MsgCommandOutput -> ShowS
[MsgCommandOutput] -> ShowS
MsgCommandOutput -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgCommandOutput] -> ShowS
$cshowList :: [MsgCommandOutput] -> ShowS
show :: MsgCommandOutput -> String
$cshow :: MsgCommandOutput -> String
showsPrec :: Int -> MsgCommandOutput -> ShowS
$cshowsPrec :: Int -> MsgCommandOutput -> ShowS
Show, ReadPrec [MsgCommandOutput]
ReadPrec MsgCommandOutput
Int -> ReadS MsgCommandOutput
ReadS [MsgCommandOutput]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgCommandOutput]
$creadListPrec :: ReadPrec [MsgCommandOutput]
readPrec :: ReadPrec MsgCommandOutput
$creadPrec :: ReadPrec MsgCommandOutput
readList :: ReadS [MsgCommandOutput]
$creadList :: ReadS [MsgCommandOutput]
readsPrec :: Int -> ReadS MsgCommandOutput
$creadsPrec :: Int -> ReadS MsgCommandOutput
Read, MsgCommandOutput -> MsgCommandOutput -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgCommandOutput -> MsgCommandOutput -> Bool
$c/= :: MsgCommandOutput -> MsgCommandOutput -> Bool
== :: MsgCommandOutput -> MsgCommandOutput -> Bool
$c== :: MsgCommandOutput -> MsgCommandOutput -> Bool
Eq )

instance Binary MsgCommandOutput where
  get :: Get MsgCommandOutput
get = do
    Word32
_msgCommandOutput_sequence <- Get Word32
getWord32le
    Text
_msgCommandOutput_line <- ByteString -> Text
decodeUtf8 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> ByteString
toStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getRemainingLazyByteString
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgCommandOutput {Word32
Text
_msgCommandOutput_line :: Text
_msgCommandOutput_sequence :: Word32
_msgCommandOutput_line :: Text
_msgCommandOutput_sequence :: Word32
..}

  put :: MsgCommandOutput -> Put
put MsgCommandOutput {Word32
Text
_msgCommandOutput_line :: Text
_msgCommandOutput_sequence :: Word32
_msgCommandOutput_line :: MsgCommandOutput -> Text
_msgCommandOutput_sequence :: MsgCommandOutput -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgCommandOutput_sequence
    ByteString -> Put
putByteString forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
_msgCommandOutput_line

$(makeSBP 'msgCommandOutput ''MsgCommandOutput)
$(makeJSON "_msgCommandOutput_" ''MsgCommandOutput)
$(makeLenses ''MsgCommandOutput)

msgNetworkStateReq :: Word16
msgNetworkStateReq :: Word16
msgNetworkStateReq = Word16
0x00BA

-- | SBP class for message MSG_NETWORK_STATE_REQ (0x00BA).
--
-- Request state of Piksi network interfaces. Output will be sent in
-- MSG_NETWORK_STATE_RESP messages.
data MsgNetworkStateReq = MsgNetworkStateReq
  deriving ( Int -> MsgNetworkStateReq -> ShowS
[MsgNetworkStateReq] -> ShowS
MsgNetworkStateReq -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgNetworkStateReq] -> ShowS
$cshowList :: [MsgNetworkStateReq] -> ShowS
show :: MsgNetworkStateReq -> String
$cshow :: MsgNetworkStateReq -> String
showsPrec :: Int -> MsgNetworkStateReq -> ShowS
$cshowsPrec :: Int -> MsgNetworkStateReq -> ShowS
Show, ReadPrec [MsgNetworkStateReq]
ReadPrec MsgNetworkStateReq
Int -> ReadS MsgNetworkStateReq
ReadS [MsgNetworkStateReq]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgNetworkStateReq]
$creadListPrec :: ReadPrec [MsgNetworkStateReq]
readPrec :: ReadPrec MsgNetworkStateReq
$creadPrec :: ReadPrec MsgNetworkStateReq
readList :: ReadS [MsgNetworkStateReq]
$creadList :: ReadS [MsgNetworkStateReq]
readsPrec :: Int -> ReadS MsgNetworkStateReq
$creadsPrec :: Int -> ReadS MsgNetworkStateReq
Read, MsgNetworkStateReq -> MsgNetworkStateReq -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgNetworkStateReq -> MsgNetworkStateReq -> Bool
$c/= :: MsgNetworkStateReq -> MsgNetworkStateReq -> Bool
== :: MsgNetworkStateReq -> MsgNetworkStateReq -> Bool
$c== :: MsgNetworkStateReq -> MsgNetworkStateReq -> Bool
Eq )

instance Binary MsgNetworkStateReq where
  get :: Get MsgNetworkStateReq
get =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgNetworkStateReq
MsgNetworkStateReq

  put :: MsgNetworkStateReq -> Put
put MsgNetworkStateReq
MsgNetworkStateReq =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
$(makeSBP 'msgNetworkStateReq ''MsgNetworkStateReq)
$(makeJSON "_msgNetworkStateReq_" ''MsgNetworkStateReq)
$(makeLenses ''MsgNetworkStateReq)

msgNetworkStateResp :: Word16
msgNetworkStateResp :: Word16
msgNetworkStateResp = Word16
0x00BB

-- | SBP class for message MSG_NETWORK_STATE_RESP (0x00BB).
--
-- The state of a network interface on the Piksi. Data is made to reflect
-- output of ifaddrs struct returned by getifaddrs in c.
data MsgNetworkStateResp = MsgNetworkStateResp
  { MsgNetworkStateResp -> [Word8]
_msgNetworkStateResp_ipv4_address :: ![Word8]
    -- ^ IPv4 address (all zero when unavailable)
  , MsgNetworkStateResp -> Word8
_msgNetworkStateResp_ipv4_mask_size :: !Word8
    -- ^ IPv4 netmask CIDR notation
  , MsgNetworkStateResp -> [Word8]
_msgNetworkStateResp_ipv6_address :: ![Word8]
    -- ^ IPv6 address (all zero when unavailable)
  , MsgNetworkStateResp -> Word8
_msgNetworkStateResp_ipv6_mask_size :: !Word8
    -- ^ IPv6 netmask CIDR notation
  , MsgNetworkStateResp -> Word32
_msgNetworkStateResp_rx_bytes     :: !Word32
    -- ^ Number of Rx bytes
  , MsgNetworkStateResp -> Word32
_msgNetworkStateResp_tx_bytes     :: !Word32
    -- ^ Number of Tx bytes
  , MsgNetworkStateResp -> Text
_msgNetworkStateResp_interface_name :: !Text
    -- ^ Interface Name
  , MsgNetworkStateResp -> Word32
_msgNetworkStateResp_flags        :: !Word32
    -- ^ Interface flags from SIOCGIFFLAGS
  } deriving ( Int -> MsgNetworkStateResp -> ShowS
[MsgNetworkStateResp] -> ShowS
MsgNetworkStateResp -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgNetworkStateResp] -> ShowS
$cshowList :: [MsgNetworkStateResp] -> ShowS
show :: MsgNetworkStateResp -> String
$cshow :: MsgNetworkStateResp -> String
showsPrec :: Int -> MsgNetworkStateResp -> ShowS
$cshowsPrec :: Int -> MsgNetworkStateResp -> ShowS
Show, ReadPrec [MsgNetworkStateResp]
ReadPrec MsgNetworkStateResp
Int -> ReadS MsgNetworkStateResp
ReadS [MsgNetworkStateResp]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgNetworkStateResp]
$creadListPrec :: ReadPrec [MsgNetworkStateResp]
readPrec :: ReadPrec MsgNetworkStateResp
$creadPrec :: ReadPrec MsgNetworkStateResp
readList :: ReadS [MsgNetworkStateResp]
$creadList :: ReadS [MsgNetworkStateResp]
readsPrec :: Int -> ReadS MsgNetworkStateResp
$creadsPrec :: Int -> ReadS MsgNetworkStateResp
Read, MsgNetworkStateResp -> MsgNetworkStateResp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgNetworkStateResp -> MsgNetworkStateResp -> Bool
$c/= :: MsgNetworkStateResp -> MsgNetworkStateResp -> Bool
== :: MsgNetworkStateResp -> MsgNetworkStateResp -> Bool
$c== :: MsgNetworkStateResp -> MsgNetworkStateResp -> Bool
Eq )

instance Binary MsgNetworkStateResp where
  get :: Get MsgNetworkStateResp
get = do
    [Word8]
_msgNetworkStateResp_ipv4_address <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
4 Get Word8
getWord8
    Word8
_msgNetworkStateResp_ipv4_mask_size <- Get Word8
getWord8
    [Word8]
_msgNetworkStateResp_ipv6_address <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
16 Get Word8
getWord8
    Word8
_msgNetworkStateResp_ipv6_mask_size <- Get Word8
getWord8
    Word32
_msgNetworkStateResp_rx_bytes <- Get Word32
getWord32le
    Word32
_msgNetworkStateResp_tx_bytes <- Get Word32
getWord32le
    Text
_msgNetworkStateResp_interface_name <- ByteString -> Text
decodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
16
    Word32
_msgNetworkStateResp_flags <- Get Word32
getWord32le
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgNetworkStateResp {[Word8]
Word8
Word32
Text
_msgNetworkStateResp_flags :: Word32
_msgNetworkStateResp_interface_name :: Text
_msgNetworkStateResp_tx_bytes :: Word32
_msgNetworkStateResp_rx_bytes :: Word32
_msgNetworkStateResp_ipv6_mask_size :: Word8
_msgNetworkStateResp_ipv6_address :: [Word8]
_msgNetworkStateResp_ipv4_mask_size :: Word8
_msgNetworkStateResp_ipv4_address :: [Word8]
_msgNetworkStateResp_flags :: Word32
_msgNetworkStateResp_interface_name :: Text
_msgNetworkStateResp_tx_bytes :: Word32
_msgNetworkStateResp_rx_bytes :: Word32
_msgNetworkStateResp_ipv6_mask_size :: Word8
_msgNetworkStateResp_ipv6_address :: [Word8]
_msgNetworkStateResp_ipv4_mask_size :: Word8
_msgNetworkStateResp_ipv4_address :: [Word8]
..}

  put :: MsgNetworkStateResp -> Put
put MsgNetworkStateResp {[Word8]
Word8
Word32
Text
_msgNetworkStateResp_flags :: Word32
_msgNetworkStateResp_interface_name :: Text
_msgNetworkStateResp_tx_bytes :: Word32
_msgNetworkStateResp_rx_bytes :: Word32
_msgNetworkStateResp_ipv6_mask_size :: Word8
_msgNetworkStateResp_ipv6_address :: [Word8]
_msgNetworkStateResp_ipv4_mask_size :: Word8
_msgNetworkStateResp_ipv4_address :: [Word8]
_msgNetworkStateResp_flags :: MsgNetworkStateResp -> Word32
_msgNetworkStateResp_interface_name :: MsgNetworkStateResp -> Text
_msgNetworkStateResp_tx_bytes :: MsgNetworkStateResp -> Word32
_msgNetworkStateResp_rx_bytes :: MsgNetworkStateResp -> Word32
_msgNetworkStateResp_ipv6_mask_size :: MsgNetworkStateResp -> Word8
_msgNetworkStateResp_ipv6_address :: MsgNetworkStateResp -> [Word8]
_msgNetworkStateResp_ipv4_mask_size :: MsgNetworkStateResp -> Word8
_msgNetworkStateResp_ipv4_address :: MsgNetworkStateResp -> [Word8]
..} = do
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
_msgNetworkStateResp_ipv4_address
    Word8 -> Put
putWord8 Word8
_msgNetworkStateResp_ipv4_mask_size
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
_msgNetworkStateResp_ipv6_address
    Word8 -> Put
putWord8 Word8
_msgNetworkStateResp_ipv6_mask_size
    Word32 -> Put
putWord32le Word32
_msgNetworkStateResp_rx_bytes
    Word32 -> Put
putWord32le Word32
_msgNetworkStateResp_tx_bytes
    ByteString -> Put
putByteString forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
_msgNetworkStateResp_interface_name
    Word32 -> Put
putWord32le Word32
_msgNetworkStateResp_flags

$(makeSBP 'msgNetworkStateResp ''MsgNetworkStateResp)
$(makeJSON "_msgNetworkStateResp_" ''MsgNetworkStateResp)
$(makeLenses ''MsgNetworkStateResp)

-- | NetworkUsage.
--
-- The bandwidth usage for each interface can be reported within this struct
-- and utilize multiple fields to fully specify the type of traffic that is
-- being tracked. As either the interval of collection or the collection time
-- may vary, both a timestamp and period field is provided, though may not
-- necessarily be populated with a value.
data NetworkUsage = NetworkUsage
  { NetworkUsage -> Word64
_networkUsage_duration     :: !Word64
    -- ^ Duration over which the measurement was collected
  , NetworkUsage -> Word64
_networkUsage_total_bytes  :: !Word64
    -- ^ Number of bytes handled in total within period
  , NetworkUsage -> Word32
_networkUsage_rx_bytes     :: !Word32
    -- ^ Number of bytes transmitted within period
  , NetworkUsage -> Word32
_networkUsage_tx_bytes     :: !Word32
    -- ^ Number of bytes received within period
  , NetworkUsage -> Text
_networkUsage_interface_name :: !Text
    -- ^ Interface Name
  } deriving ( Int -> NetworkUsage -> ShowS
[NetworkUsage] -> ShowS
NetworkUsage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NetworkUsage] -> ShowS
$cshowList :: [NetworkUsage] -> ShowS
show :: NetworkUsage -> String
$cshow :: NetworkUsage -> String
showsPrec :: Int -> NetworkUsage -> ShowS
$cshowsPrec :: Int -> NetworkUsage -> ShowS
Show, ReadPrec [NetworkUsage]
ReadPrec NetworkUsage
Int -> ReadS NetworkUsage
ReadS [NetworkUsage]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NetworkUsage]
$creadListPrec :: ReadPrec [NetworkUsage]
readPrec :: ReadPrec NetworkUsage
$creadPrec :: ReadPrec NetworkUsage
readList :: ReadS [NetworkUsage]
$creadList :: ReadS [NetworkUsage]
readsPrec :: Int -> ReadS NetworkUsage
$creadsPrec :: Int -> ReadS NetworkUsage
Read, NetworkUsage -> NetworkUsage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NetworkUsage -> NetworkUsage -> Bool
$c/= :: NetworkUsage -> NetworkUsage -> Bool
== :: NetworkUsage -> NetworkUsage -> Bool
$c== :: NetworkUsage -> NetworkUsage -> Bool
Eq )

instance Binary NetworkUsage where
  get :: Get NetworkUsage
get = do
    Word64
_networkUsage_duration <- Get Word64
getWord64le
    Word64
_networkUsage_total_bytes <- Get Word64
getWord64le
    Word32
_networkUsage_rx_bytes <- Get Word32
getWord32le
    Word32
_networkUsage_tx_bytes <- Get Word32
getWord32le
    Text
_networkUsage_interface_name <- ByteString -> Text
decodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
16
    forall (f :: * -> *) a. Applicative f => a -> f a
pure NetworkUsage {Word32
Word64
Text
_networkUsage_interface_name :: Text
_networkUsage_tx_bytes :: Word32
_networkUsage_rx_bytes :: Word32
_networkUsage_total_bytes :: Word64
_networkUsage_duration :: Word64
_networkUsage_interface_name :: Text
_networkUsage_tx_bytes :: Word32
_networkUsage_rx_bytes :: Word32
_networkUsage_total_bytes :: Word64
_networkUsage_duration :: Word64
..}

  put :: NetworkUsage -> Put
put NetworkUsage {Word32
Word64
Text
_networkUsage_interface_name :: Text
_networkUsage_tx_bytes :: Word32
_networkUsage_rx_bytes :: Word32
_networkUsage_total_bytes :: Word64
_networkUsage_duration :: Word64
_networkUsage_interface_name :: NetworkUsage -> Text
_networkUsage_tx_bytes :: NetworkUsage -> Word32
_networkUsage_rx_bytes :: NetworkUsage -> Word32
_networkUsage_total_bytes :: NetworkUsage -> Word64
_networkUsage_duration :: NetworkUsage -> Word64
..} = do
    Word64 -> Put
putWord64le Word64
_networkUsage_duration
    Word64 -> Put
putWord64le Word64
_networkUsage_total_bytes
    Word32 -> Put
putWord32le Word32
_networkUsage_rx_bytes
    Word32 -> Put
putWord32le Word32
_networkUsage_tx_bytes
    ByteString -> Put
putByteString forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
_networkUsage_interface_name

$(makeJSON "_networkUsage_" ''NetworkUsage)
$(makeLenses ''NetworkUsage)

msgNetworkBandwidthUsage :: Word16
msgNetworkBandwidthUsage :: Word16
msgNetworkBandwidthUsage = Word16
0x00BD

-- | SBP class for message MSG_NETWORK_BANDWIDTH_USAGE (0x00BD).
--
-- The bandwidth usage, a list of usage by interface.
data MsgNetworkBandwidthUsage = MsgNetworkBandwidthUsage
  { MsgNetworkBandwidthUsage -> [NetworkUsage]
_msgNetworkBandwidthUsage_interfaces :: ![NetworkUsage]
    -- ^ Usage measurement array
  } deriving ( Int -> MsgNetworkBandwidthUsage -> ShowS
[MsgNetworkBandwidthUsage] -> ShowS
MsgNetworkBandwidthUsage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgNetworkBandwidthUsage] -> ShowS
$cshowList :: [MsgNetworkBandwidthUsage] -> ShowS
show :: MsgNetworkBandwidthUsage -> String
$cshow :: MsgNetworkBandwidthUsage -> String
showsPrec :: Int -> MsgNetworkBandwidthUsage -> ShowS
$cshowsPrec :: Int -> MsgNetworkBandwidthUsage -> ShowS
Show, ReadPrec [MsgNetworkBandwidthUsage]
ReadPrec MsgNetworkBandwidthUsage
Int -> ReadS MsgNetworkBandwidthUsage
ReadS [MsgNetworkBandwidthUsage]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgNetworkBandwidthUsage]
$creadListPrec :: ReadPrec [MsgNetworkBandwidthUsage]
readPrec :: ReadPrec MsgNetworkBandwidthUsage
$creadPrec :: ReadPrec MsgNetworkBandwidthUsage
readList :: ReadS [MsgNetworkBandwidthUsage]
$creadList :: ReadS [MsgNetworkBandwidthUsage]
readsPrec :: Int -> ReadS MsgNetworkBandwidthUsage
$creadsPrec :: Int -> ReadS MsgNetworkBandwidthUsage
Read, MsgNetworkBandwidthUsage -> MsgNetworkBandwidthUsage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgNetworkBandwidthUsage -> MsgNetworkBandwidthUsage -> Bool
$c/= :: MsgNetworkBandwidthUsage -> MsgNetworkBandwidthUsage -> Bool
== :: MsgNetworkBandwidthUsage -> MsgNetworkBandwidthUsage -> Bool
$c== :: MsgNetworkBandwidthUsage -> MsgNetworkBandwidthUsage -> Bool
Eq )

instance Binary MsgNetworkBandwidthUsage where
  get :: Get MsgNetworkBandwidthUsage
get = do
    [NetworkUsage]
_msgNetworkBandwidthUsage_interfaces <- forall (m :: * -> *) a. Monad m => m Bool -> m a -> m [a]
whileM (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool
isEmpty) forall t. Binary t => Get t
get
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgNetworkBandwidthUsage {[NetworkUsage]
_msgNetworkBandwidthUsage_interfaces :: [NetworkUsage]
_msgNetworkBandwidthUsage_interfaces :: [NetworkUsage]
..}

  put :: MsgNetworkBandwidthUsage -> Put
put MsgNetworkBandwidthUsage {[NetworkUsage]
_msgNetworkBandwidthUsage_interfaces :: [NetworkUsage]
_msgNetworkBandwidthUsage_interfaces :: MsgNetworkBandwidthUsage -> [NetworkUsage]
..} = do
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall t. Binary t => t -> Put
put [NetworkUsage]
_msgNetworkBandwidthUsage_interfaces

$(makeSBP 'msgNetworkBandwidthUsage ''MsgNetworkBandwidthUsage)
$(makeJSON "_msgNetworkBandwidthUsage_" ''MsgNetworkBandwidthUsage)
$(makeLenses ''MsgNetworkBandwidthUsage)

msgCellModemStatus :: Word16
msgCellModemStatus :: Word16
msgCellModemStatus = Word16
0x00BE

-- | SBP class for message MSG_CELL_MODEM_STATUS (0x00BE).
--
-- If a cell modem is present on a piksi device, this message will be send
-- periodically to update the host on the status of the modem and its various
-- parameters.
data MsgCellModemStatus = MsgCellModemStatus
  { MsgCellModemStatus -> Int8
_msgCellModemStatus_signal_strength :: !Int8
    -- ^ Received cell signal strength in dBm, zero translates to unknown
  , MsgCellModemStatus -> Float
_msgCellModemStatus_signal_error_rate :: !Float
    -- ^ BER as reported by the modem, zero translates to unknown
  , MsgCellModemStatus -> [Word8]
_msgCellModemStatus_reserved        :: ![Word8]
    -- ^ Unspecified data TBD for this schema
  } deriving ( Int -> MsgCellModemStatus -> ShowS
[MsgCellModemStatus] -> ShowS
MsgCellModemStatus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgCellModemStatus] -> ShowS
$cshowList :: [MsgCellModemStatus] -> ShowS
show :: MsgCellModemStatus -> String
$cshow :: MsgCellModemStatus -> String
showsPrec :: Int -> MsgCellModemStatus -> ShowS
$cshowsPrec :: Int -> MsgCellModemStatus -> ShowS
Show, ReadPrec [MsgCellModemStatus]
ReadPrec MsgCellModemStatus
Int -> ReadS MsgCellModemStatus
ReadS [MsgCellModemStatus]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgCellModemStatus]
$creadListPrec :: ReadPrec [MsgCellModemStatus]
readPrec :: ReadPrec MsgCellModemStatus
$creadPrec :: ReadPrec MsgCellModemStatus
readList :: ReadS [MsgCellModemStatus]
$creadList :: ReadS [MsgCellModemStatus]
readsPrec :: Int -> ReadS MsgCellModemStatus
$creadsPrec :: Int -> ReadS MsgCellModemStatus
Read, MsgCellModemStatus -> MsgCellModemStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgCellModemStatus -> MsgCellModemStatus -> Bool
$c/= :: MsgCellModemStatus -> MsgCellModemStatus -> Bool
== :: MsgCellModemStatus -> MsgCellModemStatus -> Bool
$c== :: MsgCellModemStatus -> MsgCellModemStatus -> Bool
Eq )

instance Binary MsgCellModemStatus where
  get :: Get MsgCellModemStatus
get = do
    Int8
_msgCellModemStatus_signal_strength <- (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8)
    Float
_msgCellModemStatus_signal_error_rate <- Get Float
getFloat32le
    [Word8]
_msgCellModemStatus_reserved <- forall (m :: * -> *) a. Monad m => m Bool -> m a -> m [a]
whileM (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool
isEmpty) Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgCellModemStatus {Float
Int8
[Word8]
_msgCellModemStatus_reserved :: [Word8]
_msgCellModemStatus_signal_error_rate :: Float
_msgCellModemStatus_signal_strength :: Int8
_msgCellModemStatus_reserved :: [Word8]
_msgCellModemStatus_signal_error_rate :: Float
_msgCellModemStatus_signal_strength :: Int8
..}

  put :: MsgCellModemStatus -> Put
put MsgCellModemStatus {Float
Int8
[Word8]
_msgCellModemStatus_reserved :: [Word8]
_msgCellModemStatus_signal_error_rate :: Float
_msgCellModemStatus_signal_strength :: Int8
_msgCellModemStatus_reserved :: MsgCellModemStatus -> [Word8]
_msgCellModemStatus_signal_error_rate :: MsgCellModemStatus -> Float
_msgCellModemStatus_signal_strength :: MsgCellModemStatus -> Int8
..} = do
    (Word8 -> Put
putWord8 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) Int8
_msgCellModemStatus_signal_strength
    Float -> Put
putFloat32le Float
_msgCellModemStatus_signal_error_rate
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
_msgCellModemStatus_reserved

$(makeSBP 'msgCellModemStatus ''MsgCellModemStatus)
$(makeJSON "_msgCellModemStatus_" ''MsgCellModemStatus)
$(makeLenses ''MsgCellModemStatus)

msgSpecanDep :: Word16
msgSpecanDep :: Word16
msgSpecanDep = Word16
0x0050

-- | SBP class for message MSG_SPECAN_DEP (0x0050).
--
-- Deprecated.
data MsgSpecanDep = MsgSpecanDep
  { MsgSpecanDep -> Word16
_msgSpecanDep_channel_tag   :: !Word16
    -- ^ Channel ID
  , MsgSpecanDep -> GpsTimeDep
_msgSpecanDep_t             :: !GpsTimeDep
    -- ^ Receiver time of this observation
  , MsgSpecanDep -> Float
_msgSpecanDep_freq_ref      :: !Float
    -- ^ Reference frequency of this packet
  , MsgSpecanDep -> Float
_msgSpecanDep_freq_step     :: !Float
    -- ^ Frequency step of points in this packet
  , MsgSpecanDep -> Float
_msgSpecanDep_amplitude_ref :: !Float
    -- ^ Reference amplitude of this packet
  , MsgSpecanDep -> Float
_msgSpecanDep_amplitude_unit :: !Float
    -- ^ Amplitude unit value of points in this packet
  , MsgSpecanDep -> [Word8]
_msgSpecanDep_amplitude_value :: ![Word8]
    -- ^ Amplitude values (in the above units) of points in this packet
  } deriving ( Int -> MsgSpecanDep -> ShowS
[MsgSpecanDep] -> ShowS
MsgSpecanDep -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgSpecanDep] -> ShowS
$cshowList :: [MsgSpecanDep] -> ShowS
show :: MsgSpecanDep -> String
$cshow :: MsgSpecanDep -> String
showsPrec :: Int -> MsgSpecanDep -> ShowS
$cshowsPrec :: Int -> MsgSpecanDep -> ShowS
Show, ReadPrec [MsgSpecanDep]
ReadPrec MsgSpecanDep
Int -> ReadS MsgSpecanDep
ReadS [MsgSpecanDep]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgSpecanDep]
$creadListPrec :: ReadPrec [MsgSpecanDep]
readPrec :: ReadPrec MsgSpecanDep
$creadPrec :: ReadPrec MsgSpecanDep
readList :: ReadS [MsgSpecanDep]
$creadList :: ReadS [MsgSpecanDep]
readsPrec :: Int -> ReadS MsgSpecanDep
$creadsPrec :: Int -> ReadS MsgSpecanDep
Read, MsgSpecanDep -> MsgSpecanDep -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgSpecanDep -> MsgSpecanDep -> Bool
$c/= :: MsgSpecanDep -> MsgSpecanDep -> Bool
== :: MsgSpecanDep -> MsgSpecanDep -> Bool
$c== :: MsgSpecanDep -> MsgSpecanDep -> Bool
Eq )

instance Binary MsgSpecanDep where
  get :: Get MsgSpecanDep
get = do
    Word16
_msgSpecanDep_channel_tag <- Get Word16
getWord16le
    GpsTimeDep
_msgSpecanDep_t <- forall t. Binary t => Get t
get
    Float
_msgSpecanDep_freq_ref <- Get Float
getFloat32le
    Float
_msgSpecanDep_freq_step <- Get Float
getFloat32le
    Float
_msgSpecanDep_amplitude_ref <- Get Float
getFloat32le
    Float
_msgSpecanDep_amplitude_unit <- Get Float
getFloat32le
    [Word8]
_msgSpecanDep_amplitude_value <- forall (m :: * -> *) a. Monad m => m Bool -> m a -> m [a]
whileM (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool
isEmpty) Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgSpecanDep {Float
[Word8]
Word16
GpsTimeDep
_msgSpecanDep_amplitude_value :: [Word8]
_msgSpecanDep_amplitude_unit :: Float
_msgSpecanDep_amplitude_ref :: Float
_msgSpecanDep_freq_step :: Float
_msgSpecanDep_freq_ref :: Float
_msgSpecanDep_t :: GpsTimeDep
_msgSpecanDep_channel_tag :: Word16
_msgSpecanDep_amplitude_value :: [Word8]
_msgSpecanDep_amplitude_unit :: Float
_msgSpecanDep_amplitude_ref :: Float
_msgSpecanDep_freq_step :: Float
_msgSpecanDep_freq_ref :: Float
_msgSpecanDep_t :: GpsTimeDep
_msgSpecanDep_channel_tag :: Word16
..}

  put :: MsgSpecanDep -> Put
put MsgSpecanDep {Float
[Word8]
Word16
GpsTimeDep
_msgSpecanDep_amplitude_value :: [Word8]
_msgSpecanDep_amplitude_unit :: Float
_msgSpecanDep_amplitude_ref :: Float
_msgSpecanDep_freq_step :: Float
_msgSpecanDep_freq_ref :: Float
_msgSpecanDep_t :: GpsTimeDep
_msgSpecanDep_channel_tag :: Word16
_msgSpecanDep_amplitude_value :: MsgSpecanDep -> [Word8]
_msgSpecanDep_amplitude_unit :: MsgSpecanDep -> Float
_msgSpecanDep_amplitude_ref :: MsgSpecanDep -> Float
_msgSpecanDep_freq_step :: MsgSpecanDep -> Float
_msgSpecanDep_freq_ref :: MsgSpecanDep -> Float
_msgSpecanDep_t :: MsgSpecanDep -> GpsTimeDep
_msgSpecanDep_channel_tag :: MsgSpecanDep -> Word16
..} = do
    Word16 -> Put
putWord16le Word16
_msgSpecanDep_channel_tag
    forall t. Binary t => t -> Put
put GpsTimeDep
_msgSpecanDep_t
    Float -> Put
putFloat32le Float
_msgSpecanDep_freq_ref
    Float -> Put
putFloat32le Float
_msgSpecanDep_freq_step
    Float -> Put
putFloat32le Float
_msgSpecanDep_amplitude_ref
    Float -> Put
putFloat32le Float
_msgSpecanDep_amplitude_unit
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
_msgSpecanDep_amplitude_value

$(makeSBP 'msgSpecanDep ''MsgSpecanDep)
$(makeJSON "_msgSpecanDep_" ''MsgSpecanDep)
$(makeLenses ''MsgSpecanDep)

msgSpecan :: Word16
msgSpecan :: Word16
msgSpecan = Word16
0x0051

-- | SBP class for message MSG_SPECAN (0x0051).
--
-- Spectrum analyzer packet.
data MsgSpecan = MsgSpecan
  { MsgSpecan -> Word16
_msgSpecan_channel_tag   :: !Word16
    -- ^ Channel ID
  , MsgSpecan -> GpsTime
_msgSpecan_t             :: !GpsTime
    -- ^ Receiver time of this observation
  , MsgSpecan -> Float
_msgSpecan_freq_ref      :: !Float
    -- ^ Reference frequency of this packet
  , MsgSpecan -> Float
_msgSpecan_freq_step     :: !Float
    -- ^ Frequency step of points in this packet
  , MsgSpecan -> Float
_msgSpecan_amplitude_ref :: !Float
    -- ^ Reference amplitude of this packet
  , MsgSpecan -> Float
_msgSpecan_amplitude_unit :: !Float
    -- ^ Amplitude unit value of points in this packet
  , MsgSpecan -> [Word8]
_msgSpecan_amplitude_value :: ![Word8]
    -- ^ Amplitude values (in the above units) of points in this packet
  } deriving ( Int -> MsgSpecan -> ShowS
[MsgSpecan] -> ShowS
MsgSpecan -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgSpecan] -> ShowS
$cshowList :: [MsgSpecan] -> ShowS
show :: MsgSpecan -> String
$cshow :: MsgSpecan -> String
showsPrec :: Int -> MsgSpecan -> ShowS
$cshowsPrec :: Int -> MsgSpecan -> ShowS
Show, ReadPrec [MsgSpecan]
ReadPrec MsgSpecan
Int -> ReadS MsgSpecan
ReadS [MsgSpecan]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgSpecan]
$creadListPrec :: ReadPrec [MsgSpecan]
readPrec :: ReadPrec MsgSpecan
$creadPrec :: ReadPrec MsgSpecan
readList :: ReadS [MsgSpecan]
$creadList :: ReadS [MsgSpecan]
readsPrec :: Int -> ReadS MsgSpecan
$creadsPrec :: Int -> ReadS MsgSpecan
Read, MsgSpecan -> MsgSpecan -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgSpecan -> MsgSpecan -> Bool
$c/= :: MsgSpecan -> MsgSpecan -> Bool
== :: MsgSpecan -> MsgSpecan -> Bool
$c== :: MsgSpecan -> MsgSpecan -> Bool
Eq )

instance Binary MsgSpecan where
  get :: Get MsgSpecan
get = do
    Word16
_msgSpecan_channel_tag <- Get Word16
getWord16le
    GpsTime
_msgSpecan_t <- forall t. Binary t => Get t
get
    Float
_msgSpecan_freq_ref <- Get Float
getFloat32le
    Float
_msgSpecan_freq_step <- Get Float
getFloat32le
    Float
_msgSpecan_amplitude_ref <- Get Float
getFloat32le
    Float
_msgSpecan_amplitude_unit <- Get Float
getFloat32le
    [Word8]
_msgSpecan_amplitude_value <- forall (m :: * -> *) a. Monad m => m Bool -> m a -> m [a]
whileM (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool
isEmpty) Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgSpecan {Float
[Word8]
Word16
GpsTime
_msgSpecan_amplitude_value :: [Word8]
_msgSpecan_amplitude_unit :: Float
_msgSpecan_amplitude_ref :: Float
_msgSpecan_freq_step :: Float
_msgSpecan_freq_ref :: Float
_msgSpecan_t :: GpsTime
_msgSpecan_channel_tag :: Word16
_msgSpecan_amplitude_value :: [Word8]
_msgSpecan_amplitude_unit :: Float
_msgSpecan_amplitude_ref :: Float
_msgSpecan_freq_step :: Float
_msgSpecan_freq_ref :: Float
_msgSpecan_t :: GpsTime
_msgSpecan_channel_tag :: Word16
..}

  put :: MsgSpecan -> Put
put MsgSpecan {Float
[Word8]
Word16
GpsTime
_msgSpecan_amplitude_value :: [Word8]
_msgSpecan_amplitude_unit :: Float
_msgSpecan_amplitude_ref :: Float
_msgSpecan_freq_step :: Float
_msgSpecan_freq_ref :: Float
_msgSpecan_t :: GpsTime
_msgSpecan_channel_tag :: Word16
_msgSpecan_amplitude_value :: MsgSpecan -> [Word8]
_msgSpecan_amplitude_unit :: MsgSpecan -> Float
_msgSpecan_amplitude_ref :: MsgSpecan -> Float
_msgSpecan_freq_step :: MsgSpecan -> Float
_msgSpecan_freq_ref :: MsgSpecan -> Float
_msgSpecan_t :: MsgSpecan -> GpsTime
_msgSpecan_channel_tag :: MsgSpecan -> Word16
..} = do
    Word16 -> Put
putWord16le Word16
_msgSpecan_channel_tag
    forall t. Binary t => t -> Put
put GpsTime
_msgSpecan_t
    Float -> Put
putFloat32le Float
_msgSpecan_freq_ref
    Float -> Put
putFloat32le Float
_msgSpecan_freq_step
    Float -> Put
putFloat32le Float
_msgSpecan_amplitude_ref
    Float -> Put
putFloat32le Float
_msgSpecan_amplitude_unit
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
_msgSpecan_amplitude_value

$(makeSBP 'msgSpecan ''MsgSpecan)
$(makeJSON "_msgSpecan_" ''MsgSpecan)
$(makeLenses ''MsgSpecan)

msgFrontEndGain :: Word16
msgFrontEndGain :: Word16
msgFrontEndGain = Word16
0x00BF

-- | SBP class for message MSG_FRONT_END_GAIN (0x00BF).
--
-- This message describes the gain of each channel in the receiver frontend.
-- Each gain is encoded as a non-dimensional percentage relative to the
-- maximum range possible for the gain stage of the frontend. By convention,
-- each gain array has 8 entries and the index of the array corresponding to
-- the index of the rf channel in the frontend. A gain of 127 percent encodes
-- that rf channel is not present in the hardware. A negative value implies an
-- error for the particular gain stage as reported by the frontend.
data MsgFrontEndGain = MsgFrontEndGain
  { MsgFrontEndGain -> [Int8]
_msgFrontEndGain_rf_gain :: ![Int8]
    -- ^ RF gain for each frontend channel
  , MsgFrontEndGain -> [Int8]
_msgFrontEndGain_if_gain :: ![Int8]
    -- ^ Intermediate frequency gain for each frontend channel
  } deriving ( Int -> MsgFrontEndGain -> ShowS
[MsgFrontEndGain] -> ShowS
MsgFrontEndGain -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgFrontEndGain] -> ShowS
$cshowList :: [MsgFrontEndGain] -> ShowS
show :: MsgFrontEndGain -> String
$cshow :: MsgFrontEndGain -> String
showsPrec :: Int -> MsgFrontEndGain -> ShowS
$cshowsPrec :: Int -> MsgFrontEndGain -> ShowS
Show, ReadPrec [MsgFrontEndGain]
ReadPrec MsgFrontEndGain
Int -> ReadS MsgFrontEndGain
ReadS [MsgFrontEndGain]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgFrontEndGain]
$creadListPrec :: ReadPrec [MsgFrontEndGain]
readPrec :: ReadPrec MsgFrontEndGain
$creadPrec :: ReadPrec MsgFrontEndGain
readList :: ReadS [MsgFrontEndGain]
$creadList :: ReadS [MsgFrontEndGain]
readsPrec :: Int -> ReadS MsgFrontEndGain
$creadsPrec :: Int -> ReadS MsgFrontEndGain
Read, MsgFrontEndGain -> MsgFrontEndGain -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgFrontEndGain -> MsgFrontEndGain -> Bool
$c/= :: MsgFrontEndGain -> MsgFrontEndGain -> Bool
== :: MsgFrontEndGain -> MsgFrontEndGain -> Bool
$c== :: MsgFrontEndGain -> MsgFrontEndGain -> Bool
Eq )

instance Binary MsgFrontEndGain where
  get :: Get MsgFrontEndGain
get = do
    [Int8]
_msgFrontEndGain_rf_gain <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8)
    [Int8]
_msgFrontEndGain_if_gain <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgFrontEndGain {[Int8]
_msgFrontEndGain_if_gain :: [Int8]
_msgFrontEndGain_rf_gain :: [Int8]
_msgFrontEndGain_if_gain :: [Int8]
_msgFrontEndGain_rf_gain :: [Int8]
..}

  put :: MsgFrontEndGain -> Put
put MsgFrontEndGain {[Int8]
_msgFrontEndGain_if_gain :: [Int8]
_msgFrontEndGain_rf_gain :: [Int8]
_msgFrontEndGain_if_gain :: MsgFrontEndGain -> [Int8]
_msgFrontEndGain_rf_gain :: MsgFrontEndGain -> [Int8]
..} = do
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Word8 -> Put
putWord8 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) [Int8]
_msgFrontEndGain_rf_gain
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Word8 -> Put
putWord8 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) [Int8]
_msgFrontEndGain_if_gain

$(makeSBP 'msgFrontEndGain ''MsgFrontEndGain)
$(makeJSON "_msgFrontEndGain_" ''MsgFrontEndGain)
$(makeLenses ''MsgFrontEndGain)