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

-- |
-- Module:      SwiftNav.SBP.System
-- Copyright:   Copyright (C) 2015-2021 Swift Navigation, Inc.
-- License:     MIT
-- Contact:     https://support.swiftnav.com
-- Stability:   experimental
-- Portability: portable
--
-- \< Standardized system messages from Swift Navigation devices. \>

module SwiftNav.SBP.System
  ( module SwiftNav.SBP.System
  ) 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

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


msgStartup :: Word16
msgStartup :: Word16
msgStartup = Word16
0xFF00

-- | SBP class for message MSG_STARTUP (0xFF00).
--
-- The system start-up message is sent once on system start-up. It notifies
-- the host or other attached devices that the system has started and is now
-- ready to respond to commands or configuration requests.
data MsgStartup = MsgStartup
  { MsgStartup -> Word8
_msgStartup_cause      :: !Word8
    -- ^ Cause of startup
  , MsgStartup -> Word8
_msgStartup_startup_type :: !Word8
    -- ^ Startup type
  , MsgStartup -> Word16
_msgStartup_reserved   :: !Word16
    -- ^ Reserved
  } deriving ( Int -> MsgStartup -> ShowS
[MsgStartup] -> ShowS
MsgStartup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgStartup] -> ShowS
$cshowList :: [MsgStartup] -> ShowS
show :: MsgStartup -> String
$cshow :: MsgStartup -> String
showsPrec :: Int -> MsgStartup -> ShowS
$cshowsPrec :: Int -> MsgStartup -> ShowS
Show, ReadPrec [MsgStartup]
ReadPrec MsgStartup
Int -> ReadS MsgStartup
ReadS [MsgStartup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgStartup]
$creadListPrec :: ReadPrec [MsgStartup]
readPrec :: ReadPrec MsgStartup
$creadPrec :: ReadPrec MsgStartup
readList :: ReadS [MsgStartup]
$creadList :: ReadS [MsgStartup]
readsPrec :: Int -> ReadS MsgStartup
$creadsPrec :: Int -> ReadS MsgStartup
Read, MsgStartup -> MsgStartup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgStartup -> MsgStartup -> Bool
$c/= :: MsgStartup -> MsgStartup -> Bool
== :: MsgStartup -> MsgStartup -> Bool
$c== :: MsgStartup -> MsgStartup -> Bool
Eq )

instance Binary MsgStartup where
  get :: Get MsgStartup
get = do
    Word8
_msgStartup_cause <- Get Word8
getWord8
    Word8
_msgStartup_startup_type <- Get Word8
getWord8
    Word16
_msgStartup_reserved <- Get Word16
getWord16le
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgStartup {Word8
Word16
_msgStartup_reserved :: Word16
_msgStartup_startup_type :: Word8
_msgStartup_cause :: Word8
_msgStartup_reserved :: Word16
_msgStartup_startup_type :: Word8
_msgStartup_cause :: Word8
..}

  put :: MsgStartup -> Put
put MsgStartup {Word8
Word16
_msgStartup_reserved :: Word16
_msgStartup_startup_type :: Word8
_msgStartup_cause :: Word8
_msgStartup_reserved :: MsgStartup -> Word16
_msgStartup_startup_type :: MsgStartup -> Word8
_msgStartup_cause :: MsgStartup -> Word8
..} = do
    Word8 -> Put
putWord8 Word8
_msgStartup_cause
    Word8 -> Put
putWord8 Word8
_msgStartup_startup_type
    Word16 -> Put
putWord16le Word16
_msgStartup_reserved

$(makeSBP 'msgStartup ''MsgStartup)
$(makeJSON "_msgStartup_" ''MsgStartup)
$(makeLenses ''MsgStartup)

msgDgnssStatus :: Word16
msgDgnssStatus :: Word16
msgDgnssStatus = Word16
0xFF02

-- | SBP class for message MSG_DGNSS_STATUS (0xFF02).
--
-- This message provides information about the receipt of Differential
-- corrections.  It is expected to be sent with each receipt of a complete
-- corrections packet.
data MsgDgnssStatus = MsgDgnssStatus
  { MsgDgnssStatus -> Word8
_msgDgnssStatus_flags     :: !Word8
    -- ^ Status flags
  , MsgDgnssStatus -> Word16
_msgDgnssStatus_latency   :: !Word16
    -- ^ Latency of observation receipt
  , MsgDgnssStatus -> Word8
_msgDgnssStatus_num_signals :: !Word8
    -- ^ Number of signals from base station
  , MsgDgnssStatus -> Text
_msgDgnssStatus_source    :: !Text
    -- ^ Corrections source string
  } deriving ( Int -> MsgDgnssStatus -> ShowS
[MsgDgnssStatus] -> ShowS
MsgDgnssStatus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgDgnssStatus] -> ShowS
$cshowList :: [MsgDgnssStatus] -> ShowS
show :: MsgDgnssStatus -> String
$cshow :: MsgDgnssStatus -> String
showsPrec :: Int -> MsgDgnssStatus -> ShowS
$cshowsPrec :: Int -> MsgDgnssStatus -> ShowS
Show, ReadPrec [MsgDgnssStatus]
ReadPrec MsgDgnssStatus
Int -> ReadS MsgDgnssStatus
ReadS [MsgDgnssStatus]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgDgnssStatus]
$creadListPrec :: ReadPrec [MsgDgnssStatus]
readPrec :: ReadPrec MsgDgnssStatus
$creadPrec :: ReadPrec MsgDgnssStatus
readList :: ReadS [MsgDgnssStatus]
$creadList :: ReadS [MsgDgnssStatus]
readsPrec :: Int -> ReadS MsgDgnssStatus
$creadsPrec :: Int -> ReadS MsgDgnssStatus
Read, MsgDgnssStatus -> MsgDgnssStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgDgnssStatus -> MsgDgnssStatus -> Bool
$c/= :: MsgDgnssStatus -> MsgDgnssStatus -> Bool
== :: MsgDgnssStatus -> MsgDgnssStatus -> Bool
$c== :: MsgDgnssStatus -> MsgDgnssStatus -> Bool
Eq )

instance Binary MsgDgnssStatus where
  get :: Get MsgDgnssStatus
get = do
    Word8
_msgDgnssStatus_flags <- Get Word8
getWord8
    Word16
_msgDgnssStatus_latency <- Get Word16
getWord16le
    Word8
_msgDgnssStatus_num_signals <- Get Word8
getWord8
    Text
_msgDgnssStatus_source <- 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 MsgDgnssStatus {Word8
Word16
Text
_msgDgnssStatus_source :: Text
_msgDgnssStatus_num_signals :: Word8
_msgDgnssStatus_latency :: Word16
_msgDgnssStatus_flags :: Word8
_msgDgnssStatus_source :: Text
_msgDgnssStatus_num_signals :: Word8
_msgDgnssStatus_latency :: Word16
_msgDgnssStatus_flags :: Word8
..}

  put :: MsgDgnssStatus -> Put
put MsgDgnssStatus {Word8
Word16
Text
_msgDgnssStatus_source :: Text
_msgDgnssStatus_num_signals :: Word8
_msgDgnssStatus_latency :: Word16
_msgDgnssStatus_flags :: Word8
_msgDgnssStatus_source :: MsgDgnssStatus -> Text
_msgDgnssStatus_num_signals :: MsgDgnssStatus -> Word8
_msgDgnssStatus_latency :: MsgDgnssStatus -> Word16
_msgDgnssStatus_flags :: MsgDgnssStatus -> Word8
..} = do
    Word8 -> Put
putWord8 Word8
_msgDgnssStatus_flags
    Word16 -> Put
putWord16le Word16
_msgDgnssStatus_latency
    Word8 -> Put
putWord8 Word8
_msgDgnssStatus_num_signals
    ByteString -> Put
putByteString forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
_msgDgnssStatus_source

$(makeSBP 'msgDgnssStatus ''MsgDgnssStatus)
$(makeJSON "_msgDgnssStatus_" ''MsgDgnssStatus)
$(makeLenses ''MsgDgnssStatus)

msgHeartbeat :: Word16
msgHeartbeat :: Word16
msgHeartbeat = Word16
0xFFFF

-- | SBP class for message MSG_HEARTBEAT (0xFFFF).
--
-- The heartbeat message is sent periodically to inform the host or other
-- attached devices that the system is running. It is used to monitor system
-- malfunctions. It also contains status flags that indicate to the host the
-- status of the system and whether it is operating correctly. Currently, the
-- expected heartbeat interval is 1 sec.
--
-- The system error flag is used to indicate that an error has occurred in the
-- system. To determine the source of the error, the remaining error flags
-- should be inspected.
data MsgHeartbeat = MsgHeartbeat
  { MsgHeartbeat -> Word32
_msgHeartbeat_flags :: !Word32
    -- ^ Status flags
  } deriving ( Int -> MsgHeartbeat -> ShowS
[MsgHeartbeat] -> ShowS
MsgHeartbeat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgHeartbeat] -> ShowS
$cshowList :: [MsgHeartbeat] -> ShowS
show :: MsgHeartbeat -> String
$cshow :: MsgHeartbeat -> String
showsPrec :: Int -> MsgHeartbeat -> ShowS
$cshowsPrec :: Int -> MsgHeartbeat -> ShowS
Show, ReadPrec [MsgHeartbeat]
ReadPrec MsgHeartbeat
Int -> ReadS MsgHeartbeat
ReadS [MsgHeartbeat]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgHeartbeat]
$creadListPrec :: ReadPrec [MsgHeartbeat]
readPrec :: ReadPrec MsgHeartbeat
$creadPrec :: ReadPrec MsgHeartbeat
readList :: ReadS [MsgHeartbeat]
$creadList :: ReadS [MsgHeartbeat]
readsPrec :: Int -> ReadS MsgHeartbeat
$creadsPrec :: Int -> ReadS MsgHeartbeat
Read, MsgHeartbeat -> MsgHeartbeat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgHeartbeat -> MsgHeartbeat -> Bool
$c/= :: MsgHeartbeat -> MsgHeartbeat -> Bool
== :: MsgHeartbeat -> MsgHeartbeat -> Bool
$c== :: MsgHeartbeat -> MsgHeartbeat -> Bool
Eq )

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

  put :: MsgHeartbeat -> Put
put MsgHeartbeat {Word32
_msgHeartbeat_flags :: Word32
_msgHeartbeat_flags :: MsgHeartbeat -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgHeartbeat_flags

$(makeSBP 'msgHeartbeat ''MsgHeartbeat)
$(makeJSON "_msgHeartbeat_" ''MsgHeartbeat)
$(makeLenses ''MsgHeartbeat)

-- | SubSystemReport.
--
-- Report the general and specific state of a subsystem.  If the generic state
-- is reported as initializing, the specific state should be ignored.
data SubSystemReport = SubSystemReport
  { SubSystemReport -> Word16
_subSystemReport_component :: !Word16
    -- ^ Identity of reporting subsystem
  , SubSystemReport -> Word8
_subSystemReport_generic :: !Word8
    -- ^ Generic form status report
  , SubSystemReport -> Word8
_subSystemReport_specific :: !Word8
    -- ^ Subsystem specific status code
  } deriving ( Int -> SubSystemReport -> ShowS
[SubSystemReport] -> ShowS
SubSystemReport -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubSystemReport] -> ShowS
$cshowList :: [SubSystemReport] -> ShowS
show :: SubSystemReport -> String
$cshow :: SubSystemReport -> String
showsPrec :: Int -> SubSystemReport -> ShowS
$cshowsPrec :: Int -> SubSystemReport -> ShowS
Show, ReadPrec [SubSystemReport]
ReadPrec SubSystemReport
Int -> ReadS SubSystemReport
ReadS [SubSystemReport]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SubSystemReport]
$creadListPrec :: ReadPrec [SubSystemReport]
readPrec :: ReadPrec SubSystemReport
$creadPrec :: ReadPrec SubSystemReport
readList :: ReadS [SubSystemReport]
$creadList :: ReadS [SubSystemReport]
readsPrec :: Int -> ReadS SubSystemReport
$creadsPrec :: Int -> ReadS SubSystemReport
Read, SubSystemReport -> SubSystemReport -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubSystemReport -> SubSystemReport -> Bool
$c/= :: SubSystemReport -> SubSystemReport -> Bool
== :: SubSystemReport -> SubSystemReport -> Bool
$c== :: SubSystemReport -> SubSystemReport -> Bool
Eq )

instance Binary SubSystemReport where
  get :: Get SubSystemReport
get = do
    Word16
_subSystemReport_component <- Get Word16
getWord16le
    Word8
_subSystemReport_generic <- Get Word8
getWord8
    Word8
_subSystemReport_specific <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure SubSystemReport {Word8
Word16
_subSystemReport_specific :: Word8
_subSystemReport_generic :: Word8
_subSystemReport_component :: Word16
_subSystemReport_specific :: Word8
_subSystemReport_generic :: Word8
_subSystemReport_component :: Word16
..}

  put :: SubSystemReport -> Put
put SubSystemReport {Word8
Word16
_subSystemReport_specific :: Word8
_subSystemReport_generic :: Word8
_subSystemReport_component :: Word16
_subSystemReport_specific :: SubSystemReport -> Word8
_subSystemReport_generic :: SubSystemReport -> Word8
_subSystemReport_component :: SubSystemReport -> Word16
..} = do
    Word16 -> Put
putWord16le Word16
_subSystemReport_component
    Word8 -> Put
putWord8 Word8
_subSystemReport_generic
    Word8 -> Put
putWord8 Word8
_subSystemReport_specific

$(makeJSON "_subSystemReport_" ''SubSystemReport)
$(makeLenses ''SubSystemReport)

msgStatusReport :: Word16
msgStatusReport :: Word16
msgStatusReport = Word16
0xFFFE

-- | SBP class for message MSG_STATUS_REPORT (0xFFFE).
--
-- The status report is sent periodically to inform the host or other attached
-- devices that the system is running. It is used to monitor system
-- malfunctions. It contains status reports that indicate to the host the
-- status of each subsystem and whether it is operating correctly.
--
-- Interpretation of the subsystem specific status code is product dependent,
-- but if the generic status code is initializing, it should be ignored.
-- Refer to product documentation for details.
data MsgStatusReport = MsgStatusReport
  { MsgStatusReport -> Word16
_msgStatusReport_reporting_system :: !Word16
    -- ^ Identity of reporting system
  , MsgStatusReport -> Word16
_msgStatusReport_sbp_version    :: !Word16
    -- ^ SBP protocol version
  , MsgStatusReport -> Word32
_msgStatusReport_sequence       :: !Word32
    -- ^ Increments on each status report sent
  , MsgStatusReport -> Word32
_msgStatusReport_uptime         :: !Word32
    -- ^ Number of seconds since system start-up
  , MsgStatusReport -> [SubSystemReport]
_msgStatusReport_status         :: ![SubSystemReport]
    -- ^ Reported status of individual subsystems
  } deriving ( Int -> MsgStatusReport -> ShowS
[MsgStatusReport] -> ShowS
MsgStatusReport -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgStatusReport] -> ShowS
$cshowList :: [MsgStatusReport] -> ShowS
show :: MsgStatusReport -> String
$cshow :: MsgStatusReport -> String
showsPrec :: Int -> MsgStatusReport -> ShowS
$cshowsPrec :: Int -> MsgStatusReport -> ShowS
Show, ReadPrec [MsgStatusReport]
ReadPrec MsgStatusReport
Int -> ReadS MsgStatusReport
ReadS [MsgStatusReport]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgStatusReport]
$creadListPrec :: ReadPrec [MsgStatusReport]
readPrec :: ReadPrec MsgStatusReport
$creadPrec :: ReadPrec MsgStatusReport
readList :: ReadS [MsgStatusReport]
$creadList :: ReadS [MsgStatusReport]
readsPrec :: Int -> ReadS MsgStatusReport
$creadsPrec :: Int -> ReadS MsgStatusReport
Read, MsgStatusReport -> MsgStatusReport -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgStatusReport -> MsgStatusReport -> Bool
$c/= :: MsgStatusReport -> MsgStatusReport -> Bool
== :: MsgStatusReport -> MsgStatusReport -> Bool
$c== :: MsgStatusReport -> MsgStatusReport -> Bool
Eq )

instance Binary MsgStatusReport where
  get :: Get MsgStatusReport
get = do
    Word16
_msgStatusReport_reporting_system <- Get Word16
getWord16le
    Word16
_msgStatusReport_sbp_version <- Get Word16
getWord16le
    Word32
_msgStatusReport_sequence <- Get Word32
getWord32le
    Word32
_msgStatusReport_uptime <- Get Word32
getWord32le
    [SubSystemReport]
_msgStatusReport_status <- 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 MsgStatusReport {[SubSystemReport]
Word16
Word32
_msgStatusReport_status :: [SubSystemReport]
_msgStatusReport_uptime :: Word32
_msgStatusReport_sequence :: Word32
_msgStatusReport_sbp_version :: Word16
_msgStatusReport_reporting_system :: Word16
_msgStatusReport_status :: [SubSystemReport]
_msgStatusReport_uptime :: Word32
_msgStatusReport_sequence :: Word32
_msgStatusReport_sbp_version :: Word16
_msgStatusReport_reporting_system :: Word16
..}

  put :: MsgStatusReport -> Put
put MsgStatusReport {[SubSystemReport]
Word16
Word32
_msgStatusReport_status :: [SubSystemReport]
_msgStatusReport_uptime :: Word32
_msgStatusReport_sequence :: Word32
_msgStatusReport_sbp_version :: Word16
_msgStatusReport_reporting_system :: Word16
_msgStatusReport_status :: MsgStatusReport -> [SubSystemReport]
_msgStatusReport_uptime :: MsgStatusReport -> Word32
_msgStatusReport_sequence :: MsgStatusReport -> Word32
_msgStatusReport_sbp_version :: MsgStatusReport -> Word16
_msgStatusReport_reporting_system :: MsgStatusReport -> Word16
..} = do
    Word16 -> Put
putWord16le Word16
_msgStatusReport_reporting_system
    Word16 -> Put
putWord16le Word16
_msgStatusReport_sbp_version
    Word32 -> Put
putWord32le Word32
_msgStatusReport_sequence
    Word32 -> Put
putWord32le Word32
_msgStatusReport_uptime
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall t. Binary t => t -> Put
put [SubSystemReport]
_msgStatusReport_status

$(makeSBP 'msgStatusReport ''MsgStatusReport)
$(makeJSON "_msgStatusReport_" ''MsgStatusReport)
$(makeLenses ''MsgStatusReport)

-- | StatusJournalItem.
--
-- Reports the uptime and the state of a subsystem via generic and specific
-- status codes.  If the generic state is reported as initializing, the
-- specific state should be ignored.
data StatusJournalItem = StatusJournalItem
  { StatusJournalItem -> Word32
_statusJournalItem_uptime :: !Word32
    -- ^ Milliseconds since system startup
  , StatusJournalItem -> SubSystemReport
_statusJournalItem_report :: !SubSystemReport
  } deriving ( Int -> StatusJournalItem -> ShowS
[StatusJournalItem] -> ShowS
StatusJournalItem -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StatusJournalItem] -> ShowS
$cshowList :: [StatusJournalItem] -> ShowS
show :: StatusJournalItem -> String
$cshow :: StatusJournalItem -> String
showsPrec :: Int -> StatusJournalItem -> ShowS
$cshowsPrec :: Int -> StatusJournalItem -> ShowS
Show, ReadPrec [StatusJournalItem]
ReadPrec StatusJournalItem
Int -> ReadS StatusJournalItem
ReadS [StatusJournalItem]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StatusJournalItem]
$creadListPrec :: ReadPrec [StatusJournalItem]
readPrec :: ReadPrec StatusJournalItem
$creadPrec :: ReadPrec StatusJournalItem
readList :: ReadS [StatusJournalItem]
$creadList :: ReadS [StatusJournalItem]
readsPrec :: Int -> ReadS StatusJournalItem
$creadsPrec :: Int -> ReadS StatusJournalItem
Read, StatusJournalItem -> StatusJournalItem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StatusJournalItem -> StatusJournalItem -> Bool
$c/= :: StatusJournalItem -> StatusJournalItem -> Bool
== :: StatusJournalItem -> StatusJournalItem -> Bool
$c== :: StatusJournalItem -> StatusJournalItem -> Bool
Eq )

instance Binary StatusJournalItem where
  get :: Get StatusJournalItem
get = do
    Word32
_statusJournalItem_uptime <- Get Word32
getWord32le
    SubSystemReport
_statusJournalItem_report <- forall t. Binary t => Get t
get
    forall (f :: * -> *) a. Applicative f => a -> f a
pure StatusJournalItem {Word32
SubSystemReport
_statusJournalItem_report :: SubSystemReport
_statusJournalItem_uptime :: Word32
_statusJournalItem_report :: SubSystemReport
_statusJournalItem_uptime :: Word32
..}

  put :: StatusJournalItem -> Put
put StatusJournalItem {Word32
SubSystemReport
_statusJournalItem_report :: SubSystemReport
_statusJournalItem_uptime :: Word32
_statusJournalItem_report :: StatusJournalItem -> SubSystemReport
_statusJournalItem_uptime :: StatusJournalItem -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_statusJournalItem_uptime
    forall t. Binary t => t -> Put
put SubSystemReport
_statusJournalItem_report

$(makeJSON "_statusJournalItem_" ''StatusJournalItem)
$(makeLenses ''StatusJournalItem)

msgStatusJournal :: Word16
msgStatusJournal :: Word16
msgStatusJournal = Word16
0xFFFD

-- | SBP class for message MSG_STATUS_JOURNAL (0xFFFD).
--
-- The status journal message contains past status reports (see
-- MSG_STATUS_REPORT) and functions as a error/event storage for telemetry
-- purposes.
data MsgStatusJournal = MsgStatusJournal
  { MsgStatusJournal -> Word16
_msgStatusJournal_reporting_system   :: !Word16
    -- ^ Identity of reporting system
  , MsgStatusJournal -> Word16
_msgStatusJournal_sbp_version        :: !Word16
    -- ^ SBP protocol version
  , MsgStatusJournal -> Word32
_msgStatusJournal_total_status_reports :: !Word32
    -- ^ Total number of status reports sent since system startup
  , MsgStatusJournal -> Word8
_msgStatusJournal_sequence_descriptor :: !Word8
    -- ^ Index and number of messages in this sequence. First nibble is the size
    -- of the sequence (n), second nibble is the zero-indexed counter (ith
    -- packet of n)
  , MsgStatusJournal -> [StatusJournalItem]
_msgStatusJournal_journal            :: ![StatusJournalItem]
    -- ^ Status journal
  } deriving ( Int -> MsgStatusJournal -> ShowS
[MsgStatusJournal] -> ShowS
MsgStatusJournal -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgStatusJournal] -> ShowS
$cshowList :: [MsgStatusJournal] -> ShowS
show :: MsgStatusJournal -> String
$cshow :: MsgStatusJournal -> String
showsPrec :: Int -> MsgStatusJournal -> ShowS
$cshowsPrec :: Int -> MsgStatusJournal -> ShowS
Show, ReadPrec [MsgStatusJournal]
ReadPrec MsgStatusJournal
Int -> ReadS MsgStatusJournal
ReadS [MsgStatusJournal]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgStatusJournal]
$creadListPrec :: ReadPrec [MsgStatusJournal]
readPrec :: ReadPrec MsgStatusJournal
$creadPrec :: ReadPrec MsgStatusJournal
readList :: ReadS [MsgStatusJournal]
$creadList :: ReadS [MsgStatusJournal]
readsPrec :: Int -> ReadS MsgStatusJournal
$creadsPrec :: Int -> ReadS MsgStatusJournal
Read, MsgStatusJournal -> MsgStatusJournal -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgStatusJournal -> MsgStatusJournal -> Bool
$c/= :: MsgStatusJournal -> MsgStatusJournal -> Bool
== :: MsgStatusJournal -> MsgStatusJournal -> Bool
$c== :: MsgStatusJournal -> MsgStatusJournal -> Bool
Eq )

instance Binary MsgStatusJournal where
  get :: Get MsgStatusJournal
get = do
    Word16
_msgStatusJournal_reporting_system <- Get Word16
getWord16le
    Word16
_msgStatusJournal_sbp_version <- Get Word16
getWord16le
    Word32
_msgStatusJournal_total_status_reports <- Get Word32
getWord32le
    Word8
_msgStatusJournal_sequence_descriptor <- Get Word8
getWord8
    [StatusJournalItem]
_msgStatusJournal_journal <- 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 MsgStatusJournal {[StatusJournalItem]
Word8
Word16
Word32
_msgStatusJournal_journal :: [StatusJournalItem]
_msgStatusJournal_sequence_descriptor :: Word8
_msgStatusJournal_total_status_reports :: Word32
_msgStatusJournal_sbp_version :: Word16
_msgStatusJournal_reporting_system :: Word16
_msgStatusJournal_journal :: [StatusJournalItem]
_msgStatusJournal_sequence_descriptor :: Word8
_msgStatusJournal_total_status_reports :: Word32
_msgStatusJournal_sbp_version :: Word16
_msgStatusJournal_reporting_system :: Word16
..}

  put :: MsgStatusJournal -> Put
put MsgStatusJournal {[StatusJournalItem]
Word8
Word16
Word32
_msgStatusJournal_journal :: [StatusJournalItem]
_msgStatusJournal_sequence_descriptor :: Word8
_msgStatusJournal_total_status_reports :: Word32
_msgStatusJournal_sbp_version :: Word16
_msgStatusJournal_reporting_system :: Word16
_msgStatusJournal_journal :: MsgStatusJournal -> [StatusJournalItem]
_msgStatusJournal_sequence_descriptor :: MsgStatusJournal -> Word8
_msgStatusJournal_total_status_reports :: MsgStatusJournal -> Word32
_msgStatusJournal_sbp_version :: MsgStatusJournal -> Word16
_msgStatusJournal_reporting_system :: MsgStatusJournal -> Word16
..} = do
    Word16 -> Put
putWord16le Word16
_msgStatusJournal_reporting_system
    Word16 -> Put
putWord16le Word16
_msgStatusJournal_sbp_version
    Word32 -> Put
putWord32le Word32
_msgStatusJournal_total_status_reports
    Word8 -> Put
putWord8 Word8
_msgStatusJournal_sequence_descriptor
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall t. Binary t => t -> Put
put [StatusJournalItem]
_msgStatusJournal_journal

$(makeSBP 'msgStatusJournal ''MsgStatusJournal)
$(makeJSON "_msgStatusJournal_" ''MsgStatusJournal)
$(makeLenses ''MsgStatusJournal)

msgInsStatus :: Word16
msgInsStatus :: Word16
msgInsStatus = Word16
0xFF03

-- | SBP class for message MSG_INS_STATUS (0xFF03).
--
-- The INS status message describes the state of the operation and
-- initialization of the inertial navigation system.
data MsgInsStatus = MsgInsStatus
  { MsgInsStatus -> Word32
_msgInsStatus_flags :: !Word32
    -- ^ Status flags
  } deriving ( Int -> MsgInsStatus -> ShowS
[MsgInsStatus] -> ShowS
MsgInsStatus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgInsStatus] -> ShowS
$cshowList :: [MsgInsStatus] -> ShowS
show :: MsgInsStatus -> String
$cshow :: MsgInsStatus -> String
showsPrec :: Int -> MsgInsStatus -> ShowS
$cshowsPrec :: Int -> MsgInsStatus -> ShowS
Show, ReadPrec [MsgInsStatus]
ReadPrec MsgInsStatus
Int -> ReadS MsgInsStatus
ReadS [MsgInsStatus]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgInsStatus]
$creadListPrec :: ReadPrec [MsgInsStatus]
readPrec :: ReadPrec MsgInsStatus
$creadPrec :: ReadPrec MsgInsStatus
readList :: ReadS [MsgInsStatus]
$creadList :: ReadS [MsgInsStatus]
readsPrec :: Int -> ReadS MsgInsStatus
$creadsPrec :: Int -> ReadS MsgInsStatus
Read, MsgInsStatus -> MsgInsStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgInsStatus -> MsgInsStatus -> Bool
$c/= :: MsgInsStatus -> MsgInsStatus -> Bool
== :: MsgInsStatus -> MsgInsStatus -> Bool
$c== :: MsgInsStatus -> MsgInsStatus -> Bool
Eq )

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

  put :: MsgInsStatus -> Put
put MsgInsStatus {Word32
_msgInsStatus_flags :: Word32
_msgInsStatus_flags :: MsgInsStatus -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgInsStatus_flags

$(makeSBP 'msgInsStatus ''MsgInsStatus)
$(makeJSON "_msgInsStatus_" ''MsgInsStatus)
$(makeLenses ''MsgInsStatus)

msgCsacTelemetry :: Word16
msgCsacTelemetry :: Word16
msgCsacTelemetry = Word16
0xFF04

-- | SBP class for message MSG_CSAC_TELEMETRY (0xFF04).
--
-- The CSAC telemetry message has an implementation defined telemetry string
-- from a device. It is not produced or available on general Swift Products.
-- It is intended to be a low rate message for status purposes.
data MsgCsacTelemetry = MsgCsacTelemetry
  { MsgCsacTelemetry -> Word8
_msgCsacTelemetry_id      :: !Word8
    -- ^ Index representing the type of telemetry in use.  It is implementation
    -- defined.
  , MsgCsacTelemetry -> Text
_msgCsacTelemetry_telemetry :: !Text
    -- ^ Comma separated list of values as defined by the index
  } deriving ( Int -> MsgCsacTelemetry -> ShowS
[MsgCsacTelemetry] -> ShowS
MsgCsacTelemetry -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgCsacTelemetry] -> ShowS
$cshowList :: [MsgCsacTelemetry] -> ShowS
show :: MsgCsacTelemetry -> String
$cshow :: MsgCsacTelemetry -> String
showsPrec :: Int -> MsgCsacTelemetry -> ShowS
$cshowsPrec :: Int -> MsgCsacTelemetry -> ShowS
Show, ReadPrec [MsgCsacTelemetry]
ReadPrec MsgCsacTelemetry
Int -> ReadS MsgCsacTelemetry
ReadS [MsgCsacTelemetry]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgCsacTelemetry]
$creadListPrec :: ReadPrec [MsgCsacTelemetry]
readPrec :: ReadPrec MsgCsacTelemetry
$creadPrec :: ReadPrec MsgCsacTelemetry
readList :: ReadS [MsgCsacTelemetry]
$creadList :: ReadS [MsgCsacTelemetry]
readsPrec :: Int -> ReadS MsgCsacTelemetry
$creadsPrec :: Int -> ReadS MsgCsacTelemetry
Read, MsgCsacTelemetry -> MsgCsacTelemetry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgCsacTelemetry -> MsgCsacTelemetry -> Bool
$c/= :: MsgCsacTelemetry -> MsgCsacTelemetry -> Bool
== :: MsgCsacTelemetry -> MsgCsacTelemetry -> Bool
$c== :: MsgCsacTelemetry -> MsgCsacTelemetry -> Bool
Eq )

instance Binary MsgCsacTelemetry where
  get :: Get MsgCsacTelemetry
get = do
    Word8
_msgCsacTelemetry_id <- Get Word8
getWord8
    Text
_msgCsacTelemetry_telemetry <- 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 MsgCsacTelemetry {Word8
Text
_msgCsacTelemetry_telemetry :: Text
_msgCsacTelemetry_id :: Word8
_msgCsacTelemetry_telemetry :: Text
_msgCsacTelemetry_id :: Word8
..}

  put :: MsgCsacTelemetry -> Put
put MsgCsacTelemetry {Word8
Text
_msgCsacTelemetry_telemetry :: Text
_msgCsacTelemetry_id :: Word8
_msgCsacTelemetry_telemetry :: MsgCsacTelemetry -> Text
_msgCsacTelemetry_id :: MsgCsacTelemetry -> Word8
..} = do
    Word8 -> Put
putWord8 Word8
_msgCsacTelemetry_id
    ByteString -> Put
putByteString forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
_msgCsacTelemetry_telemetry

$(makeSBP 'msgCsacTelemetry ''MsgCsacTelemetry)
$(makeJSON "_msgCsacTelemetry_" ''MsgCsacTelemetry)
$(makeLenses ''MsgCsacTelemetry)

msgCsacTelemetryLabels :: Word16
msgCsacTelemetryLabels :: Word16
msgCsacTelemetryLabels = Word16
0xFF05

-- | SBP class for message MSG_CSAC_TELEMETRY_LABELS (0xFF05).
--
-- The CSAC telemetry message provides labels for each member of the string
-- produced by MSG_CSAC_TELEMETRY. It should be provided by a device at a
-- lower rate than the MSG_CSAC_TELEMETRY.
data MsgCsacTelemetryLabels = MsgCsacTelemetryLabels
  { MsgCsacTelemetryLabels -> Word8
_msgCsacTelemetryLabels_id             :: !Word8
    -- ^ Index representing the type of telemetry in use.  It is implementation
    -- defined.
  , MsgCsacTelemetryLabels -> Text
_msgCsacTelemetryLabels_telemetry_labels :: !Text
    -- ^ Comma separated list of telemetry field values
  } deriving ( Int -> MsgCsacTelemetryLabels -> ShowS
[MsgCsacTelemetryLabels] -> ShowS
MsgCsacTelemetryLabels -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgCsacTelemetryLabels] -> ShowS
$cshowList :: [MsgCsacTelemetryLabels] -> ShowS
show :: MsgCsacTelemetryLabels -> String
$cshow :: MsgCsacTelemetryLabels -> String
showsPrec :: Int -> MsgCsacTelemetryLabels -> ShowS
$cshowsPrec :: Int -> MsgCsacTelemetryLabels -> ShowS
Show, ReadPrec [MsgCsacTelemetryLabels]
ReadPrec MsgCsacTelemetryLabels
Int -> ReadS MsgCsacTelemetryLabels
ReadS [MsgCsacTelemetryLabels]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgCsacTelemetryLabels]
$creadListPrec :: ReadPrec [MsgCsacTelemetryLabels]
readPrec :: ReadPrec MsgCsacTelemetryLabels
$creadPrec :: ReadPrec MsgCsacTelemetryLabels
readList :: ReadS [MsgCsacTelemetryLabels]
$creadList :: ReadS [MsgCsacTelemetryLabels]
readsPrec :: Int -> ReadS MsgCsacTelemetryLabels
$creadsPrec :: Int -> ReadS MsgCsacTelemetryLabels
Read, MsgCsacTelemetryLabels -> MsgCsacTelemetryLabels -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgCsacTelemetryLabels -> MsgCsacTelemetryLabels -> Bool
$c/= :: MsgCsacTelemetryLabels -> MsgCsacTelemetryLabels -> Bool
== :: MsgCsacTelemetryLabels -> MsgCsacTelemetryLabels -> Bool
$c== :: MsgCsacTelemetryLabels -> MsgCsacTelemetryLabels -> Bool
Eq )

instance Binary MsgCsacTelemetryLabels where
  get :: Get MsgCsacTelemetryLabels
get = do
    Word8
_msgCsacTelemetryLabels_id <- Get Word8
getWord8
    Text
_msgCsacTelemetryLabels_telemetry_labels <- 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 MsgCsacTelemetryLabels {Word8
Text
_msgCsacTelemetryLabels_telemetry_labels :: Text
_msgCsacTelemetryLabels_id :: Word8
_msgCsacTelemetryLabels_telemetry_labels :: Text
_msgCsacTelemetryLabels_id :: Word8
..}

  put :: MsgCsacTelemetryLabels -> Put
put MsgCsacTelemetryLabels {Word8
Text
_msgCsacTelemetryLabels_telemetry_labels :: Text
_msgCsacTelemetryLabels_id :: Word8
_msgCsacTelemetryLabels_telemetry_labels :: MsgCsacTelemetryLabels -> Text
_msgCsacTelemetryLabels_id :: MsgCsacTelemetryLabels -> Word8
..} = do
    Word8 -> Put
putWord8 Word8
_msgCsacTelemetryLabels_id
    ByteString -> Put
putByteString forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
_msgCsacTelemetryLabels_telemetry_labels

$(makeSBP 'msgCsacTelemetryLabels ''MsgCsacTelemetryLabels)
$(makeJSON "_msgCsacTelemetryLabels_" ''MsgCsacTelemetryLabels)
$(makeLenses ''MsgCsacTelemetryLabels)

msgInsUpdates :: Word16
msgInsUpdates :: Word16
msgInsUpdates = Word16
0xFF06

-- | SBP class for message MSG_INS_UPDATES (0xFF06).
--
-- The INS update status message contains information about executed and
-- rejected INS updates. This message is expected to be extended in the future
-- as new types of measurements are being added.
data MsgInsUpdates = MsgInsUpdates
  { MsgInsUpdates -> Word32
_msgInsUpdates_tow      :: !Word32
    -- ^ GPS Time of Week
  , MsgInsUpdates -> Word8
_msgInsUpdates_gnsspos  :: !Word8
    -- ^ GNSS position update status flags
  , MsgInsUpdates -> Word8
_msgInsUpdates_gnssvel  :: !Word8
    -- ^ GNSS velocity update status flags
  , MsgInsUpdates -> Word8
_msgInsUpdates_wheelticks :: !Word8
    -- ^ Wheelticks update status flags
  , MsgInsUpdates -> Word8
_msgInsUpdates_speed    :: !Word8
    -- ^ Wheelticks update status flags
  , MsgInsUpdates -> Word8
_msgInsUpdates_nhc      :: !Word8
    -- ^ NHC update status flags
  , MsgInsUpdates -> Word8
_msgInsUpdates_zerovel  :: !Word8
    -- ^ Zero velocity update status flags
  } deriving ( Int -> MsgInsUpdates -> ShowS
[MsgInsUpdates] -> ShowS
MsgInsUpdates -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgInsUpdates] -> ShowS
$cshowList :: [MsgInsUpdates] -> ShowS
show :: MsgInsUpdates -> String
$cshow :: MsgInsUpdates -> String
showsPrec :: Int -> MsgInsUpdates -> ShowS
$cshowsPrec :: Int -> MsgInsUpdates -> ShowS
Show, ReadPrec [MsgInsUpdates]
ReadPrec MsgInsUpdates
Int -> ReadS MsgInsUpdates
ReadS [MsgInsUpdates]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgInsUpdates]
$creadListPrec :: ReadPrec [MsgInsUpdates]
readPrec :: ReadPrec MsgInsUpdates
$creadPrec :: ReadPrec MsgInsUpdates
readList :: ReadS [MsgInsUpdates]
$creadList :: ReadS [MsgInsUpdates]
readsPrec :: Int -> ReadS MsgInsUpdates
$creadsPrec :: Int -> ReadS MsgInsUpdates
Read, MsgInsUpdates -> MsgInsUpdates -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgInsUpdates -> MsgInsUpdates -> Bool
$c/= :: MsgInsUpdates -> MsgInsUpdates -> Bool
== :: MsgInsUpdates -> MsgInsUpdates -> Bool
$c== :: MsgInsUpdates -> MsgInsUpdates -> Bool
Eq )

instance Binary MsgInsUpdates where
  get :: Get MsgInsUpdates
get = do
    Word32
_msgInsUpdates_tow <- Get Word32
getWord32le
    Word8
_msgInsUpdates_gnsspos <- Get Word8
getWord8
    Word8
_msgInsUpdates_gnssvel <- Get Word8
getWord8
    Word8
_msgInsUpdates_wheelticks <- Get Word8
getWord8
    Word8
_msgInsUpdates_speed <- Get Word8
getWord8
    Word8
_msgInsUpdates_nhc <- Get Word8
getWord8
    Word8
_msgInsUpdates_zerovel <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgInsUpdates {Word8
Word32
_msgInsUpdates_zerovel :: Word8
_msgInsUpdates_nhc :: Word8
_msgInsUpdates_speed :: Word8
_msgInsUpdates_wheelticks :: Word8
_msgInsUpdates_gnssvel :: Word8
_msgInsUpdates_gnsspos :: Word8
_msgInsUpdates_tow :: Word32
_msgInsUpdates_zerovel :: Word8
_msgInsUpdates_nhc :: Word8
_msgInsUpdates_speed :: Word8
_msgInsUpdates_wheelticks :: Word8
_msgInsUpdates_gnssvel :: Word8
_msgInsUpdates_gnsspos :: Word8
_msgInsUpdates_tow :: Word32
..}

  put :: MsgInsUpdates -> Put
put MsgInsUpdates {Word8
Word32
_msgInsUpdates_zerovel :: Word8
_msgInsUpdates_nhc :: Word8
_msgInsUpdates_speed :: Word8
_msgInsUpdates_wheelticks :: Word8
_msgInsUpdates_gnssvel :: Word8
_msgInsUpdates_gnsspos :: Word8
_msgInsUpdates_tow :: Word32
_msgInsUpdates_zerovel :: MsgInsUpdates -> Word8
_msgInsUpdates_nhc :: MsgInsUpdates -> Word8
_msgInsUpdates_speed :: MsgInsUpdates -> Word8
_msgInsUpdates_wheelticks :: MsgInsUpdates -> Word8
_msgInsUpdates_gnssvel :: MsgInsUpdates -> Word8
_msgInsUpdates_gnsspos :: MsgInsUpdates -> Word8
_msgInsUpdates_tow :: MsgInsUpdates -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgInsUpdates_tow
    Word8 -> Put
putWord8 Word8
_msgInsUpdates_gnsspos
    Word8 -> Put
putWord8 Word8
_msgInsUpdates_gnssvel
    Word8 -> Put
putWord8 Word8
_msgInsUpdates_wheelticks
    Word8 -> Put
putWord8 Word8
_msgInsUpdates_speed
    Word8 -> Put
putWord8 Word8
_msgInsUpdates_nhc
    Word8 -> Put
putWord8 Word8
_msgInsUpdates_zerovel

$(makeSBP 'msgInsUpdates ''MsgInsUpdates)
$(makeJSON "_msgInsUpdates_" ''MsgInsUpdates)
$(makeLenses ''MsgInsUpdates)

msgGnssTimeOffset :: Word16
msgGnssTimeOffset :: Word16
msgGnssTimeOffset = Word16
0xFF07

-- | SBP class for message MSG_GNSS_TIME_OFFSET (0xFF07).
--
-- The GNSS time offset message contains the information that is needed to
-- translate messages tagged with a local timestamp (e.g. IMU or wheeltick
-- messages) to GNSS time for the sender producing this message.
data MsgGnssTimeOffset = MsgGnssTimeOffset
  { MsgGnssTimeOffset -> Int16
_msgGnssTimeOffset_weeks      :: !Int16
    -- ^ Weeks portion of the time offset
  , MsgGnssTimeOffset -> Int32
_msgGnssTimeOffset_milliseconds :: !Int32
    -- ^ Milliseconds portion of the time offset
  , MsgGnssTimeOffset -> Int16
_msgGnssTimeOffset_microseconds :: !Int16
    -- ^ Microseconds portion of the time offset
  , MsgGnssTimeOffset -> Word8
_msgGnssTimeOffset_flags      :: !Word8
    -- ^ Status flags (reserved)
  } deriving ( Int -> MsgGnssTimeOffset -> ShowS
[MsgGnssTimeOffset] -> ShowS
MsgGnssTimeOffset -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgGnssTimeOffset] -> ShowS
$cshowList :: [MsgGnssTimeOffset] -> ShowS
show :: MsgGnssTimeOffset -> String
$cshow :: MsgGnssTimeOffset -> String
showsPrec :: Int -> MsgGnssTimeOffset -> ShowS
$cshowsPrec :: Int -> MsgGnssTimeOffset -> ShowS
Show, ReadPrec [MsgGnssTimeOffset]
ReadPrec MsgGnssTimeOffset
Int -> ReadS MsgGnssTimeOffset
ReadS [MsgGnssTimeOffset]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgGnssTimeOffset]
$creadListPrec :: ReadPrec [MsgGnssTimeOffset]
readPrec :: ReadPrec MsgGnssTimeOffset
$creadPrec :: ReadPrec MsgGnssTimeOffset
readList :: ReadS [MsgGnssTimeOffset]
$creadList :: ReadS [MsgGnssTimeOffset]
readsPrec :: Int -> ReadS MsgGnssTimeOffset
$creadsPrec :: Int -> ReadS MsgGnssTimeOffset
Read, MsgGnssTimeOffset -> MsgGnssTimeOffset -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgGnssTimeOffset -> MsgGnssTimeOffset -> Bool
$c/= :: MsgGnssTimeOffset -> MsgGnssTimeOffset -> Bool
== :: MsgGnssTimeOffset -> MsgGnssTimeOffset -> Bool
$c== :: MsgGnssTimeOffset -> MsgGnssTimeOffset -> Bool
Eq )

instance Binary MsgGnssTimeOffset where
  get :: Get MsgGnssTimeOffset
get = do
    Int16
_msgGnssTimeOffset_weeks <- (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)
    Int32
_msgGnssTimeOffset_milliseconds <- (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)
    Int16
_msgGnssTimeOffset_microseconds <- (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)
    Word8
_msgGnssTimeOffset_flags <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgGnssTimeOffset {Int16
Int32
Word8
_msgGnssTimeOffset_flags :: Word8
_msgGnssTimeOffset_microseconds :: Int16
_msgGnssTimeOffset_milliseconds :: Int32
_msgGnssTimeOffset_weeks :: Int16
_msgGnssTimeOffset_flags :: Word8
_msgGnssTimeOffset_microseconds :: Int16
_msgGnssTimeOffset_milliseconds :: Int32
_msgGnssTimeOffset_weeks :: Int16
..}

  put :: MsgGnssTimeOffset -> Put
put MsgGnssTimeOffset {Int16
Int32
Word8
_msgGnssTimeOffset_flags :: Word8
_msgGnssTimeOffset_microseconds :: Int16
_msgGnssTimeOffset_milliseconds :: Int32
_msgGnssTimeOffset_weeks :: Int16
_msgGnssTimeOffset_flags :: MsgGnssTimeOffset -> Word8
_msgGnssTimeOffset_microseconds :: MsgGnssTimeOffset -> Int16
_msgGnssTimeOffset_milliseconds :: MsgGnssTimeOffset -> Int32
_msgGnssTimeOffset_weeks :: MsgGnssTimeOffset -> 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
_msgGnssTimeOffset_weeks
    (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
_msgGnssTimeOffset_milliseconds
    (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
_msgGnssTimeOffset_microseconds
    Word8 -> Put
putWord8 Word8
_msgGnssTimeOffset_flags

$(makeSBP 'msgGnssTimeOffset ''MsgGnssTimeOffset)
$(makeJSON "_msgGnssTimeOffset_" ''MsgGnssTimeOffset)
$(makeLenses ''MsgGnssTimeOffset)

msgPpsTime :: Word16
msgPpsTime :: Word16
msgPpsTime = Word16
0xFF08

-- | SBP class for message MSG_PPS_TIME (0xFF08).
--
-- The PPS time message contains the value of the sender's local time in
-- microseconds at the moment a pulse is detected on the PPS input. This is to
-- be used for syncronisation of sensor data sampled with a local timestamp
-- (e.g. IMU or wheeltick messages) where GNSS time is unknown to the sender.
--
-- The local time used to timestamp the PPS pulse must be generated by the
-- same clock which is used to timestamp the IMU/wheel sensor data and should
-- follow the same roll-over rules.  A separate MSG_PPS_TIME message should be
-- sent for each source of sensor data which uses PPS-relative timestamping.
-- The sender ID for each of these MSG_PPS_TIME messages should match the
-- sender ID of the respective sensor data.
data MsgPpsTime = MsgPpsTime
  { MsgPpsTime -> Word64
_msgPpsTime_time :: !Word64
    -- ^ Local time in microseconds
  , MsgPpsTime -> Word8
_msgPpsTime_flags :: !Word8
    -- ^ Status flags
  } deriving ( Int -> MsgPpsTime -> ShowS
[MsgPpsTime] -> ShowS
MsgPpsTime -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgPpsTime] -> ShowS
$cshowList :: [MsgPpsTime] -> ShowS
show :: MsgPpsTime -> String
$cshow :: MsgPpsTime -> String
showsPrec :: Int -> MsgPpsTime -> ShowS
$cshowsPrec :: Int -> MsgPpsTime -> ShowS
Show, ReadPrec [MsgPpsTime]
ReadPrec MsgPpsTime
Int -> ReadS MsgPpsTime
ReadS [MsgPpsTime]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgPpsTime]
$creadListPrec :: ReadPrec [MsgPpsTime]
readPrec :: ReadPrec MsgPpsTime
$creadPrec :: ReadPrec MsgPpsTime
readList :: ReadS [MsgPpsTime]
$creadList :: ReadS [MsgPpsTime]
readsPrec :: Int -> ReadS MsgPpsTime
$creadsPrec :: Int -> ReadS MsgPpsTime
Read, MsgPpsTime -> MsgPpsTime -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgPpsTime -> MsgPpsTime -> Bool
$c/= :: MsgPpsTime -> MsgPpsTime -> Bool
== :: MsgPpsTime -> MsgPpsTime -> Bool
$c== :: MsgPpsTime -> MsgPpsTime -> Bool
Eq )

instance Binary MsgPpsTime where
  get :: Get MsgPpsTime
get = do
    Word64
_msgPpsTime_time <- Get Word64
getWord64le
    Word8
_msgPpsTime_flags <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgPpsTime {Word8
Word64
_msgPpsTime_flags :: Word8
_msgPpsTime_time :: Word64
_msgPpsTime_flags :: Word8
_msgPpsTime_time :: Word64
..}

  put :: MsgPpsTime -> Put
put MsgPpsTime {Word8
Word64
_msgPpsTime_flags :: Word8
_msgPpsTime_time :: Word64
_msgPpsTime_flags :: MsgPpsTime -> Word8
_msgPpsTime_time :: MsgPpsTime -> Word64
..} = do
    Word64 -> Put
putWord64le Word64
_msgPpsTime_time
    Word8 -> Put
putWord8 Word8
_msgPpsTime_flags

$(makeSBP 'msgPpsTime ''MsgPpsTime)
$(makeJSON "_msgPpsTime_" ''MsgPpsTime)
$(makeLenses ''MsgPpsTime)

msgSensorAidEvent :: Word16
msgSensorAidEvent :: Word16
msgSensorAidEvent = Word16
0xFF09

-- | SBP class for message MSG_SENSOR_AID_EVENT (0xFF09).
--
-- This diagnostic message contains state and update status information for
-- all sensors that are being used by the fusion engine. This message will be
-- generated asynchronously to the solution messages and will be emitted
-- anytime a sensor update is being processed.
data MsgSensorAidEvent = MsgSensorAidEvent
  { MsgSensorAidEvent -> Word32
_msgSensorAidEvent_time           :: !Word32
    -- ^ Update timestamp in milliseconds.
  , MsgSensorAidEvent -> Word8
_msgSensorAidEvent_sensor_type    :: !Word8
    -- ^ Sensor type
  , MsgSensorAidEvent -> Word16
_msgSensorAidEvent_sensor_id      :: !Word16
    -- ^ Sensor identifier
  , MsgSensorAidEvent -> Word8
_msgSensorAidEvent_sensor_state   :: !Word8
    -- ^ Reserved for future use
  , MsgSensorAidEvent -> Word8
_msgSensorAidEvent_n_available_meas :: !Word8
    -- ^ Number of available measurements in this epoch
  , MsgSensorAidEvent -> Word8
_msgSensorAidEvent_n_attempted_meas :: !Word8
    -- ^ Number of attempted measurements in this epoch
  , MsgSensorAidEvent -> Word8
_msgSensorAidEvent_n_accepted_meas :: !Word8
    -- ^ Number of accepted measurements in this epoch
  , MsgSensorAidEvent -> Word32
_msgSensorAidEvent_flags          :: !Word32
    -- ^ Reserved for future use
  } deriving ( Int -> MsgSensorAidEvent -> ShowS
[MsgSensorAidEvent] -> ShowS
MsgSensorAidEvent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgSensorAidEvent] -> ShowS
$cshowList :: [MsgSensorAidEvent] -> ShowS
show :: MsgSensorAidEvent -> String
$cshow :: MsgSensorAidEvent -> String
showsPrec :: Int -> MsgSensorAidEvent -> ShowS
$cshowsPrec :: Int -> MsgSensorAidEvent -> ShowS
Show, ReadPrec [MsgSensorAidEvent]
ReadPrec MsgSensorAidEvent
Int -> ReadS MsgSensorAidEvent
ReadS [MsgSensorAidEvent]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgSensorAidEvent]
$creadListPrec :: ReadPrec [MsgSensorAidEvent]
readPrec :: ReadPrec MsgSensorAidEvent
$creadPrec :: ReadPrec MsgSensorAidEvent
readList :: ReadS [MsgSensorAidEvent]
$creadList :: ReadS [MsgSensorAidEvent]
readsPrec :: Int -> ReadS MsgSensorAidEvent
$creadsPrec :: Int -> ReadS MsgSensorAidEvent
Read, MsgSensorAidEvent -> MsgSensorAidEvent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgSensorAidEvent -> MsgSensorAidEvent -> Bool
$c/= :: MsgSensorAidEvent -> MsgSensorAidEvent -> Bool
== :: MsgSensorAidEvent -> MsgSensorAidEvent -> Bool
$c== :: MsgSensorAidEvent -> MsgSensorAidEvent -> Bool
Eq )

instance Binary MsgSensorAidEvent where
  get :: Get MsgSensorAidEvent
get = do
    Word32
_msgSensorAidEvent_time <- Get Word32
getWord32le
    Word8
_msgSensorAidEvent_sensor_type <- Get Word8
getWord8
    Word16
_msgSensorAidEvent_sensor_id <- Get Word16
getWord16le
    Word8
_msgSensorAidEvent_sensor_state <- Get Word8
getWord8
    Word8
_msgSensorAidEvent_n_available_meas <- Get Word8
getWord8
    Word8
_msgSensorAidEvent_n_attempted_meas <- Get Word8
getWord8
    Word8
_msgSensorAidEvent_n_accepted_meas <- Get Word8
getWord8
    Word32
_msgSensorAidEvent_flags <- Get Word32
getWord32le
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgSensorAidEvent {Word8
Word16
Word32
_msgSensorAidEvent_flags :: Word32
_msgSensorAidEvent_n_accepted_meas :: Word8
_msgSensorAidEvent_n_attempted_meas :: Word8
_msgSensorAidEvent_n_available_meas :: Word8
_msgSensorAidEvent_sensor_state :: Word8
_msgSensorAidEvent_sensor_id :: Word16
_msgSensorAidEvent_sensor_type :: Word8
_msgSensorAidEvent_time :: Word32
_msgSensorAidEvent_flags :: Word32
_msgSensorAidEvent_n_accepted_meas :: Word8
_msgSensorAidEvent_n_attempted_meas :: Word8
_msgSensorAidEvent_n_available_meas :: Word8
_msgSensorAidEvent_sensor_state :: Word8
_msgSensorAidEvent_sensor_id :: Word16
_msgSensorAidEvent_sensor_type :: Word8
_msgSensorAidEvent_time :: Word32
..}

  put :: MsgSensorAidEvent -> Put
put MsgSensorAidEvent {Word8
Word16
Word32
_msgSensorAidEvent_flags :: Word32
_msgSensorAidEvent_n_accepted_meas :: Word8
_msgSensorAidEvent_n_attempted_meas :: Word8
_msgSensorAidEvent_n_available_meas :: Word8
_msgSensorAidEvent_sensor_state :: Word8
_msgSensorAidEvent_sensor_id :: Word16
_msgSensorAidEvent_sensor_type :: Word8
_msgSensorAidEvent_time :: Word32
_msgSensorAidEvent_flags :: MsgSensorAidEvent -> Word32
_msgSensorAidEvent_n_accepted_meas :: MsgSensorAidEvent -> Word8
_msgSensorAidEvent_n_attempted_meas :: MsgSensorAidEvent -> Word8
_msgSensorAidEvent_n_available_meas :: MsgSensorAidEvent -> Word8
_msgSensorAidEvent_sensor_state :: MsgSensorAidEvent -> Word8
_msgSensorAidEvent_sensor_id :: MsgSensorAidEvent -> Word16
_msgSensorAidEvent_sensor_type :: MsgSensorAidEvent -> Word8
_msgSensorAidEvent_time :: MsgSensorAidEvent -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgSensorAidEvent_time
    Word8 -> Put
putWord8 Word8
_msgSensorAidEvent_sensor_type
    Word16 -> Put
putWord16le Word16
_msgSensorAidEvent_sensor_id
    Word8 -> Put
putWord8 Word8
_msgSensorAidEvent_sensor_state
    Word8 -> Put
putWord8 Word8
_msgSensorAidEvent_n_available_meas
    Word8 -> Put
putWord8 Word8
_msgSensorAidEvent_n_attempted_meas
    Word8 -> Put
putWord8 Word8
_msgSensorAidEvent_n_accepted_meas
    Word32 -> Put
putWord32le Word32
_msgSensorAidEvent_flags

$(makeSBP 'msgSensorAidEvent ''MsgSensorAidEvent)
$(makeJSON "_msgSensorAidEvent_" ''MsgSensorAidEvent)
$(makeLenses ''MsgSensorAidEvent)

msgGroupMeta :: Word16
msgGroupMeta :: Word16
msgGroupMeta = Word16
0xFF0A

-- | SBP class for message MSG_GROUP_META (0xFF0A).
--
-- This leading message lists the time metadata of the Solution Group. It also
-- lists the atomic contents (i.e. types of messages included) of the Solution
-- Group.
data MsgGroupMeta = MsgGroupMeta
  { MsgGroupMeta -> Word8
_msgGroupMeta_group_id   :: !Word8
    -- ^ Id of the Msgs Group, 0 is Unknown, 1 is Bestpos, 2 is Gnss
  , MsgGroupMeta -> Word8
_msgGroupMeta_flags      :: !Word8
    -- ^ Status flags (reserved)
  , MsgGroupMeta -> Word8
_msgGroupMeta_n_group_msgs :: !Word8
    -- ^ Size of list group_msgs
  , MsgGroupMeta -> [Word16]
_msgGroupMeta_group_msgs :: ![Word16]
    -- ^ An in-order list of message types included in the Solution Group,
    -- including GROUP_META itself
  } deriving ( Int -> MsgGroupMeta -> ShowS
[MsgGroupMeta] -> ShowS
MsgGroupMeta -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgGroupMeta] -> ShowS
$cshowList :: [MsgGroupMeta] -> ShowS
show :: MsgGroupMeta -> String
$cshow :: MsgGroupMeta -> String
showsPrec :: Int -> MsgGroupMeta -> ShowS
$cshowsPrec :: Int -> MsgGroupMeta -> ShowS
Show, ReadPrec [MsgGroupMeta]
ReadPrec MsgGroupMeta
Int -> ReadS MsgGroupMeta
ReadS [MsgGroupMeta]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgGroupMeta]
$creadListPrec :: ReadPrec [MsgGroupMeta]
readPrec :: ReadPrec MsgGroupMeta
$creadPrec :: ReadPrec MsgGroupMeta
readList :: ReadS [MsgGroupMeta]
$creadList :: ReadS [MsgGroupMeta]
readsPrec :: Int -> ReadS MsgGroupMeta
$creadsPrec :: Int -> ReadS MsgGroupMeta
Read, MsgGroupMeta -> MsgGroupMeta -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgGroupMeta -> MsgGroupMeta -> Bool
$c/= :: MsgGroupMeta -> MsgGroupMeta -> Bool
== :: MsgGroupMeta -> MsgGroupMeta -> Bool
$c== :: MsgGroupMeta -> MsgGroupMeta -> Bool
Eq )

instance Binary MsgGroupMeta where
  get :: Get MsgGroupMeta
get = do
    Word8
_msgGroupMeta_group_id <- Get Word8
getWord8
    Word8
_msgGroupMeta_flags <- Get Word8
getWord8
    Word8
_msgGroupMeta_n_group_msgs <- Get Word8
getWord8
    [Word16]
_msgGroupMeta_group_msgs <- 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 Word16
getWord16le
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgGroupMeta {[Word16]
Word8
_msgGroupMeta_group_msgs :: [Word16]
_msgGroupMeta_n_group_msgs :: Word8
_msgGroupMeta_flags :: Word8
_msgGroupMeta_group_id :: Word8
_msgGroupMeta_group_msgs :: [Word16]
_msgGroupMeta_n_group_msgs :: Word8
_msgGroupMeta_flags :: Word8
_msgGroupMeta_group_id :: Word8
..}

  put :: MsgGroupMeta -> Put
put MsgGroupMeta {[Word16]
Word8
_msgGroupMeta_group_msgs :: [Word16]
_msgGroupMeta_n_group_msgs :: Word8
_msgGroupMeta_flags :: Word8
_msgGroupMeta_group_id :: Word8
_msgGroupMeta_group_msgs :: MsgGroupMeta -> [Word16]
_msgGroupMeta_n_group_msgs :: MsgGroupMeta -> Word8
_msgGroupMeta_flags :: MsgGroupMeta -> Word8
_msgGroupMeta_group_id :: MsgGroupMeta -> Word8
..} = do
    Word8 -> Put
putWord8 Word8
_msgGroupMeta_group_id
    Word8 -> Put
putWord8 Word8
_msgGroupMeta_flags
    Word8 -> Put
putWord8 Word8
_msgGroupMeta_n_group_msgs
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word16 -> Put
putWord16le [Word16]
_msgGroupMeta_group_msgs

$(makeSBP 'msgGroupMeta ''MsgGroupMeta)
$(makeJSON "_msgGroupMeta_" ''MsgGroupMeta)
$(makeLenses ''MsgGroupMeta)