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

-- |
-- Module:      SwiftNav.SBP.Navigation
-- Copyright:   Copyright (C) 2015-2021 Swift Navigation, Inc.
-- License:     MIT
-- Contact:     https://support.swiftnav.com
-- Stability:   experimental
-- Portability: portable
--
-- \< Geodetic navigation messages reporting GPS time, position, velocity, and
-- baseline position solutions. For position solutions, these messages define
-- several different position solutions: single-point (SPP), RTK, and pseudo-
-- absolute position solutions.
--
-- The SPP is the standalone, absolute GPS position solution using only a
-- single receiver. The RTK solution is the differential GPS solution, which
-- can use either a fixed/integer or floating carrier phase ambiguity. The
-- pseudo-absolute position solution uses a user-provided, well-surveyed base
-- station position (if available) and the RTK solution in tandem.
--
-- When the inertial navigation mode indicates that the IMU is used, all
-- messages are reported in the vehicle body frame as defined by device
-- settings.  By default, the vehicle body frame is configured to be
-- coincident with the antenna phase center.  When there is no inertial
-- navigation, the solution will be reported at the phase center of the
-- antenna. There is no inertial navigation capability on Piksi Multi or Duro.
--
-- The tow field, when valid, is most often the Time of Measurement. When this
-- is the case, the 5th bit of flags is set to the default value of 0. When
-- this is not the case, the tow may be a time of arrival or a local system
-- timestamp, irrespective of the time reference (GPS Week or else), but not a
-- Time of Measurement. \>

module SwiftNav.SBP.Navigation
  ( module SwiftNav.SBP.Navigation
  ) 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) #-}


msgGpsTime :: Word16
msgGpsTime :: Word16
msgGpsTime = Word16
0x0102

-- | SBP class for message MSG_GPS_TIME (0x0102).
--
-- This message reports the GPS time, representing the time since the GPS
-- epoch began on midnight January 6, 1980 UTC. GPS time counts the weeks and
-- seconds of the week. The weeks begin at the Saturday/Sunday transition. GPS
-- week 0 began at the beginning of the GPS time scale.
--
-- Within each week number, the GPS time of the week is between between 0 and
-- 604800 seconds (=60*60*24*7). Note that GPS time does not accumulate leap
-- seconds, and as of now, has a small offset from UTC. In a message stream,
-- this message precedes a set of other navigation messages referenced to the
-- same time (but lacking the ns field) and indicates a more precise time of
-- these messages.
data MsgGpsTime = MsgGpsTime
  { MsgGpsTime -> Word16
_msgGpsTime_wn        :: !Word16
    -- ^ GPS week number
  , MsgGpsTime -> Word32
_msgGpsTime_tow       :: !Word32
    -- ^ GPS time of week rounded to the nearest millisecond
  , MsgGpsTime -> Int32
_msgGpsTime_ns_residual :: !Int32
    -- ^ Nanosecond residual of millisecond-rounded TOW (ranges from -500000 to
    -- 500000)
  , MsgGpsTime -> Word8
_msgGpsTime_flags     :: !Word8
    -- ^ Status flags (reserved)
  } deriving ( Int -> MsgGpsTime -> ShowS
[MsgGpsTime] -> ShowS
MsgGpsTime -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgGpsTime] -> ShowS
$cshowList :: [MsgGpsTime] -> ShowS
show :: MsgGpsTime -> String
$cshow :: MsgGpsTime -> String
showsPrec :: Int -> MsgGpsTime -> ShowS
$cshowsPrec :: Int -> MsgGpsTime -> ShowS
Show, ReadPrec [MsgGpsTime]
ReadPrec MsgGpsTime
Int -> ReadS MsgGpsTime
ReadS [MsgGpsTime]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgGpsTime]
$creadListPrec :: ReadPrec [MsgGpsTime]
readPrec :: ReadPrec MsgGpsTime
$creadPrec :: ReadPrec MsgGpsTime
readList :: ReadS [MsgGpsTime]
$creadList :: ReadS [MsgGpsTime]
readsPrec :: Int -> ReadS MsgGpsTime
$creadsPrec :: Int -> ReadS MsgGpsTime
Read, MsgGpsTime -> MsgGpsTime -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgGpsTime -> MsgGpsTime -> Bool
$c/= :: MsgGpsTime -> MsgGpsTime -> Bool
== :: MsgGpsTime -> MsgGpsTime -> Bool
$c== :: MsgGpsTime -> MsgGpsTime -> Bool
Eq )

instance Binary MsgGpsTime where
  get :: Get MsgGpsTime
get = do
    Word16
_msgGpsTime_wn <- Get Word16
getWord16le
    Word32
_msgGpsTime_tow <- Get Word32
getWord32le
    Int32
_msgGpsTime_ns_residual <- (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)
    Word8
_msgGpsTime_flags <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgGpsTime {Int32
Word8
Word16
Word32
_msgGpsTime_flags :: Word8
_msgGpsTime_ns_residual :: Int32
_msgGpsTime_tow :: Word32
_msgGpsTime_wn :: Word16
_msgGpsTime_flags :: Word8
_msgGpsTime_ns_residual :: Int32
_msgGpsTime_tow :: Word32
_msgGpsTime_wn :: Word16
..}

  put :: MsgGpsTime -> Put
put MsgGpsTime {Int32
Word8
Word16
Word32
_msgGpsTime_flags :: Word8
_msgGpsTime_ns_residual :: Int32
_msgGpsTime_tow :: Word32
_msgGpsTime_wn :: Word16
_msgGpsTime_flags :: MsgGpsTime -> Word8
_msgGpsTime_ns_residual :: MsgGpsTime -> Int32
_msgGpsTime_tow :: MsgGpsTime -> Word32
_msgGpsTime_wn :: MsgGpsTime -> Word16
..} = do
    Word16 -> Put
putWord16le Word16
_msgGpsTime_wn
    Word32 -> Put
putWord32le Word32
_msgGpsTime_tow
    (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
_msgGpsTime_ns_residual
    Word8 -> Put
putWord8 Word8
_msgGpsTime_flags

$(makeSBP 'msgGpsTime ''MsgGpsTime)
$(makeJSON "_msgGpsTime_" ''MsgGpsTime)
$(makeLenses ''MsgGpsTime)

msgGpsTimeGnss :: Word16
msgGpsTimeGnss :: Word16
msgGpsTimeGnss = Word16
0x0104

-- | SBP class for message MSG_GPS_TIME_GNSS (0x0104).
--
-- This message reports the GPS time, representing the time since the GPS
-- epoch began on midnight January 6, 1980 UTC. GPS time counts the weeks and
-- seconds of the week. The weeks begin at the Saturday/Sunday transition. GPS
-- week 0 began at the beginning of the GPS time scale.
--
-- Within each week number, the GPS time of the week is between between 0 and
-- 604800 seconds (=60*60*24*7). Note that GPS time does not accumulate leap
-- seconds, and as of now, has a small offset from UTC. In a message stream,
-- this message precedes a set of other navigation messages referenced to the
-- same time (but lacking the ns field) and indicates a more precise time of
-- these messages.
data MsgGpsTimeGnss = MsgGpsTimeGnss
  { MsgGpsTimeGnss -> Word16
_msgGpsTimeGnss_wn        :: !Word16
    -- ^ GPS week number
  , MsgGpsTimeGnss -> Word32
_msgGpsTimeGnss_tow       :: !Word32
    -- ^ GPS time of week rounded to the nearest millisecond
  , MsgGpsTimeGnss -> Int32
_msgGpsTimeGnss_ns_residual :: !Int32
    -- ^ Nanosecond residual of millisecond-rounded TOW (ranges from -500000 to
    -- 500000)
  , MsgGpsTimeGnss -> Word8
_msgGpsTimeGnss_flags     :: !Word8
    -- ^ Status flags (reserved)
  } deriving ( Int -> MsgGpsTimeGnss -> ShowS
[MsgGpsTimeGnss] -> ShowS
MsgGpsTimeGnss -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgGpsTimeGnss] -> ShowS
$cshowList :: [MsgGpsTimeGnss] -> ShowS
show :: MsgGpsTimeGnss -> String
$cshow :: MsgGpsTimeGnss -> String
showsPrec :: Int -> MsgGpsTimeGnss -> ShowS
$cshowsPrec :: Int -> MsgGpsTimeGnss -> ShowS
Show, ReadPrec [MsgGpsTimeGnss]
ReadPrec MsgGpsTimeGnss
Int -> ReadS MsgGpsTimeGnss
ReadS [MsgGpsTimeGnss]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgGpsTimeGnss]
$creadListPrec :: ReadPrec [MsgGpsTimeGnss]
readPrec :: ReadPrec MsgGpsTimeGnss
$creadPrec :: ReadPrec MsgGpsTimeGnss
readList :: ReadS [MsgGpsTimeGnss]
$creadList :: ReadS [MsgGpsTimeGnss]
readsPrec :: Int -> ReadS MsgGpsTimeGnss
$creadsPrec :: Int -> ReadS MsgGpsTimeGnss
Read, MsgGpsTimeGnss -> MsgGpsTimeGnss -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgGpsTimeGnss -> MsgGpsTimeGnss -> Bool
$c/= :: MsgGpsTimeGnss -> MsgGpsTimeGnss -> Bool
== :: MsgGpsTimeGnss -> MsgGpsTimeGnss -> Bool
$c== :: MsgGpsTimeGnss -> MsgGpsTimeGnss -> Bool
Eq )

instance Binary MsgGpsTimeGnss where
  get :: Get MsgGpsTimeGnss
get = do
    Word16
_msgGpsTimeGnss_wn <- Get Word16
getWord16le
    Word32
_msgGpsTimeGnss_tow <- Get Word32
getWord32le
    Int32
_msgGpsTimeGnss_ns_residual <- (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)
    Word8
_msgGpsTimeGnss_flags <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgGpsTimeGnss {Int32
Word8
Word16
Word32
_msgGpsTimeGnss_flags :: Word8
_msgGpsTimeGnss_ns_residual :: Int32
_msgGpsTimeGnss_tow :: Word32
_msgGpsTimeGnss_wn :: Word16
_msgGpsTimeGnss_flags :: Word8
_msgGpsTimeGnss_ns_residual :: Int32
_msgGpsTimeGnss_tow :: Word32
_msgGpsTimeGnss_wn :: Word16
..}

  put :: MsgGpsTimeGnss -> Put
put MsgGpsTimeGnss {Int32
Word8
Word16
Word32
_msgGpsTimeGnss_flags :: Word8
_msgGpsTimeGnss_ns_residual :: Int32
_msgGpsTimeGnss_tow :: Word32
_msgGpsTimeGnss_wn :: Word16
_msgGpsTimeGnss_flags :: MsgGpsTimeGnss -> Word8
_msgGpsTimeGnss_ns_residual :: MsgGpsTimeGnss -> Int32
_msgGpsTimeGnss_tow :: MsgGpsTimeGnss -> Word32
_msgGpsTimeGnss_wn :: MsgGpsTimeGnss -> Word16
..} = do
    Word16 -> Put
putWord16le Word16
_msgGpsTimeGnss_wn
    Word32 -> Put
putWord32le Word32
_msgGpsTimeGnss_tow
    (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
_msgGpsTimeGnss_ns_residual
    Word8 -> Put
putWord8 Word8
_msgGpsTimeGnss_flags

$(makeSBP 'msgGpsTimeGnss ''MsgGpsTimeGnss)
$(makeJSON "_msgGpsTimeGnss_" ''MsgGpsTimeGnss)
$(makeLenses ''MsgGpsTimeGnss)

msgUtcTime :: Word16
msgUtcTime :: Word16
msgUtcTime = Word16
0x0103

-- | SBP class for message MSG_UTC_TIME (0x0103).
--
-- This message reports the Universal Coordinated Time (UTC).  Note the flags
-- which indicate the source of the UTC offset value and source of the time
-- fix.
data MsgUtcTime = MsgUtcTime
  { MsgUtcTime -> Word8
_msgUtcTime_flags :: !Word8
    -- ^ Indicates source and time validity
  , MsgUtcTime -> Word32
_msgUtcTime_tow   :: !Word32
    -- ^ GPS time of week rounded to the nearest millisecond
  , MsgUtcTime -> Word16
_msgUtcTime_year  :: !Word16
    -- ^ Year
  , MsgUtcTime -> Word8
_msgUtcTime_month :: !Word8
    -- ^ Month (range 1 .. 12)
  , MsgUtcTime -> Word8
_msgUtcTime_day   :: !Word8
    -- ^ days in the month (range 1-31)
  , MsgUtcTime -> Word8
_msgUtcTime_hours :: !Word8
    -- ^ hours of day (range 0-23)
  , MsgUtcTime -> Word8
_msgUtcTime_minutes :: !Word8
    -- ^ minutes of hour (range 0-59)
  , MsgUtcTime -> Word8
_msgUtcTime_seconds :: !Word8
    -- ^ seconds of minute (range 0-60) rounded down
  , MsgUtcTime -> Word32
_msgUtcTime_ns    :: !Word32
    -- ^ nanoseconds of second (range 0-999999999)
  } deriving ( Int -> MsgUtcTime -> ShowS
[MsgUtcTime] -> ShowS
MsgUtcTime -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgUtcTime] -> ShowS
$cshowList :: [MsgUtcTime] -> ShowS
show :: MsgUtcTime -> String
$cshow :: MsgUtcTime -> String
showsPrec :: Int -> MsgUtcTime -> ShowS
$cshowsPrec :: Int -> MsgUtcTime -> ShowS
Show, ReadPrec [MsgUtcTime]
ReadPrec MsgUtcTime
Int -> ReadS MsgUtcTime
ReadS [MsgUtcTime]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgUtcTime]
$creadListPrec :: ReadPrec [MsgUtcTime]
readPrec :: ReadPrec MsgUtcTime
$creadPrec :: ReadPrec MsgUtcTime
readList :: ReadS [MsgUtcTime]
$creadList :: ReadS [MsgUtcTime]
readsPrec :: Int -> ReadS MsgUtcTime
$creadsPrec :: Int -> ReadS MsgUtcTime
Read, MsgUtcTime -> MsgUtcTime -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgUtcTime -> MsgUtcTime -> Bool
$c/= :: MsgUtcTime -> MsgUtcTime -> Bool
== :: MsgUtcTime -> MsgUtcTime -> Bool
$c== :: MsgUtcTime -> MsgUtcTime -> Bool
Eq )

instance Binary MsgUtcTime where
  get :: Get MsgUtcTime
get = do
    Word8
_msgUtcTime_flags <- Get Word8
getWord8
    Word32
_msgUtcTime_tow <- Get Word32
getWord32le
    Word16
_msgUtcTime_year <- Get Word16
getWord16le
    Word8
_msgUtcTime_month <- Get Word8
getWord8
    Word8
_msgUtcTime_day <- Get Word8
getWord8
    Word8
_msgUtcTime_hours <- Get Word8
getWord8
    Word8
_msgUtcTime_minutes <- Get Word8
getWord8
    Word8
_msgUtcTime_seconds <- Get Word8
getWord8
    Word32
_msgUtcTime_ns <- Get Word32
getWord32le
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgUtcTime {Word8
Word16
Word32
_msgUtcTime_ns :: Word32
_msgUtcTime_seconds :: Word8
_msgUtcTime_minutes :: Word8
_msgUtcTime_hours :: Word8
_msgUtcTime_day :: Word8
_msgUtcTime_month :: Word8
_msgUtcTime_year :: Word16
_msgUtcTime_tow :: Word32
_msgUtcTime_flags :: Word8
_msgUtcTime_ns :: Word32
_msgUtcTime_seconds :: Word8
_msgUtcTime_minutes :: Word8
_msgUtcTime_hours :: Word8
_msgUtcTime_day :: Word8
_msgUtcTime_month :: Word8
_msgUtcTime_year :: Word16
_msgUtcTime_tow :: Word32
_msgUtcTime_flags :: Word8
..}

  put :: MsgUtcTime -> Put
put MsgUtcTime {Word8
Word16
Word32
_msgUtcTime_ns :: Word32
_msgUtcTime_seconds :: Word8
_msgUtcTime_minutes :: Word8
_msgUtcTime_hours :: Word8
_msgUtcTime_day :: Word8
_msgUtcTime_month :: Word8
_msgUtcTime_year :: Word16
_msgUtcTime_tow :: Word32
_msgUtcTime_flags :: Word8
_msgUtcTime_ns :: MsgUtcTime -> Word32
_msgUtcTime_seconds :: MsgUtcTime -> Word8
_msgUtcTime_minutes :: MsgUtcTime -> Word8
_msgUtcTime_hours :: MsgUtcTime -> Word8
_msgUtcTime_day :: MsgUtcTime -> Word8
_msgUtcTime_month :: MsgUtcTime -> Word8
_msgUtcTime_year :: MsgUtcTime -> Word16
_msgUtcTime_tow :: MsgUtcTime -> Word32
_msgUtcTime_flags :: MsgUtcTime -> Word8
..} = do
    Word8 -> Put
putWord8 Word8
_msgUtcTime_flags
    Word32 -> Put
putWord32le Word32
_msgUtcTime_tow
    Word16 -> Put
putWord16le Word16
_msgUtcTime_year
    Word8 -> Put
putWord8 Word8
_msgUtcTime_month
    Word8 -> Put
putWord8 Word8
_msgUtcTime_day
    Word8 -> Put
putWord8 Word8
_msgUtcTime_hours
    Word8 -> Put
putWord8 Word8
_msgUtcTime_minutes
    Word8 -> Put
putWord8 Word8
_msgUtcTime_seconds
    Word32 -> Put
putWord32le Word32
_msgUtcTime_ns

$(makeSBP 'msgUtcTime ''MsgUtcTime)
$(makeJSON "_msgUtcTime_" ''MsgUtcTime)
$(makeLenses ''MsgUtcTime)

msgUtcTimeGnss :: Word16
msgUtcTimeGnss :: Word16
msgUtcTimeGnss = Word16
0x0105

-- | SBP class for message MSG_UTC_TIME_GNSS (0x0105).
--
-- This message reports the Universal Coordinated Time (UTC).  Note the flags
-- which indicate the source of the UTC offset value and source of the time
-- fix.
data MsgUtcTimeGnss = MsgUtcTimeGnss
  { MsgUtcTimeGnss -> Word8
_msgUtcTimeGnss_flags :: !Word8
    -- ^ Indicates source and time validity
  , MsgUtcTimeGnss -> Word32
_msgUtcTimeGnss_tow   :: !Word32
    -- ^ GPS time of week rounded to the nearest millisecond
  , MsgUtcTimeGnss -> Word16
_msgUtcTimeGnss_year  :: !Word16
    -- ^ Year
  , MsgUtcTimeGnss -> Word8
_msgUtcTimeGnss_month :: !Word8
    -- ^ Month (range 1 .. 12)
  , MsgUtcTimeGnss -> Word8
_msgUtcTimeGnss_day   :: !Word8
    -- ^ days in the month (range 1-31)
  , MsgUtcTimeGnss -> Word8
_msgUtcTimeGnss_hours :: !Word8
    -- ^ hours of day (range 0-23)
  , MsgUtcTimeGnss -> Word8
_msgUtcTimeGnss_minutes :: !Word8
    -- ^ minutes of hour (range 0-59)
  , MsgUtcTimeGnss -> Word8
_msgUtcTimeGnss_seconds :: !Word8
    -- ^ seconds of minute (range 0-60) rounded down
  , MsgUtcTimeGnss -> Word32
_msgUtcTimeGnss_ns    :: !Word32
    -- ^ nanoseconds of second (range 0-999999999)
  } deriving ( Int -> MsgUtcTimeGnss -> ShowS
[MsgUtcTimeGnss] -> ShowS
MsgUtcTimeGnss -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgUtcTimeGnss] -> ShowS
$cshowList :: [MsgUtcTimeGnss] -> ShowS
show :: MsgUtcTimeGnss -> String
$cshow :: MsgUtcTimeGnss -> String
showsPrec :: Int -> MsgUtcTimeGnss -> ShowS
$cshowsPrec :: Int -> MsgUtcTimeGnss -> ShowS
Show, ReadPrec [MsgUtcTimeGnss]
ReadPrec MsgUtcTimeGnss
Int -> ReadS MsgUtcTimeGnss
ReadS [MsgUtcTimeGnss]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgUtcTimeGnss]
$creadListPrec :: ReadPrec [MsgUtcTimeGnss]
readPrec :: ReadPrec MsgUtcTimeGnss
$creadPrec :: ReadPrec MsgUtcTimeGnss
readList :: ReadS [MsgUtcTimeGnss]
$creadList :: ReadS [MsgUtcTimeGnss]
readsPrec :: Int -> ReadS MsgUtcTimeGnss
$creadsPrec :: Int -> ReadS MsgUtcTimeGnss
Read, MsgUtcTimeGnss -> MsgUtcTimeGnss -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgUtcTimeGnss -> MsgUtcTimeGnss -> Bool
$c/= :: MsgUtcTimeGnss -> MsgUtcTimeGnss -> Bool
== :: MsgUtcTimeGnss -> MsgUtcTimeGnss -> Bool
$c== :: MsgUtcTimeGnss -> MsgUtcTimeGnss -> Bool
Eq )

instance Binary MsgUtcTimeGnss where
  get :: Get MsgUtcTimeGnss
get = do
    Word8
_msgUtcTimeGnss_flags <- Get Word8
getWord8
    Word32
_msgUtcTimeGnss_tow <- Get Word32
getWord32le
    Word16
_msgUtcTimeGnss_year <- Get Word16
getWord16le
    Word8
_msgUtcTimeGnss_month <- Get Word8
getWord8
    Word8
_msgUtcTimeGnss_day <- Get Word8
getWord8
    Word8
_msgUtcTimeGnss_hours <- Get Word8
getWord8
    Word8
_msgUtcTimeGnss_minutes <- Get Word8
getWord8
    Word8
_msgUtcTimeGnss_seconds <- Get Word8
getWord8
    Word32
_msgUtcTimeGnss_ns <- Get Word32
getWord32le
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgUtcTimeGnss {Word8
Word16
Word32
_msgUtcTimeGnss_ns :: Word32
_msgUtcTimeGnss_seconds :: Word8
_msgUtcTimeGnss_minutes :: Word8
_msgUtcTimeGnss_hours :: Word8
_msgUtcTimeGnss_day :: Word8
_msgUtcTimeGnss_month :: Word8
_msgUtcTimeGnss_year :: Word16
_msgUtcTimeGnss_tow :: Word32
_msgUtcTimeGnss_flags :: Word8
_msgUtcTimeGnss_ns :: Word32
_msgUtcTimeGnss_seconds :: Word8
_msgUtcTimeGnss_minutes :: Word8
_msgUtcTimeGnss_hours :: Word8
_msgUtcTimeGnss_day :: Word8
_msgUtcTimeGnss_month :: Word8
_msgUtcTimeGnss_year :: Word16
_msgUtcTimeGnss_tow :: Word32
_msgUtcTimeGnss_flags :: Word8
..}

  put :: MsgUtcTimeGnss -> Put
put MsgUtcTimeGnss {Word8
Word16
Word32
_msgUtcTimeGnss_ns :: Word32
_msgUtcTimeGnss_seconds :: Word8
_msgUtcTimeGnss_minutes :: Word8
_msgUtcTimeGnss_hours :: Word8
_msgUtcTimeGnss_day :: Word8
_msgUtcTimeGnss_month :: Word8
_msgUtcTimeGnss_year :: Word16
_msgUtcTimeGnss_tow :: Word32
_msgUtcTimeGnss_flags :: Word8
_msgUtcTimeGnss_ns :: MsgUtcTimeGnss -> Word32
_msgUtcTimeGnss_seconds :: MsgUtcTimeGnss -> Word8
_msgUtcTimeGnss_minutes :: MsgUtcTimeGnss -> Word8
_msgUtcTimeGnss_hours :: MsgUtcTimeGnss -> Word8
_msgUtcTimeGnss_day :: MsgUtcTimeGnss -> Word8
_msgUtcTimeGnss_month :: MsgUtcTimeGnss -> Word8
_msgUtcTimeGnss_year :: MsgUtcTimeGnss -> Word16
_msgUtcTimeGnss_tow :: MsgUtcTimeGnss -> Word32
_msgUtcTimeGnss_flags :: MsgUtcTimeGnss -> Word8
..} = do
    Word8 -> Put
putWord8 Word8
_msgUtcTimeGnss_flags
    Word32 -> Put
putWord32le Word32
_msgUtcTimeGnss_tow
    Word16 -> Put
putWord16le Word16
_msgUtcTimeGnss_year
    Word8 -> Put
putWord8 Word8
_msgUtcTimeGnss_month
    Word8 -> Put
putWord8 Word8
_msgUtcTimeGnss_day
    Word8 -> Put
putWord8 Word8
_msgUtcTimeGnss_hours
    Word8 -> Put
putWord8 Word8
_msgUtcTimeGnss_minutes
    Word8 -> Put
putWord8 Word8
_msgUtcTimeGnss_seconds
    Word32 -> Put
putWord32le Word32
_msgUtcTimeGnss_ns

$(makeSBP 'msgUtcTimeGnss ''MsgUtcTimeGnss)
$(makeJSON "_msgUtcTimeGnss_" ''MsgUtcTimeGnss)
$(makeLenses ''MsgUtcTimeGnss)

msgDops :: Word16
msgDops :: Word16
msgDops = Word16
0x0208

-- | SBP class for message MSG_DOPS (0x0208).
--
-- This dilution of precision (DOP) message describes the effect of navigation
-- satellite geometry on positional measurement precision.  The flags field
-- indicated whether the DOP reported corresponds to differential or SPP
-- solution.
data MsgDops = MsgDops
  { MsgDops -> Word32
_msgDops_tow :: !Word32
    -- ^ GPS Time of Week
  , MsgDops -> Word16
_msgDops_gdop :: !Word16
    -- ^ Geometric Dilution of Precision
  , MsgDops -> Word16
_msgDops_pdop :: !Word16
    -- ^ Position Dilution of Precision
  , MsgDops -> Word16
_msgDops_tdop :: !Word16
    -- ^ Time Dilution of Precision
  , MsgDops -> Word16
_msgDops_hdop :: !Word16
    -- ^ Horizontal Dilution of Precision
  , MsgDops -> Word16
_msgDops_vdop :: !Word16
    -- ^ Vertical Dilution of Precision
  , MsgDops -> Word8
_msgDops_flags :: !Word8
    -- ^ Indicates the position solution with which the DOPS message corresponds
  } deriving ( Int -> MsgDops -> ShowS
[MsgDops] -> ShowS
MsgDops -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgDops] -> ShowS
$cshowList :: [MsgDops] -> ShowS
show :: MsgDops -> String
$cshow :: MsgDops -> String
showsPrec :: Int -> MsgDops -> ShowS
$cshowsPrec :: Int -> MsgDops -> ShowS
Show, ReadPrec [MsgDops]
ReadPrec MsgDops
Int -> ReadS MsgDops
ReadS [MsgDops]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgDops]
$creadListPrec :: ReadPrec [MsgDops]
readPrec :: ReadPrec MsgDops
$creadPrec :: ReadPrec MsgDops
readList :: ReadS [MsgDops]
$creadList :: ReadS [MsgDops]
readsPrec :: Int -> ReadS MsgDops
$creadsPrec :: Int -> ReadS MsgDops
Read, MsgDops -> MsgDops -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgDops -> MsgDops -> Bool
$c/= :: MsgDops -> MsgDops -> Bool
== :: MsgDops -> MsgDops -> Bool
$c== :: MsgDops -> MsgDops -> Bool
Eq )

instance Binary MsgDops where
  get :: Get MsgDops
get = do
    Word32
_msgDops_tow <- Get Word32
getWord32le
    Word16
_msgDops_gdop <- Get Word16
getWord16le
    Word16
_msgDops_pdop <- Get Word16
getWord16le
    Word16
_msgDops_tdop <- Get Word16
getWord16le
    Word16
_msgDops_hdop <- Get Word16
getWord16le
    Word16
_msgDops_vdop <- Get Word16
getWord16le
    Word8
_msgDops_flags <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgDops {Word8
Word16
Word32
_msgDops_flags :: Word8
_msgDops_vdop :: Word16
_msgDops_hdop :: Word16
_msgDops_tdop :: Word16
_msgDops_pdop :: Word16
_msgDops_gdop :: Word16
_msgDops_tow :: Word32
_msgDops_flags :: Word8
_msgDops_vdop :: Word16
_msgDops_hdop :: Word16
_msgDops_tdop :: Word16
_msgDops_pdop :: Word16
_msgDops_gdop :: Word16
_msgDops_tow :: Word32
..}

  put :: MsgDops -> Put
put MsgDops {Word8
Word16
Word32
_msgDops_flags :: Word8
_msgDops_vdop :: Word16
_msgDops_hdop :: Word16
_msgDops_tdop :: Word16
_msgDops_pdop :: Word16
_msgDops_gdop :: Word16
_msgDops_tow :: Word32
_msgDops_flags :: MsgDops -> Word8
_msgDops_vdop :: MsgDops -> Word16
_msgDops_hdop :: MsgDops -> Word16
_msgDops_tdop :: MsgDops -> Word16
_msgDops_pdop :: MsgDops -> Word16
_msgDops_gdop :: MsgDops -> Word16
_msgDops_tow :: MsgDops -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgDops_tow
    Word16 -> Put
putWord16le Word16
_msgDops_gdop
    Word16 -> Put
putWord16le Word16
_msgDops_pdop
    Word16 -> Put
putWord16le Word16
_msgDops_tdop
    Word16 -> Put
putWord16le Word16
_msgDops_hdop
    Word16 -> Put
putWord16le Word16
_msgDops_vdop
    Word8 -> Put
putWord8 Word8
_msgDops_flags

$(makeSBP 'msgDops ''MsgDops)
$(makeJSON "_msgDops_" ''MsgDops)
$(makeLenses ''MsgDops)

msgPosEcef :: Word16
msgPosEcef :: Word16
msgPosEcef = Word16
0x0209

-- | SBP class for message MSG_POS_ECEF (0x0209).
--
-- The position solution message reports absolute Earth Centered Earth Fixed
-- (ECEF) coordinates and the status (single point vs pseudo-absolute RTK) of
-- the position solution. If the rover receiver knows the surveyed position of
-- the base station and has an RTK solution, this reports a pseudo-absolute
-- position solution using the base station position and the rover's RTK
-- baseline vector. The full GPS time is given by the preceding MSG_GPS_TIME
-- with the matching time-of-week (tow).
data MsgPosEcef = MsgPosEcef
  { MsgPosEcef -> Word32
_msgPosEcef_tow    :: !Word32
    -- ^ GPS Time of Week
  , MsgPosEcef -> Double
_msgPosEcef_x      :: !Double
    -- ^ ECEF X coordinate
  , MsgPosEcef -> Double
_msgPosEcef_y      :: !Double
    -- ^ ECEF Y coordinate
  , MsgPosEcef -> Double
_msgPosEcef_z      :: !Double
    -- ^ ECEF Z coordinate
  , MsgPosEcef -> Word16
_msgPosEcef_accuracy :: !Word16
    -- ^ Position estimated standard deviation
  , MsgPosEcef -> Word8
_msgPosEcef_n_sats :: !Word8
    -- ^ Number of satellites used in solution
  , MsgPosEcef -> Word8
_msgPosEcef_flags  :: !Word8
    -- ^ Status flags
  } deriving ( Int -> MsgPosEcef -> ShowS
[MsgPosEcef] -> ShowS
MsgPosEcef -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgPosEcef] -> ShowS
$cshowList :: [MsgPosEcef] -> ShowS
show :: MsgPosEcef -> String
$cshow :: MsgPosEcef -> String
showsPrec :: Int -> MsgPosEcef -> ShowS
$cshowsPrec :: Int -> MsgPosEcef -> ShowS
Show, ReadPrec [MsgPosEcef]
ReadPrec MsgPosEcef
Int -> ReadS MsgPosEcef
ReadS [MsgPosEcef]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgPosEcef]
$creadListPrec :: ReadPrec [MsgPosEcef]
readPrec :: ReadPrec MsgPosEcef
$creadPrec :: ReadPrec MsgPosEcef
readList :: ReadS [MsgPosEcef]
$creadList :: ReadS [MsgPosEcef]
readsPrec :: Int -> ReadS MsgPosEcef
$creadsPrec :: Int -> ReadS MsgPosEcef
Read, MsgPosEcef -> MsgPosEcef -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgPosEcef -> MsgPosEcef -> Bool
$c/= :: MsgPosEcef -> MsgPosEcef -> Bool
== :: MsgPosEcef -> MsgPosEcef -> Bool
$c== :: MsgPosEcef -> MsgPosEcef -> Bool
Eq )

instance Binary MsgPosEcef where
  get :: Get MsgPosEcef
get = do
    Word32
_msgPosEcef_tow <- Get Word32
getWord32le
    Double
_msgPosEcef_x <- Get Double
getFloat64le
    Double
_msgPosEcef_y <- Get Double
getFloat64le
    Double
_msgPosEcef_z <- Get Double
getFloat64le
    Word16
_msgPosEcef_accuracy <- Get Word16
getWord16le
    Word8
_msgPosEcef_n_sats <- Get Word8
getWord8
    Word8
_msgPosEcef_flags <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgPosEcef {Double
Word8
Word16
Word32
_msgPosEcef_flags :: Word8
_msgPosEcef_n_sats :: Word8
_msgPosEcef_accuracy :: Word16
_msgPosEcef_z :: Double
_msgPosEcef_y :: Double
_msgPosEcef_x :: Double
_msgPosEcef_tow :: Word32
_msgPosEcef_flags :: Word8
_msgPosEcef_n_sats :: Word8
_msgPosEcef_accuracy :: Word16
_msgPosEcef_z :: Double
_msgPosEcef_y :: Double
_msgPosEcef_x :: Double
_msgPosEcef_tow :: Word32
..}

  put :: MsgPosEcef -> Put
put MsgPosEcef {Double
Word8
Word16
Word32
_msgPosEcef_flags :: Word8
_msgPosEcef_n_sats :: Word8
_msgPosEcef_accuracy :: Word16
_msgPosEcef_z :: Double
_msgPosEcef_y :: Double
_msgPosEcef_x :: Double
_msgPosEcef_tow :: Word32
_msgPosEcef_flags :: MsgPosEcef -> Word8
_msgPosEcef_n_sats :: MsgPosEcef -> Word8
_msgPosEcef_accuracy :: MsgPosEcef -> Word16
_msgPosEcef_z :: MsgPosEcef -> Double
_msgPosEcef_y :: MsgPosEcef -> Double
_msgPosEcef_x :: MsgPosEcef -> Double
_msgPosEcef_tow :: MsgPosEcef -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgPosEcef_tow
    Double -> Put
putFloat64le Double
_msgPosEcef_x
    Double -> Put
putFloat64le Double
_msgPosEcef_y
    Double -> Put
putFloat64le Double
_msgPosEcef_z
    Word16 -> Put
putWord16le Word16
_msgPosEcef_accuracy
    Word8 -> Put
putWord8 Word8
_msgPosEcef_n_sats
    Word8 -> Put
putWord8 Word8
_msgPosEcef_flags

$(makeSBP 'msgPosEcef ''MsgPosEcef)
$(makeJSON "_msgPosEcef_" ''MsgPosEcef)
$(makeLenses ''MsgPosEcef)

msgPosEcefCov :: Word16
msgPosEcefCov :: Word16
msgPosEcefCov = Word16
0x0214

-- | SBP class for message MSG_POS_ECEF_COV (0x0214).
--
-- The position solution message reports absolute Earth Centered Earth Fixed
-- (ECEF) coordinates and the status (single point vs pseudo-absolute RTK) of
-- the position solution. The message also reports the upper triangular
-- portion of the 3x3 covariance matrix. If the receiver knows the surveyed
-- position of the base station and has an RTK solution, this reports a
-- pseudo-absolute position solution using the base station position and the
-- rover's RTK baseline vector. The full GPS time is given by the preceding
-- MSG_GPS_TIME with the matching time-of-week (tow).
data MsgPosEcefCov = MsgPosEcefCov
  { MsgPosEcefCov -> Word32
_msgPosEcefCov_tow   :: !Word32
    -- ^ GPS Time of Week
  , MsgPosEcefCov -> Double
_msgPosEcefCov_x     :: !Double
    -- ^ ECEF X coordinate
  , MsgPosEcefCov -> Double
_msgPosEcefCov_y     :: !Double
    -- ^ ECEF Y coordinate
  , MsgPosEcefCov -> Double
_msgPosEcefCov_z     :: !Double
    -- ^ ECEF Z coordinate
  , MsgPosEcefCov -> Float
_msgPosEcefCov_cov_x_x :: !Float
    -- ^ Estimated variance of x
  , MsgPosEcefCov -> Float
_msgPosEcefCov_cov_x_y :: !Float
    -- ^ Estimated covariance of x and y
  , MsgPosEcefCov -> Float
_msgPosEcefCov_cov_x_z :: !Float
    -- ^ Estimated covariance of x and z
  , MsgPosEcefCov -> Float
_msgPosEcefCov_cov_y_y :: !Float
    -- ^ Estimated variance of y
  , MsgPosEcefCov -> Float
_msgPosEcefCov_cov_y_z :: !Float
    -- ^ Estimated covariance of y and z
  , MsgPosEcefCov -> Float
_msgPosEcefCov_cov_z_z :: !Float
    -- ^ Estimated variance of z
  , MsgPosEcefCov -> Word8
_msgPosEcefCov_n_sats :: !Word8
    -- ^ Number of satellites used in solution
  , MsgPosEcefCov -> Word8
_msgPosEcefCov_flags :: !Word8
    -- ^ Status flags
  } deriving ( Int -> MsgPosEcefCov -> ShowS
[MsgPosEcefCov] -> ShowS
MsgPosEcefCov -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgPosEcefCov] -> ShowS
$cshowList :: [MsgPosEcefCov] -> ShowS
show :: MsgPosEcefCov -> String
$cshow :: MsgPosEcefCov -> String
showsPrec :: Int -> MsgPosEcefCov -> ShowS
$cshowsPrec :: Int -> MsgPosEcefCov -> ShowS
Show, ReadPrec [MsgPosEcefCov]
ReadPrec MsgPosEcefCov
Int -> ReadS MsgPosEcefCov
ReadS [MsgPosEcefCov]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgPosEcefCov]
$creadListPrec :: ReadPrec [MsgPosEcefCov]
readPrec :: ReadPrec MsgPosEcefCov
$creadPrec :: ReadPrec MsgPosEcefCov
readList :: ReadS [MsgPosEcefCov]
$creadList :: ReadS [MsgPosEcefCov]
readsPrec :: Int -> ReadS MsgPosEcefCov
$creadsPrec :: Int -> ReadS MsgPosEcefCov
Read, MsgPosEcefCov -> MsgPosEcefCov -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgPosEcefCov -> MsgPosEcefCov -> Bool
$c/= :: MsgPosEcefCov -> MsgPosEcefCov -> Bool
== :: MsgPosEcefCov -> MsgPosEcefCov -> Bool
$c== :: MsgPosEcefCov -> MsgPosEcefCov -> Bool
Eq )

instance Binary MsgPosEcefCov where
  get :: Get MsgPosEcefCov
get = do
    Word32
_msgPosEcefCov_tow <- Get Word32
getWord32le
    Double
_msgPosEcefCov_x <- Get Double
getFloat64le
    Double
_msgPosEcefCov_y <- Get Double
getFloat64le
    Double
_msgPosEcefCov_z <- Get Double
getFloat64le
    Float
_msgPosEcefCov_cov_x_x <- Get Float
getFloat32le
    Float
_msgPosEcefCov_cov_x_y <- Get Float
getFloat32le
    Float
_msgPosEcefCov_cov_x_z <- Get Float
getFloat32le
    Float
_msgPosEcefCov_cov_y_y <- Get Float
getFloat32le
    Float
_msgPosEcefCov_cov_y_z <- Get Float
getFloat32le
    Float
_msgPosEcefCov_cov_z_z <- Get Float
getFloat32le
    Word8
_msgPosEcefCov_n_sats <- Get Word8
getWord8
    Word8
_msgPosEcefCov_flags <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgPosEcefCov {Double
Float
Word8
Word32
_msgPosEcefCov_flags :: Word8
_msgPosEcefCov_n_sats :: Word8
_msgPosEcefCov_cov_z_z :: Float
_msgPosEcefCov_cov_y_z :: Float
_msgPosEcefCov_cov_y_y :: Float
_msgPosEcefCov_cov_x_z :: Float
_msgPosEcefCov_cov_x_y :: Float
_msgPosEcefCov_cov_x_x :: Float
_msgPosEcefCov_z :: Double
_msgPosEcefCov_y :: Double
_msgPosEcefCov_x :: Double
_msgPosEcefCov_tow :: Word32
_msgPosEcefCov_flags :: Word8
_msgPosEcefCov_n_sats :: Word8
_msgPosEcefCov_cov_z_z :: Float
_msgPosEcefCov_cov_y_z :: Float
_msgPosEcefCov_cov_y_y :: Float
_msgPosEcefCov_cov_x_z :: Float
_msgPosEcefCov_cov_x_y :: Float
_msgPosEcefCov_cov_x_x :: Float
_msgPosEcefCov_z :: Double
_msgPosEcefCov_y :: Double
_msgPosEcefCov_x :: Double
_msgPosEcefCov_tow :: Word32
..}

  put :: MsgPosEcefCov -> Put
put MsgPosEcefCov {Double
Float
Word8
Word32
_msgPosEcefCov_flags :: Word8
_msgPosEcefCov_n_sats :: Word8
_msgPosEcefCov_cov_z_z :: Float
_msgPosEcefCov_cov_y_z :: Float
_msgPosEcefCov_cov_y_y :: Float
_msgPosEcefCov_cov_x_z :: Float
_msgPosEcefCov_cov_x_y :: Float
_msgPosEcefCov_cov_x_x :: Float
_msgPosEcefCov_z :: Double
_msgPosEcefCov_y :: Double
_msgPosEcefCov_x :: Double
_msgPosEcefCov_tow :: Word32
_msgPosEcefCov_flags :: MsgPosEcefCov -> Word8
_msgPosEcefCov_n_sats :: MsgPosEcefCov -> Word8
_msgPosEcefCov_cov_z_z :: MsgPosEcefCov -> Float
_msgPosEcefCov_cov_y_z :: MsgPosEcefCov -> Float
_msgPosEcefCov_cov_y_y :: MsgPosEcefCov -> Float
_msgPosEcefCov_cov_x_z :: MsgPosEcefCov -> Float
_msgPosEcefCov_cov_x_y :: MsgPosEcefCov -> Float
_msgPosEcefCov_cov_x_x :: MsgPosEcefCov -> Float
_msgPosEcefCov_z :: MsgPosEcefCov -> Double
_msgPosEcefCov_y :: MsgPosEcefCov -> Double
_msgPosEcefCov_x :: MsgPosEcefCov -> Double
_msgPosEcefCov_tow :: MsgPosEcefCov -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgPosEcefCov_tow
    Double -> Put
putFloat64le Double
_msgPosEcefCov_x
    Double -> Put
putFloat64le Double
_msgPosEcefCov_y
    Double -> Put
putFloat64le Double
_msgPosEcefCov_z
    Float -> Put
putFloat32le Float
_msgPosEcefCov_cov_x_x
    Float -> Put
putFloat32le Float
_msgPosEcefCov_cov_x_y
    Float -> Put
putFloat32le Float
_msgPosEcefCov_cov_x_z
    Float -> Put
putFloat32le Float
_msgPosEcefCov_cov_y_y
    Float -> Put
putFloat32le Float
_msgPosEcefCov_cov_y_z
    Float -> Put
putFloat32le Float
_msgPosEcefCov_cov_z_z
    Word8 -> Put
putWord8 Word8
_msgPosEcefCov_n_sats
    Word8 -> Put
putWord8 Word8
_msgPosEcefCov_flags

$(makeSBP 'msgPosEcefCov ''MsgPosEcefCov)
$(makeJSON "_msgPosEcefCov_" ''MsgPosEcefCov)
$(makeLenses ''MsgPosEcefCov)

msgPosLlh :: Word16
msgPosLlh :: Word16
msgPosLlh = Word16
0x020A

-- | SBP class for message MSG_POS_LLH (0x020A).
--
-- This position solution message reports the absolute geodetic coordinates
-- and the status (single point vs pseudo-absolute RTK) of the position
-- solution. If the rover receiver knows the surveyed position of the base
-- station and has an RTK solution, this reports a pseudo-absolute position
-- solution using the base station position and the rover's RTK baseline
-- vector. The full GPS time is given by the preceding MSG_GPS_TIME with the
-- matching time-of-week (tow).
data MsgPosLlh = MsgPosLlh
  { MsgPosLlh -> Word32
_msgPosLlh_tow      :: !Word32
    -- ^ GPS Time of Week
  , MsgPosLlh -> Double
_msgPosLlh_lat      :: !Double
    -- ^ Latitude
  , MsgPosLlh -> Double
_msgPosLlh_lon      :: !Double
    -- ^ Longitude
  , MsgPosLlh -> Double
_msgPosLlh_height   :: !Double
    -- ^ Height above WGS84 ellipsoid
  , MsgPosLlh -> Word16
_msgPosLlh_h_accuracy :: !Word16
    -- ^ Horizontal position estimated standard deviation
  , MsgPosLlh -> Word16
_msgPosLlh_v_accuracy :: !Word16
    -- ^ Vertical position estimated standard deviation
  , MsgPosLlh -> Word8
_msgPosLlh_n_sats   :: !Word8
    -- ^ Number of satellites used in solution.
  , MsgPosLlh -> Word8
_msgPosLlh_flags    :: !Word8
    -- ^ Status flags
  } deriving ( Int -> MsgPosLlh -> ShowS
[MsgPosLlh] -> ShowS
MsgPosLlh -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgPosLlh] -> ShowS
$cshowList :: [MsgPosLlh] -> ShowS
show :: MsgPosLlh -> String
$cshow :: MsgPosLlh -> String
showsPrec :: Int -> MsgPosLlh -> ShowS
$cshowsPrec :: Int -> MsgPosLlh -> ShowS
Show, ReadPrec [MsgPosLlh]
ReadPrec MsgPosLlh
Int -> ReadS MsgPosLlh
ReadS [MsgPosLlh]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgPosLlh]
$creadListPrec :: ReadPrec [MsgPosLlh]
readPrec :: ReadPrec MsgPosLlh
$creadPrec :: ReadPrec MsgPosLlh
readList :: ReadS [MsgPosLlh]
$creadList :: ReadS [MsgPosLlh]
readsPrec :: Int -> ReadS MsgPosLlh
$creadsPrec :: Int -> ReadS MsgPosLlh
Read, MsgPosLlh -> MsgPosLlh -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgPosLlh -> MsgPosLlh -> Bool
$c/= :: MsgPosLlh -> MsgPosLlh -> Bool
== :: MsgPosLlh -> MsgPosLlh -> Bool
$c== :: MsgPosLlh -> MsgPosLlh -> Bool
Eq )

instance Binary MsgPosLlh where
  get :: Get MsgPosLlh
get = do
    Word32
_msgPosLlh_tow <- Get Word32
getWord32le
    Double
_msgPosLlh_lat <- Get Double
getFloat64le
    Double
_msgPosLlh_lon <- Get Double
getFloat64le
    Double
_msgPosLlh_height <- Get Double
getFloat64le
    Word16
_msgPosLlh_h_accuracy <- Get Word16
getWord16le
    Word16
_msgPosLlh_v_accuracy <- Get Word16
getWord16le
    Word8
_msgPosLlh_n_sats <- Get Word8
getWord8
    Word8
_msgPosLlh_flags <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgPosLlh {Double
Word8
Word16
Word32
_msgPosLlh_flags :: Word8
_msgPosLlh_n_sats :: Word8
_msgPosLlh_v_accuracy :: Word16
_msgPosLlh_h_accuracy :: Word16
_msgPosLlh_height :: Double
_msgPosLlh_lon :: Double
_msgPosLlh_lat :: Double
_msgPosLlh_tow :: Word32
_msgPosLlh_flags :: Word8
_msgPosLlh_n_sats :: Word8
_msgPosLlh_v_accuracy :: Word16
_msgPosLlh_h_accuracy :: Word16
_msgPosLlh_height :: Double
_msgPosLlh_lon :: Double
_msgPosLlh_lat :: Double
_msgPosLlh_tow :: Word32
..}

  put :: MsgPosLlh -> Put
put MsgPosLlh {Double
Word8
Word16
Word32
_msgPosLlh_flags :: Word8
_msgPosLlh_n_sats :: Word8
_msgPosLlh_v_accuracy :: Word16
_msgPosLlh_h_accuracy :: Word16
_msgPosLlh_height :: Double
_msgPosLlh_lon :: Double
_msgPosLlh_lat :: Double
_msgPosLlh_tow :: Word32
_msgPosLlh_flags :: MsgPosLlh -> Word8
_msgPosLlh_n_sats :: MsgPosLlh -> Word8
_msgPosLlh_v_accuracy :: MsgPosLlh -> Word16
_msgPosLlh_h_accuracy :: MsgPosLlh -> Word16
_msgPosLlh_height :: MsgPosLlh -> Double
_msgPosLlh_lon :: MsgPosLlh -> Double
_msgPosLlh_lat :: MsgPosLlh -> Double
_msgPosLlh_tow :: MsgPosLlh -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgPosLlh_tow
    Double -> Put
putFloat64le Double
_msgPosLlh_lat
    Double -> Put
putFloat64le Double
_msgPosLlh_lon
    Double -> Put
putFloat64le Double
_msgPosLlh_height
    Word16 -> Put
putWord16le Word16
_msgPosLlh_h_accuracy
    Word16 -> Put
putWord16le Word16
_msgPosLlh_v_accuracy
    Word8 -> Put
putWord8 Word8
_msgPosLlh_n_sats
    Word8 -> Put
putWord8 Word8
_msgPosLlh_flags

$(makeSBP 'msgPosLlh ''MsgPosLlh)
$(makeJSON "_msgPosLlh_" ''MsgPosLlh)
$(makeLenses ''MsgPosLlh)

msgPosLlhCov :: Word16
msgPosLlhCov :: Word16
msgPosLlhCov = Word16
0x0211

-- | SBP class for message MSG_POS_LLH_COV (0x0211).
--
-- This position solution message reports the absolute geodetic coordinates
-- and the status (single point vs pseudo-absolute RTK) of the position
-- solution as well as the upper triangle of the 3x3 covariance matrix.  The
-- position information and Fix Mode flags follow the MSG_POS_LLH message.
-- Since the covariance matrix is computed in the local-level North, East,
-- Down frame, the covariance terms follow that convention. Thus, covariances
-- are reported against the "downward" measurement and care should be taken
-- with the sign convention.
data MsgPosLlhCov = MsgPosLlhCov
  { MsgPosLlhCov -> Word32
_msgPosLlhCov_tow   :: !Word32
    -- ^ GPS Time of Week
  , MsgPosLlhCov -> Double
_msgPosLlhCov_lat   :: !Double
    -- ^ Latitude
  , MsgPosLlhCov -> Double
_msgPosLlhCov_lon   :: !Double
    -- ^ Longitude
  , MsgPosLlhCov -> Double
_msgPosLlhCov_height :: !Double
    -- ^ Height above WGS84 ellipsoid
  , MsgPosLlhCov -> Float
_msgPosLlhCov_cov_n_n :: !Float
    -- ^ Estimated variance of northing
  , MsgPosLlhCov -> Float
_msgPosLlhCov_cov_n_e :: !Float
    -- ^ Covariance of northing and easting
  , MsgPosLlhCov -> Float
_msgPosLlhCov_cov_n_d :: !Float
    -- ^ Covariance of northing and downward measurement
  , MsgPosLlhCov -> Float
_msgPosLlhCov_cov_e_e :: !Float
    -- ^ Estimated variance of easting
  , MsgPosLlhCov -> Float
_msgPosLlhCov_cov_e_d :: !Float
    -- ^ Covariance of easting and downward measurement
  , MsgPosLlhCov -> Float
_msgPosLlhCov_cov_d_d :: !Float
    -- ^ Estimated variance of downward measurement
  , MsgPosLlhCov -> Word8
_msgPosLlhCov_n_sats :: !Word8
    -- ^ Number of satellites used in solution.
  , MsgPosLlhCov -> Word8
_msgPosLlhCov_flags :: !Word8
    -- ^ Status flags
  } deriving ( Int -> MsgPosLlhCov -> ShowS
[MsgPosLlhCov] -> ShowS
MsgPosLlhCov -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgPosLlhCov] -> ShowS
$cshowList :: [MsgPosLlhCov] -> ShowS
show :: MsgPosLlhCov -> String
$cshow :: MsgPosLlhCov -> String
showsPrec :: Int -> MsgPosLlhCov -> ShowS
$cshowsPrec :: Int -> MsgPosLlhCov -> ShowS
Show, ReadPrec [MsgPosLlhCov]
ReadPrec MsgPosLlhCov
Int -> ReadS MsgPosLlhCov
ReadS [MsgPosLlhCov]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgPosLlhCov]
$creadListPrec :: ReadPrec [MsgPosLlhCov]
readPrec :: ReadPrec MsgPosLlhCov
$creadPrec :: ReadPrec MsgPosLlhCov
readList :: ReadS [MsgPosLlhCov]
$creadList :: ReadS [MsgPosLlhCov]
readsPrec :: Int -> ReadS MsgPosLlhCov
$creadsPrec :: Int -> ReadS MsgPosLlhCov
Read, MsgPosLlhCov -> MsgPosLlhCov -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgPosLlhCov -> MsgPosLlhCov -> Bool
$c/= :: MsgPosLlhCov -> MsgPosLlhCov -> Bool
== :: MsgPosLlhCov -> MsgPosLlhCov -> Bool
$c== :: MsgPosLlhCov -> MsgPosLlhCov -> Bool
Eq )

instance Binary MsgPosLlhCov where
  get :: Get MsgPosLlhCov
get = do
    Word32
_msgPosLlhCov_tow <- Get Word32
getWord32le
    Double
_msgPosLlhCov_lat <- Get Double
getFloat64le
    Double
_msgPosLlhCov_lon <- Get Double
getFloat64le
    Double
_msgPosLlhCov_height <- Get Double
getFloat64le
    Float
_msgPosLlhCov_cov_n_n <- Get Float
getFloat32le
    Float
_msgPosLlhCov_cov_n_e <- Get Float
getFloat32le
    Float
_msgPosLlhCov_cov_n_d <- Get Float
getFloat32le
    Float
_msgPosLlhCov_cov_e_e <- Get Float
getFloat32le
    Float
_msgPosLlhCov_cov_e_d <- Get Float
getFloat32le
    Float
_msgPosLlhCov_cov_d_d <- Get Float
getFloat32le
    Word8
_msgPosLlhCov_n_sats <- Get Word8
getWord8
    Word8
_msgPosLlhCov_flags <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgPosLlhCov {Double
Float
Word8
Word32
_msgPosLlhCov_flags :: Word8
_msgPosLlhCov_n_sats :: Word8
_msgPosLlhCov_cov_d_d :: Float
_msgPosLlhCov_cov_e_d :: Float
_msgPosLlhCov_cov_e_e :: Float
_msgPosLlhCov_cov_n_d :: Float
_msgPosLlhCov_cov_n_e :: Float
_msgPosLlhCov_cov_n_n :: Float
_msgPosLlhCov_height :: Double
_msgPosLlhCov_lon :: Double
_msgPosLlhCov_lat :: Double
_msgPosLlhCov_tow :: Word32
_msgPosLlhCov_flags :: Word8
_msgPosLlhCov_n_sats :: Word8
_msgPosLlhCov_cov_d_d :: Float
_msgPosLlhCov_cov_e_d :: Float
_msgPosLlhCov_cov_e_e :: Float
_msgPosLlhCov_cov_n_d :: Float
_msgPosLlhCov_cov_n_e :: Float
_msgPosLlhCov_cov_n_n :: Float
_msgPosLlhCov_height :: Double
_msgPosLlhCov_lon :: Double
_msgPosLlhCov_lat :: Double
_msgPosLlhCov_tow :: Word32
..}

  put :: MsgPosLlhCov -> Put
put MsgPosLlhCov {Double
Float
Word8
Word32
_msgPosLlhCov_flags :: Word8
_msgPosLlhCov_n_sats :: Word8
_msgPosLlhCov_cov_d_d :: Float
_msgPosLlhCov_cov_e_d :: Float
_msgPosLlhCov_cov_e_e :: Float
_msgPosLlhCov_cov_n_d :: Float
_msgPosLlhCov_cov_n_e :: Float
_msgPosLlhCov_cov_n_n :: Float
_msgPosLlhCov_height :: Double
_msgPosLlhCov_lon :: Double
_msgPosLlhCov_lat :: Double
_msgPosLlhCov_tow :: Word32
_msgPosLlhCov_flags :: MsgPosLlhCov -> Word8
_msgPosLlhCov_n_sats :: MsgPosLlhCov -> Word8
_msgPosLlhCov_cov_d_d :: MsgPosLlhCov -> Float
_msgPosLlhCov_cov_e_d :: MsgPosLlhCov -> Float
_msgPosLlhCov_cov_e_e :: MsgPosLlhCov -> Float
_msgPosLlhCov_cov_n_d :: MsgPosLlhCov -> Float
_msgPosLlhCov_cov_n_e :: MsgPosLlhCov -> Float
_msgPosLlhCov_cov_n_n :: MsgPosLlhCov -> Float
_msgPosLlhCov_height :: MsgPosLlhCov -> Double
_msgPosLlhCov_lon :: MsgPosLlhCov -> Double
_msgPosLlhCov_lat :: MsgPosLlhCov -> Double
_msgPosLlhCov_tow :: MsgPosLlhCov -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgPosLlhCov_tow
    Double -> Put
putFloat64le Double
_msgPosLlhCov_lat
    Double -> Put
putFloat64le Double
_msgPosLlhCov_lon
    Double -> Put
putFloat64le Double
_msgPosLlhCov_height
    Float -> Put
putFloat32le Float
_msgPosLlhCov_cov_n_n
    Float -> Put
putFloat32le Float
_msgPosLlhCov_cov_n_e
    Float -> Put
putFloat32le Float
_msgPosLlhCov_cov_n_d
    Float -> Put
putFloat32le Float
_msgPosLlhCov_cov_e_e
    Float -> Put
putFloat32le Float
_msgPosLlhCov_cov_e_d
    Float -> Put
putFloat32le Float
_msgPosLlhCov_cov_d_d
    Word8 -> Put
putWord8 Word8
_msgPosLlhCov_n_sats
    Word8 -> Put
putWord8 Word8
_msgPosLlhCov_flags

$(makeSBP 'msgPosLlhCov ''MsgPosLlhCov)
$(makeJSON "_msgPosLlhCov_" ''MsgPosLlhCov)
$(makeLenses ''MsgPosLlhCov)

data EstimatedHorizontalErrorEllipse = EstimatedHorizontalErrorEllipse
  { EstimatedHorizontalErrorEllipse -> Float
_estimatedHorizontalErrorEllipse_semi_major :: !Float
    -- ^ The semi major axis of the estimated horizontal error ellipse at the
    -- user-configured confidence level; zero implies invalid.
  , EstimatedHorizontalErrorEllipse -> Float
_estimatedHorizontalErrorEllipse_semi_minor :: !Float
    -- ^ The semi minor axis of the estimated horizontal error ellipse at the
    -- user-configured confidence level; zero implies invalid.
  , EstimatedHorizontalErrorEllipse -> Float
_estimatedHorizontalErrorEllipse_orientation :: !Float
    -- ^ The orientation of the semi major axis of the estimated horizontal
    -- error ellipse with respect to North.
  } deriving ( Int -> EstimatedHorizontalErrorEllipse -> ShowS
[EstimatedHorizontalErrorEllipse] -> ShowS
EstimatedHorizontalErrorEllipse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EstimatedHorizontalErrorEllipse] -> ShowS
$cshowList :: [EstimatedHorizontalErrorEllipse] -> ShowS
show :: EstimatedHorizontalErrorEllipse -> String
$cshow :: EstimatedHorizontalErrorEllipse -> String
showsPrec :: Int -> EstimatedHorizontalErrorEllipse -> ShowS
$cshowsPrec :: Int -> EstimatedHorizontalErrorEllipse -> ShowS
Show, ReadPrec [EstimatedHorizontalErrorEllipse]
ReadPrec EstimatedHorizontalErrorEllipse
Int -> ReadS EstimatedHorizontalErrorEllipse
ReadS [EstimatedHorizontalErrorEllipse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EstimatedHorizontalErrorEllipse]
$creadListPrec :: ReadPrec [EstimatedHorizontalErrorEllipse]
readPrec :: ReadPrec EstimatedHorizontalErrorEllipse
$creadPrec :: ReadPrec EstimatedHorizontalErrorEllipse
readList :: ReadS [EstimatedHorizontalErrorEllipse]
$creadList :: ReadS [EstimatedHorizontalErrorEllipse]
readsPrec :: Int -> ReadS EstimatedHorizontalErrorEllipse
$creadsPrec :: Int -> ReadS EstimatedHorizontalErrorEllipse
Read, EstimatedHorizontalErrorEllipse
-> EstimatedHorizontalErrorEllipse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EstimatedHorizontalErrorEllipse
-> EstimatedHorizontalErrorEllipse -> Bool
$c/= :: EstimatedHorizontalErrorEllipse
-> EstimatedHorizontalErrorEllipse -> Bool
== :: EstimatedHorizontalErrorEllipse
-> EstimatedHorizontalErrorEllipse -> Bool
$c== :: EstimatedHorizontalErrorEllipse
-> EstimatedHorizontalErrorEllipse -> Bool
Eq )

instance Binary EstimatedHorizontalErrorEllipse where
  get :: Get EstimatedHorizontalErrorEllipse
get = do
    Float
_estimatedHorizontalErrorEllipse_semi_major <- Get Float
getFloat32le
    Float
_estimatedHorizontalErrorEllipse_semi_minor <- Get Float
getFloat32le
    Float
_estimatedHorizontalErrorEllipse_orientation <- Get Float
getFloat32le
    forall (f :: * -> *) a. Applicative f => a -> f a
pure EstimatedHorizontalErrorEllipse {Float
_estimatedHorizontalErrorEllipse_orientation :: Float
_estimatedHorizontalErrorEllipse_semi_minor :: Float
_estimatedHorizontalErrorEllipse_semi_major :: Float
_estimatedHorizontalErrorEllipse_orientation :: Float
_estimatedHorizontalErrorEllipse_semi_minor :: Float
_estimatedHorizontalErrorEllipse_semi_major :: Float
..}

  put :: EstimatedHorizontalErrorEllipse -> Put
put EstimatedHorizontalErrorEllipse {Float
_estimatedHorizontalErrorEllipse_orientation :: Float
_estimatedHorizontalErrorEllipse_semi_minor :: Float
_estimatedHorizontalErrorEllipse_semi_major :: Float
_estimatedHorizontalErrorEllipse_orientation :: EstimatedHorizontalErrorEllipse -> Float
_estimatedHorizontalErrorEllipse_semi_minor :: EstimatedHorizontalErrorEllipse -> Float
_estimatedHorizontalErrorEllipse_semi_major :: EstimatedHorizontalErrorEllipse -> Float
..} = do
    Float -> Put
putFloat32le Float
_estimatedHorizontalErrorEllipse_semi_major
    Float -> Put
putFloat32le Float
_estimatedHorizontalErrorEllipse_semi_minor
    Float -> Put
putFloat32le Float
_estimatedHorizontalErrorEllipse_orientation

$(makeJSON "_estimatedHorizontalErrorEllipse_" ''EstimatedHorizontalErrorEllipse)
$(makeLenses ''EstimatedHorizontalErrorEllipse)

msgPosLlhAcc :: Word16
msgPosLlhAcc :: Word16
msgPosLlhAcc = Word16
0x0218

-- | SBP class for message MSG_POS_LLH_ACC (0x0218).
--
-- This position solution message reports the absolute geodetic coordinates
-- and the status (single point vs pseudo-absolute RTK) of the position
-- solution as well as the estimated horizontal, vertical, cross-track and
-- along-track errors.  The position information and Fix Mode flags  follow
-- the MSG_POS_LLH message. Since the covariance matrix is computed in the
-- local-level North, East, Down frame, the estimated error terms follow that
-- convention.
--
-- The estimated errors are reported at a user-configurable confidence level.
-- The user-configured percentile is encoded in the percentile field.
data MsgPosLlhAcc = MsgPosLlhAcc
  { MsgPosLlhAcc -> Word32
_msgPosLlhAcc_tow                :: !Word32
    -- ^ GPS Time of Week
  , MsgPosLlhAcc -> Double
_msgPosLlhAcc_lat                :: !Double
    -- ^ Latitude
  , MsgPosLlhAcc -> Double
_msgPosLlhAcc_lon                :: !Double
    -- ^ Longitude
  , MsgPosLlhAcc -> Double
_msgPosLlhAcc_height             :: !Double
    -- ^ Height above WGS84 ellipsoid
  , MsgPosLlhAcc -> Double
_msgPosLlhAcc_orthometric_height :: !Double
    -- ^ Height above the geoid (i.e. height above mean sea level). See
    -- confidence_and_geoid for geoid model used.
  , MsgPosLlhAcc -> Float
_msgPosLlhAcc_h_accuracy         :: !Float
    -- ^ Estimated horizontal error at the user-configured confidence level;
    -- zero implies invalid.
  , MsgPosLlhAcc -> Float
_msgPosLlhAcc_v_accuracy         :: !Float
    -- ^ Estimated vertical error at the user-configured confidence level; zero
    -- implies invalid.
  , MsgPosLlhAcc -> Float
_msgPosLlhAcc_ct_accuracy        :: !Float
    -- ^ Estimated cross-track error at the user-configured confidence level;
    -- zero implies invalid.
  , MsgPosLlhAcc -> Float
_msgPosLlhAcc_at_accuracy        :: !Float
    -- ^ Estimated along-track error at the user-configured confidence level;
    -- zero implies invalid.
  , MsgPosLlhAcc -> EstimatedHorizontalErrorEllipse
_msgPosLlhAcc_h_ellipse          :: !EstimatedHorizontalErrorEllipse
    -- ^ The estimated horizontal error ellipse at the user-configured
    -- confidence level.
  , MsgPosLlhAcc -> Word8
_msgPosLlhAcc_confidence_and_geoid :: !Word8
    -- ^ The lower bits describe the configured confidence level for the
    -- estimated position error. The middle bits describe the geoid model used
    -- to calculate the orthometric height.
  , MsgPosLlhAcc -> Word8
_msgPosLlhAcc_n_sats             :: !Word8
    -- ^ Number of satellites used in solution.
  , MsgPosLlhAcc -> Word8
_msgPosLlhAcc_flags              :: !Word8
    -- ^ Status flags
  } deriving ( Int -> MsgPosLlhAcc -> ShowS
[MsgPosLlhAcc] -> ShowS
MsgPosLlhAcc -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgPosLlhAcc] -> ShowS
$cshowList :: [MsgPosLlhAcc] -> ShowS
show :: MsgPosLlhAcc -> String
$cshow :: MsgPosLlhAcc -> String
showsPrec :: Int -> MsgPosLlhAcc -> ShowS
$cshowsPrec :: Int -> MsgPosLlhAcc -> ShowS
Show, ReadPrec [MsgPosLlhAcc]
ReadPrec MsgPosLlhAcc
Int -> ReadS MsgPosLlhAcc
ReadS [MsgPosLlhAcc]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgPosLlhAcc]
$creadListPrec :: ReadPrec [MsgPosLlhAcc]
readPrec :: ReadPrec MsgPosLlhAcc
$creadPrec :: ReadPrec MsgPosLlhAcc
readList :: ReadS [MsgPosLlhAcc]
$creadList :: ReadS [MsgPosLlhAcc]
readsPrec :: Int -> ReadS MsgPosLlhAcc
$creadsPrec :: Int -> ReadS MsgPosLlhAcc
Read, MsgPosLlhAcc -> MsgPosLlhAcc -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgPosLlhAcc -> MsgPosLlhAcc -> Bool
$c/= :: MsgPosLlhAcc -> MsgPosLlhAcc -> Bool
== :: MsgPosLlhAcc -> MsgPosLlhAcc -> Bool
$c== :: MsgPosLlhAcc -> MsgPosLlhAcc -> Bool
Eq )

instance Binary MsgPosLlhAcc where
  get :: Get MsgPosLlhAcc
get = do
    Word32
_msgPosLlhAcc_tow <- Get Word32
getWord32le
    Double
_msgPosLlhAcc_lat <- Get Double
getFloat64le
    Double
_msgPosLlhAcc_lon <- Get Double
getFloat64le
    Double
_msgPosLlhAcc_height <- Get Double
getFloat64le
    Double
_msgPosLlhAcc_orthometric_height <- Get Double
getFloat64le
    Float
_msgPosLlhAcc_h_accuracy <- Get Float
getFloat32le
    Float
_msgPosLlhAcc_v_accuracy <- Get Float
getFloat32le
    Float
_msgPosLlhAcc_ct_accuracy <- Get Float
getFloat32le
    Float
_msgPosLlhAcc_at_accuracy <- Get Float
getFloat32le
    EstimatedHorizontalErrorEllipse
_msgPosLlhAcc_h_ellipse <- forall t. Binary t => Get t
get
    Word8
_msgPosLlhAcc_confidence_and_geoid <- Get Word8
getWord8
    Word8
_msgPosLlhAcc_n_sats <- Get Word8
getWord8
    Word8
_msgPosLlhAcc_flags <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgPosLlhAcc {Double
Float
Word8
Word32
EstimatedHorizontalErrorEllipse
_msgPosLlhAcc_flags :: Word8
_msgPosLlhAcc_n_sats :: Word8
_msgPosLlhAcc_confidence_and_geoid :: Word8
_msgPosLlhAcc_h_ellipse :: EstimatedHorizontalErrorEllipse
_msgPosLlhAcc_at_accuracy :: Float
_msgPosLlhAcc_ct_accuracy :: Float
_msgPosLlhAcc_v_accuracy :: Float
_msgPosLlhAcc_h_accuracy :: Float
_msgPosLlhAcc_orthometric_height :: Double
_msgPosLlhAcc_height :: Double
_msgPosLlhAcc_lon :: Double
_msgPosLlhAcc_lat :: Double
_msgPosLlhAcc_tow :: Word32
_msgPosLlhAcc_flags :: Word8
_msgPosLlhAcc_n_sats :: Word8
_msgPosLlhAcc_confidence_and_geoid :: Word8
_msgPosLlhAcc_h_ellipse :: EstimatedHorizontalErrorEllipse
_msgPosLlhAcc_at_accuracy :: Float
_msgPosLlhAcc_ct_accuracy :: Float
_msgPosLlhAcc_v_accuracy :: Float
_msgPosLlhAcc_h_accuracy :: Float
_msgPosLlhAcc_orthometric_height :: Double
_msgPosLlhAcc_height :: Double
_msgPosLlhAcc_lon :: Double
_msgPosLlhAcc_lat :: Double
_msgPosLlhAcc_tow :: Word32
..}

  put :: MsgPosLlhAcc -> Put
put MsgPosLlhAcc {Double
Float
Word8
Word32
EstimatedHorizontalErrorEllipse
_msgPosLlhAcc_flags :: Word8
_msgPosLlhAcc_n_sats :: Word8
_msgPosLlhAcc_confidence_and_geoid :: Word8
_msgPosLlhAcc_h_ellipse :: EstimatedHorizontalErrorEllipse
_msgPosLlhAcc_at_accuracy :: Float
_msgPosLlhAcc_ct_accuracy :: Float
_msgPosLlhAcc_v_accuracy :: Float
_msgPosLlhAcc_h_accuracy :: Float
_msgPosLlhAcc_orthometric_height :: Double
_msgPosLlhAcc_height :: Double
_msgPosLlhAcc_lon :: Double
_msgPosLlhAcc_lat :: Double
_msgPosLlhAcc_tow :: Word32
_msgPosLlhAcc_flags :: MsgPosLlhAcc -> Word8
_msgPosLlhAcc_n_sats :: MsgPosLlhAcc -> Word8
_msgPosLlhAcc_confidence_and_geoid :: MsgPosLlhAcc -> Word8
_msgPosLlhAcc_h_ellipse :: MsgPosLlhAcc -> EstimatedHorizontalErrorEllipse
_msgPosLlhAcc_at_accuracy :: MsgPosLlhAcc -> Float
_msgPosLlhAcc_ct_accuracy :: MsgPosLlhAcc -> Float
_msgPosLlhAcc_v_accuracy :: MsgPosLlhAcc -> Float
_msgPosLlhAcc_h_accuracy :: MsgPosLlhAcc -> Float
_msgPosLlhAcc_orthometric_height :: MsgPosLlhAcc -> Double
_msgPosLlhAcc_height :: MsgPosLlhAcc -> Double
_msgPosLlhAcc_lon :: MsgPosLlhAcc -> Double
_msgPosLlhAcc_lat :: MsgPosLlhAcc -> Double
_msgPosLlhAcc_tow :: MsgPosLlhAcc -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgPosLlhAcc_tow
    Double -> Put
putFloat64le Double
_msgPosLlhAcc_lat
    Double -> Put
putFloat64le Double
_msgPosLlhAcc_lon
    Double -> Put
putFloat64le Double
_msgPosLlhAcc_height
    Double -> Put
putFloat64le Double
_msgPosLlhAcc_orthometric_height
    Float -> Put
putFloat32le Float
_msgPosLlhAcc_h_accuracy
    Float -> Put
putFloat32le Float
_msgPosLlhAcc_v_accuracy
    Float -> Put
putFloat32le Float
_msgPosLlhAcc_ct_accuracy
    Float -> Put
putFloat32le Float
_msgPosLlhAcc_at_accuracy
    forall t. Binary t => t -> Put
put EstimatedHorizontalErrorEllipse
_msgPosLlhAcc_h_ellipse
    Word8 -> Put
putWord8 Word8
_msgPosLlhAcc_confidence_and_geoid
    Word8 -> Put
putWord8 Word8
_msgPosLlhAcc_n_sats
    Word8 -> Put
putWord8 Word8
_msgPosLlhAcc_flags

$(makeSBP 'msgPosLlhAcc ''MsgPosLlhAcc)
$(makeJSON "_msgPosLlhAcc_" ''MsgPosLlhAcc)
$(makeLenses ''MsgPosLlhAcc)

msgBaselineEcef :: Word16
msgBaselineEcef :: Word16
msgBaselineEcef = Word16
0x020B

-- | SBP class for message MSG_BASELINE_ECEF (0x020B).
--
-- This message reports the baseline solution in Earth Centered Earth Fixed
-- (ECEF) coordinates. This baseline is the relative vector distance from the
-- base station to the rover receiver. The full GPS time is given by the
-- preceding MSG_GPS_TIME with the matching time-of-week (tow).
data MsgBaselineEcef = MsgBaselineEcef
  { MsgBaselineEcef -> Word32
_msgBaselineEcef_tow    :: !Word32
    -- ^ GPS Time of Week
  , MsgBaselineEcef -> Int32
_msgBaselineEcef_x      :: !Int32
    -- ^ Baseline ECEF X coordinate
  , MsgBaselineEcef -> Int32
_msgBaselineEcef_y      :: !Int32
    -- ^ Baseline ECEF Y coordinate
  , MsgBaselineEcef -> Int32
_msgBaselineEcef_z      :: !Int32
    -- ^ Baseline ECEF Z coordinate
  , MsgBaselineEcef -> Word16
_msgBaselineEcef_accuracy :: !Word16
    -- ^ Position estimated standard deviation
  , MsgBaselineEcef -> Word8
_msgBaselineEcef_n_sats :: !Word8
    -- ^ Number of satellites used in solution
  , MsgBaselineEcef -> Word8
_msgBaselineEcef_flags  :: !Word8
    -- ^ Status flags
  } deriving ( Int -> MsgBaselineEcef -> ShowS
[MsgBaselineEcef] -> ShowS
MsgBaselineEcef -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgBaselineEcef] -> ShowS
$cshowList :: [MsgBaselineEcef] -> ShowS
show :: MsgBaselineEcef -> String
$cshow :: MsgBaselineEcef -> String
showsPrec :: Int -> MsgBaselineEcef -> ShowS
$cshowsPrec :: Int -> MsgBaselineEcef -> ShowS
Show, ReadPrec [MsgBaselineEcef]
ReadPrec MsgBaselineEcef
Int -> ReadS MsgBaselineEcef
ReadS [MsgBaselineEcef]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgBaselineEcef]
$creadListPrec :: ReadPrec [MsgBaselineEcef]
readPrec :: ReadPrec MsgBaselineEcef
$creadPrec :: ReadPrec MsgBaselineEcef
readList :: ReadS [MsgBaselineEcef]
$creadList :: ReadS [MsgBaselineEcef]
readsPrec :: Int -> ReadS MsgBaselineEcef
$creadsPrec :: Int -> ReadS MsgBaselineEcef
Read, MsgBaselineEcef -> MsgBaselineEcef -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgBaselineEcef -> MsgBaselineEcef -> Bool
$c/= :: MsgBaselineEcef -> MsgBaselineEcef -> Bool
== :: MsgBaselineEcef -> MsgBaselineEcef -> Bool
$c== :: MsgBaselineEcef -> MsgBaselineEcef -> Bool
Eq )

instance Binary MsgBaselineEcef where
  get :: Get MsgBaselineEcef
get = do
    Word32
_msgBaselineEcef_tow <- Get Word32
getWord32le
    Int32
_msgBaselineEcef_x <- (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
_msgBaselineEcef_y <- (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
_msgBaselineEcef_z <- (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)
    Word16
_msgBaselineEcef_accuracy <- Get Word16
getWord16le
    Word8
_msgBaselineEcef_n_sats <- Get Word8
getWord8
    Word8
_msgBaselineEcef_flags <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgBaselineEcef {Int32
Word8
Word16
Word32
_msgBaselineEcef_flags :: Word8
_msgBaselineEcef_n_sats :: Word8
_msgBaselineEcef_accuracy :: Word16
_msgBaselineEcef_z :: Int32
_msgBaselineEcef_y :: Int32
_msgBaselineEcef_x :: Int32
_msgBaselineEcef_tow :: Word32
_msgBaselineEcef_flags :: Word8
_msgBaselineEcef_n_sats :: Word8
_msgBaselineEcef_accuracy :: Word16
_msgBaselineEcef_z :: Int32
_msgBaselineEcef_y :: Int32
_msgBaselineEcef_x :: Int32
_msgBaselineEcef_tow :: Word32
..}

  put :: MsgBaselineEcef -> Put
put MsgBaselineEcef {Int32
Word8
Word16
Word32
_msgBaselineEcef_flags :: Word8
_msgBaselineEcef_n_sats :: Word8
_msgBaselineEcef_accuracy :: Word16
_msgBaselineEcef_z :: Int32
_msgBaselineEcef_y :: Int32
_msgBaselineEcef_x :: Int32
_msgBaselineEcef_tow :: Word32
_msgBaselineEcef_flags :: MsgBaselineEcef -> Word8
_msgBaselineEcef_n_sats :: MsgBaselineEcef -> Word8
_msgBaselineEcef_accuracy :: MsgBaselineEcef -> Word16
_msgBaselineEcef_z :: MsgBaselineEcef -> Int32
_msgBaselineEcef_y :: MsgBaselineEcef -> Int32
_msgBaselineEcef_x :: MsgBaselineEcef -> Int32
_msgBaselineEcef_tow :: MsgBaselineEcef -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgBaselineEcef_tow
    (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
_msgBaselineEcef_x
    (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
_msgBaselineEcef_y
    (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
_msgBaselineEcef_z
    Word16 -> Put
putWord16le Word16
_msgBaselineEcef_accuracy
    Word8 -> Put
putWord8 Word8
_msgBaselineEcef_n_sats
    Word8 -> Put
putWord8 Word8
_msgBaselineEcef_flags

$(makeSBP 'msgBaselineEcef ''MsgBaselineEcef)
$(makeJSON "_msgBaselineEcef_" ''MsgBaselineEcef)
$(makeLenses ''MsgBaselineEcef)

msgBaselineNed :: Word16
msgBaselineNed :: Word16
msgBaselineNed = Word16
0x020C

-- | SBP class for message MSG_BASELINE_NED (0x020C).
--
-- This message reports the baseline solution in North East Down (NED)
-- coordinates. This baseline is the relative vector distance from the base
-- station to the rover receiver, and NED coordinate system is defined at the
-- local WGS84 tangent plane centered at the base station position.  The full
-- GPS time is given by the preceding MSG_GPS_TIME with the matching time-of-
-- week (tow).
data MsgBaselineNed = MsgBaselineNed
  { MsgBaselineNed -> Word32
_msgBaselineNed_tow      :: !Word32
    -- ^ GPS Time of Week
  , MsgBaselineNed -> Int32
_msgBaselineNed_n        :: !Int32
    -- ^ Baseline North coordinate
  , MsgBaselineNed -> Int32
_msgBaselineNed_e        :: !Int32
    -- ^ Baseline East coordinate
  , MsgBaselineNed -> Int32
_msgBaselineNed_d        :: !Int32
    -- ^ Baseline Down coordinate
  , MsgBaselineNed -> Word16
_msgBaselineNed_h_accuracy :: !Word16
    -- ^ Horizontal position estimated standard deviation
  , MsgBaselineNed -> Word16
_msgBaselineNed_v_accuracy :: !Word16
    -- ^ Vertical position estimated standard deviation
  , MsgBaselineNed -> Word8
_msgBaselineNed_n_sats   :: !Word8
    -- ^ Number of satellites used in solution
  , MsgBaselineNed -> Word8
_msgBaselineNed_flags    :: !Word8
    -- ^ Status flags
  } deriving ( Int -> MsgBaselineNed -> ShowS
[MsgBaselineNed] -> ShowS
MsgBaselineNed -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgBaselineNed] -> ShowS
$cshowList :: [MsgBaselineNed] -> ShowS
show :: MsgBaselineNed -> String
$cshow :: MsgBaselineNed -> String
showsPrec :: Int -> MsgBaselineNed -> ShowS
$cshowsPrec :: Int -> MsgBaselineNed -> ShowS
Show, ReadPrec [MsgBaselineNed]
ReadPrec MsgBaselineNed
Int -> ReadS MsgBaselineNed
ReadS [MsgBaselineNed]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgBaselineNed]
$creadListPrec :: ReadPrec [MsgBaselineNed]
readPrec :: ReadPrec MsgBaselineNed
$creadPrec :: ReadPrec MsgBaselineNed
readList :: ReadS [MsgBaselineNed]
$creadList :: ReadS [MsgBaselineNed]
readsPrec :: Int -> ReadS MsgBaselineNed
$creadsPrec :: Int -> ReadS MsgBaselineNed
Read, MsgBaselineNed -> MsgBaselineNed -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgBaselineNed -> MsgBaselineNed -> Bool
$c/= :: MsgBaselineNed -> MsgBaselineNed -> Bool
== :: MsgBaselineNed -> MsgBaselineNed -> Bool
$c== :: MsgBaselineNed -> MsgBaselineNed -> Bool
Eq )

instance Binary MsgBaselineNed where
  get :: Get MsgBaselineNed
get = do
    Word32
_msgBaselineNed_tow <- Get Word32
getWord32le
    Int32
_msgBaselineNed_n <- (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
_msgBaselineNed_e <- (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
_msgBaselineNed_d <- (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)
    Word16
_msgBaselineNed_h_accuracy <- Get Word16
getWord16le
    Word16
_msgBaselineNed_v_accuracy <- Get Word16
getWord16le
    Word8
_msgBaselineNed_n_sats <- Get Word8
getWord8
    Word8
_msgBaselineNed_flags <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgBaselineNed {Int32
Word8
Word16
Word32
_msgBaselineNed_flags :: Word8
_msgBaselineNed_n_sats :: Word8
_msgBaselineNed_v_accuracy :: Word16
_msgBaselineNed_h_accuracy :: Word16
_msgBaselineNed_d :: Int32
_msgBaselineNed_e :: Int32
_msgBaselineNed_n :: Int32
_msgBaselineNed_tow :: Word32
_msgBaselineNed_flags :: Word8
_msgBaselineNed_n_sats :: Word8
_msgBaselineNed_v_accuracy :: Word16
_msgBaselineNed_h_accuracy :: Word16
_msgBaselineNed_d :: Int32
_msgBaselineNed_e :: Int32
_msgBaselineNed_n :: Int32
_msgBaselineNed_tow :: Word32
..}

  put :: MsgBaselineNed -> Put
put MsgBaselineNed {Int32
Word8
Word16
Word32
_msgBaselineNed_flags :: Word8
_msgBaselineNed_n_sats :: Word8
_msgBaselineNed_v_accuracy :: Word16
_msgBaselineNed_h_accuracy :: Word16
_msgBaselineNed_d :: Int32
_msgBaselineNed_e :: Int32
_msgBaselineNed_n :: Int32
_msgBaselineNed_tow :: Word32
_msgBaselineNed_flags :: MsgBaselineNed -> Word8
_msgBaselineNed_n_sats :: MsgBaselineNed -> Word8
_msgBaselineNed_v_accuracy :: MsgBaselineNed -> Word16
_msgBaselineNed_h_accuracy :: MsgBaselineNed -> Word16
_msgBaselineNed_d :: MsgBaselineNed -> Int32
_msgBaselineNed_e :: MsgBaselineNed -> Int32
_msgBaselineNed_n :: MsgBaselineNed -> Int32
_msgBaselineNed_tow :: MsgBaselineNed -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgBaselineNed_tow
    (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
_msgBaselineNed_n
    (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
_msgBaselineNed_e
    (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
_msgBaselineNed_d
    Word16 -> Put
putWord16le Word16
_msgBaselineNed_h_accuracy
    Word16 -> Put
putWord16le Word16
_msgBaselineNed_v_accuracy
    Word8 -> Put
putWord8 Word8
_msgBaselineNed_n_sats
    Word8 -> Put
putWord8 Word8
_msgBaselineNed_flags

$(makeSBP 'msgBaselineNed ''MsgBaselineNed)
$(makeJSON "_msgBaselineNed_" ''MsgBaselineNed)
$(makeLenses ''MsgBaselineNed)

msgVelEcef :: Word16
msgVelEcef :: Word16
msgVelEcef = Word16
0x020D

-- | SBP class for message MSG_VEL_ECEF (0x020D).
--
-- This message reports the velocity in Earth Centered Earth Fixed (ECEF)
-- coordinates. The full GPS time is given by the preceding MSG_GPS_TIME with
-- the matching time-of-week (tow).
data MsgVelEcef = MsgVelEcef
  { MsgVelEcef -> Word32
_msgVelEcef_tow    :: !Word32
    -- ^ GPS Time of Week
  , MsgVelEcef -> Int32
_msgVelEcef_x      :: !Int32
    -- ^ Velocity ECEF X coordinate
  , MsgVelEcef -> Int32
_msgVelEcef_y      :: !Int32
    -- ^ Velocity ECEF Y coordinate
  , MsgVelEcef -> Int32
_msgVelEcef_z      :: !Int32
    -- ^ Velocity ECEF Z coordinate
  , MsgVelEcef -> Word16
_msgVelEcef_accuracy :: !Word16
    -- ^ Velocity estimated standard deviation
  , MsgVelEcef -> Word8
_msgVelEcef_n_sats :: !Word8
    -- ^ Number of satellites used in solution
  , MsgVelEcef -> Word8
_msgVelEcef_flags  :: !Word8
    -- ^ Status flags
  } deriving ( Int -> MsgVelEcef -> ShowS
[MsgVelEcef] -> ShowS
MsgVelEcef -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgVelEcef] -> ShowS
$cshowList :: [MsgVelEcef] -> ShowS
show :: MsgVelEcef -> String
$cshow :: MsgVelEcef -> String
showsPrec :: Int -> MsgVelEcef -> ShowS
$cshowsPrec :: Int -> MsgVelEcef -> ShowS
Show, ReadPrec [MsgVelEcef]
ReadPrec MsgVelEcef
Int -> ReadS MsgVelEcef
ReadS [MsgVelEcef]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgVelEcef]
$creadListPrec :: ReadPrec [MsgVelEcef]
readPrec :: ReadPrec MsgVelEcef
$creadPrec :: ReadPrec MsgVelEcef
readList :: ReadS [MsgVelEcef]
$creadList :: ReadS [MsgVelEcef]
readsPrec :: Int -> ReadS MsgVelEcef
$creadsPrec :: Int -> ReadS MsgVelEcef
Read, MsgVelEcef -> MsgVelEcef -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgVelEcef -> MsgVelEcef -> Bool
$c/= :: MsgVelEcef -> MsgVelEcef -> Bool
== :: MsgVelEcef -> MsgVelEcef -> Bool
$c== :: MsgVelEcef -> MsgVelEcef -> Bool
Eq )

instance Binary MsgVelEcef where
  get :: Get MsgVelEcef
get = do
    Word32
_msgVelEcef_tow <- Get Word32
getWord32le
    Int32
_msgVelEcef_x <- (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
_msgVelEcef_y <- (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
_msgVelEcef_z <- (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)
    Word16
_msgVelEcef_accuracy <- Get Word16
getWord16le
    Word8
_msgVelEcef_n_sats <- Get Word8
getWord8
    Word8
_msgVelEcef_flags <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgVelEcef {Int32
Word8
Word16
Word32
_msgVelEcef_flags :: Word8
_msgVelEcef_n_sats :: Word8
_msgVelEcef_accuracy :: Word16
_msgVelEcef_z :: Int32
_msgVelEcef_y :: Int32
_msgVelEcef_x :: Int32
_msgVelEcef_tow :: Word32
_msgVelEcef_flags :: Word8
_msgVelEcef_n_sats :: Word8
_msgVelEcef_accuracy :: Word16
_msgVelEcef_z :: Int32
_msgVelEcef_y :: Int32
_msgVelEcef_x :: Int32
_msgVelEcef_tow :: Word32
..}

  put :: MsgVelEcef -> Put
put MsgVelEcef {Int32
Word8
Word16
Word32
_msgVelEcef_flags :: Word8
_msgVelEcef_n_sats :: Word8
_msgVelEcef_accuracy :: Word16
_msgVelEcef_z :: Int32
_msgVelEcef_y :: Int32
_msgVelEcef_x :: Int32
_msgVelEcef_tow :: Word32
_msgVelEcef_flags :: MsgVelEcef -> Word8
_msgVelEcef_n_sats :: MsgVelEcef -> Word8
_msgVelEcef_accuracy :: MsgVelEcef -> Word16
_msgVelEcef_z :: MsgVelEcef -> Int32
_msgVelEcef_y :: MsgVelEcef -> Int32
_msgVelEcef_x :: MsgVelEcef -> Int32
_msgVelEcef_tow :: MsgVelEcef -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgVelEcef_tow
    (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
_msgVelEcef_x
    (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
_msgVelEcef_y
    (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
_msgVelEcef_z
    Word16 -> Put
putWord16le Word16
_msgVelEcef_accuracy
    Word8 -> Put
putWord8 Word8
_msgVelEcef_n_sats
    Word8 -> Put
putWord8 Word8
_msgVelEcef_flags

$(makeSBP 'msgVelEcef ''MsgVelEcef)
$(makeJSON "_msgVelEcef_" ''MsgVelEcef)
$(makeLenses ''MsgVelEcef)

msgVelEcefCov :: Word16
msgVelEcefCov :: Word16
msgVelEcefCov = Word16
0x0215

-- | SBP class for message MSG_VEL_ECEF_COV (0x0215).
--
-- This message reports the velocity in Earth Centered Earth Fixed (ECEF)
-- coordinates. The full GPS time is given by the preceding MSG_GPS_TIME with
-- the matching time-of-week (tow).
data MsgVelEcefCov = MsgVelEcefCov
  { MsgVelEcefCov -> Word32
_msgVelEcefCov_tow   :: !Word32
    -- ^ GPS Time of Week
  , MsgVelEcefCov -> Int32
_msgVelEcefCov_x     :: !Int32
    -- ^ Velocity ECEF X coordinate
  , MsgVelEcefCov -> Int32
_msgVelEcefCov_y     :: !Int32
    -- ^ Velocity ECEF Y coordinate
  , MsgVelEcefCov -> Int32
_msgVelEcefCov_z     :: !Int32
    -- ^ Velocity ECEF Z coordinate
  , MsgVelEcefCov -> Float
_msgVelEcefCov_cov_x_x :: !Float
    -- ^ Estimated variance of x
  , MsgVelEcefCov -> Float
_msgVelEcefCov_cov_x_y :: !Float
    -- ^ Estimated covariance of x and y
  , MsgVelEcefCov -> Float
_msgVelEcefCov_cov_x_z :: !Float
    -- ^ Estimated covariance of x and z
  , MsgVelEcefCov -> Float
_msgVelEcefCov_cov_y_y :: !Float
    -- ^ Estimated variance of y
  , MsgVelEcefCov -> Float
_msgVelEcefCov_cov_y_z :: !Float
    -- ^ Estimated covariance of y and z
  , MsgVelEcefCov -> Float
_msgVelEcefCov_cov_z_z :: !Float
    -- ^ Estimated variance of z
  , MsgVelEcefCov -> Word8
_msgVelEcefCov_n_sats :: !Word8
    -- ^ Number of satellites used in solution
  , MsgVelEcefCov -> Word8
_msgVelEcefCov_flags :: !Word8
    -- ^ Status flags
  } deriving ( Int -> MsgVelEcefCov -> ShowS
[MsgVelEcefCov] -> ShowS
MsgVelEcefCov -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgVelEcefCov] -> ShowS
$cshowList :: [MsgVelEcefCov] -> ShowS
show :: MsgVelEcefCov -> String
$cshow :: MsgVelEcefCov -> String
showsPrec :: Int -> MsgVelEcefCov -> ShowS
$cshowsPrec :: Int -> MsgVelEcefCov -> ShowS
Show, ReadPrec [MsgVelEcefCov]
ReadPrec MsgVelEcefCov
Int -> ReadS MsgVelEcefCov
ReadS [MsgVelEcefCov]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgVelEcefCov]
$creadListPrec :: ReadPrec [MsgVelEcefCov]
readPrec :: ReadPrec MsgVelEcefCov
$creadPrec :: ReadPrec MsgVelEcefCov
readList :: ReadS [MsgVelEcefCov]
$creadList :: ReadS [MsgVelEcefCov]
readsPrec :: Int -> ReadS MsgVelEcefCov
$creadsPrec :: Int -> ReadS MsgVelEcefCov
Read, MsgVelEcefCov -> MsgVelEcefCov -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgVelEcefCov -> MsgVelEcefCov -> Bool
$c/= :: MsgVelEcefCov -> MsgVelEcefCov -> Bool
== :: MsgVelEcefCov -> MsgVelEcefCov -> Bool
$c== :: MsgVelEcefCov -> MsgVelEcefCov -> Bool
Eq )

instance Binary MsgVelEcefCov where
  get :: Get MsgVelEcefCov
get = do
    Word32
_msgVelEcefCov_tow <- Get Word32
getWord32le
    Int32
_msgVelEcefCov_x <- (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
_msgVelEcefCov_y <- (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
_msgVelEcefCov_z <- (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)
    Float
_msgVelEcefCov_cov_x_x <- Get Float
getFloat32le
    Float
_msgVelEcefCov_cov_x_y <- Get Float
getFloat32le
    Float
_msgVelEcefCov_cov_x_z <- Get Float
getFloat32le
    Float
_msgVelEcefCov_cov_y_y <- Get Float
getFloat32le
    Float
_msgVelEcefCov_cov_y_z <- Get Float
getFloat32le
    Float
_msgVelEcefCov_cov_z_z <- Get Float
getFloat32le
    Word8
_msgVelEcefCov_n_sats <- Get Word8
getWord8
    Word8
_msgVelEcefCov_flags <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgVelEcefCov {Float
Int32
Word8
Word32
_msgVelEcefCov_flags :: Word8
_msgVelEcefCov_n_sats :: Word8
_msgVelEcefCov_cov_z_z :: Float
_msgVelEcefCov_cov_y_z :: Float
_msgVelEcefCov_cov_y_y :: Float
_msgVelEcefCov_cov_x_z :: Float
_msgVelEcefCov_cov_x_y :: Float
_msgVelEcefCov_cov_x_x :: Float
_msgVelEcefCov_z :: Int32
_msgVelEcefCov_y :: Int32
_msgVelEcefCov_x :: Int32
_msgVelEcefCov_tow :: Word32
_msgVelEcefCov_flags :: Word8
_msgVelEcefCov_n_sats :: Word8
_msgVelEcefCov_cov_z_z :: Float
_msgVelEcefCov_cov_y_z :: Float
_msgVelEcefCov_cov_y_y :: Float
_msgVelEcefCov_cov_x_z :: Float
_msgVelEcefCov_cov_x_y :: Float
_msgVelEcefCov_cov_x_x :: Float
_msgVelEcefCov_z :: Int32
_msgVelEcefCov_y :: Int32
_msgVelEcefCov_x :: Int32
_msgVelEcefCov_tow :: Word32
..}

  put :: MsgVelEcefCov -> Put
put MsgVelEcefCov {Float
Int32
Word8
Word32
_msgVelEcefCov_flags :: Word8
_msgVelEcefCov_n_sats :: Word8
_msgVelEcefCov_cov_z_z :: Float
_msgVelEcefCov_cov_y_z :: Float
_msgVelEcefCov_cov_y_y :: Float
_msgVelEcefCov_cov_x_z :: Float
_msgVelEcefCov_cov_x_y :: Float
_msgVelEcefCov_cov_x_x :: Float
_msgVelEcefCov_z :: Int32
_msgVelEcefCov_y :: Int32
_msgVelEcefCov_x :: Int32
_msgVelEcefCov_tow :: Word32
_msgVelEcefCov_flags :: MsgVelEcefCov -> Word8
_msgVelEcefCov_n_sats :: MsgVelEcefCov -> Word8
_msgVelEcefCov_cov_z_z :: MsgVelEcefCov -> Float
_msgVelEcefCov_cov_y_z :: MsgVelEcefCov -> Float
_msgVelEcefCov_cov_y_y :: MsgVelEcefCov -> Float
_msgVelEcefCov_cov_x_z :: MsgVelEcefCov -> Float
_msgVelEcefCov_cov_x_y :: MsgVelEcefCov -> Float
_msgVelEcefCov_cov_x_x :: MsgVelEcefCov -> Float
_msgVelEcefCov_z :: MsgVelEcefCov -> Int32
_msgVelEcefCov_y :: MsgVelEcefCov -> Int32
_msgVelEcefCov_x :: MsgVelEcefCov -> Int32
_msgVelEcefCov_tow :: MsgVelEcefCov -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgVelEcefCov_tow
    (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
_msgVelEcefCov_x
    (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
_msgVelEcefCov_y
    (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
_msgVelEcefCov_z
    Float -> Put
putFloat32le Float
_msgVelEcefCov_cov_x_x
    Float -> Put
putFloat32le Float
_msgVelEcefCov_cov_x_y
    Float -> Put
putFloat32le Float
_msgVelEcefCov_cov_x_z
    Float -> Put
putFloat32le Float
_msgVelEcefCov_cov_y_y
    Float -> Put
putFloat32le Float
_msgVelEcefCov_cov_y_z
    Float -> Put
putFloat32le Float
_msgVelEcefCov_cov_z_z
    Word8 -> Put
putWord8 Word8
_msgVelEcefCov_n_sats
    Word8 -> Put
putWord8 Word8
_msgVelEcefCov_flags

$(makeSBP 'msgVelEcefCov ''MsgVelEcefCov)
$(makeJSON "_msgVelEcefCov_" ''MsgVelEcefCov)
$(makeLenses ''MsgVelEcefCov)

msgVelNed :: Word16
msgVelNed :: Word16
msgVelNed = Word16
0x020E

-- | SBP class for message MSG_VEL_NED (0x020E).
--
-- This message reports the velocity in local North East Down (NED)
-- coordinates. The NED coordinate system is defined as the local WGS84
-- tangent plane centered at the current position. The full GPS time is given
-- by the preceding MSG_GPS_TIME with the matching time-of-week (tow).
data MsgVelNed = MsgVelNed
  { MsgVelNed -> Word32
_msgVelNed_tow      :: !Word32
    -- ^ GPS Time of Week
  , MsgVelNed -> Int32
_msgVelNed_n        :: !Int32
    -- ^ Velocity North coordinate
  , MsgVelNed -> Int32
_msgVelNed_e        :: !Int32
    -- ^ Velocity East coordinate
  , MsgVelNed -> Int32
_msgVelNed_d        :: !Int32
    -- ^ Velocity Down coordinate
  , MsgVelNed -> Word16
_msgVelNed_h_accuracy :: !Word16
    -- ^ Horizontal velocity estimated standard deviation
  , MsgVelNed -> Word16
_msgVelNed_v_accuracy :: !Word16
    -- ^ Vertical velocity estimated standard deviation
  , MsgVelNed -> Word8
_msgVelNed_n_sats   :: !Word8
    -- ^ Number of satellites used in solution
  , MsgVelNed -> Word8
_msgVelNed_flags    :: !Word8
    -- ^ Status flags
  } deriving ( Int -> MsgVelNed -> ShowS
[MsgVelNed] -> ShowS
MsgVelNed -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgVelNed] -> ShowS
$cshowList :: [MsgVelNed] -> ShowS
show :: MsgVelNed -> String
$cshow :: MsgVelNed -> String
showsPrec :: Int -> MsgVelNed -> ShowS
$cshowsPrec :: Int -> MsgVelNed -> ShowS
Show, ReadPrec [MsgVelNed]
ReadPrec MsgVelNed
Int -> ReadS MsgVelNed
ReadS [MsgVelNed]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgVelNed]
$creadListPrec :: ReadPrec [MsgVelNed]
readPrec :: ReadPrec MsgVelNed
$creadPrec :: ReadPrec MsgVelNed
readList :: ReadS [MsgVelNed]
$creadList :: ReadS [MsgVelNed]
readsPrec :: Int -> ReadS MsgVelNed
$creadsPrec :: Int -> ReadS MsgVelNed
Read, MsgVelNed -> MsgVelNed -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgVelNed -> MsgVelNed -> Bool
$c/= :: MsgVelNed -> MsgVelNed -> Bool
== :: MsgVelNed -> MsgVelNed -> Bool
$c== :: MsgVelNed -> MsgVelNed -> Bool
Eq )

instance Binary MsgVelNed where
  get :: Get MsgVelNed
get = do
    Word32
_msgVelNed_tow <- Get Word32
getWord32le
    Int32
_msgVelNed_n <- (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
_msgVelNed_e <- (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
_msgVelNed_d <- (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)
    Word16
_msgVelNed_h_accuracy <- Get Word16
getWord16le
    Word16
_msgVelNed_v_accuracy <- Get Word16
getWord16le
    Word8
_msgVelNed_n_sats <- Get Word8
getWord8
    Word8
_msgVelNed_flags <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgVelNed {Int32
Word8
Word16
Word32
_msgVelNed_flags :: Word8
_msgVelNed_n_sats :: Word8
_msgVelNed_v_accuracy :: Word16
_msgVelNed_h_accuracy :: Word16
_msgVelNed_d :: Int32
_msgVelNed_e :: Int32
_msgVelNed_n :: Int32
_msgVelNed_tow :: Word32
_msgVelNed_flags :: Word8
_msgVelNed_n_sats :: Word8
_msgVelNed_v_accuracy :: Word16
_msgVelNed_h_accuracy :: Word16
_msgVelNed_d :: Int32
_msgVelNed_e :: Int32
_msgVelNed_n :: Int32
_msgVelNed_tow :: Word32
..}

  put :: MsgVelNed -> Put
put MsgVelNed {Int32
Word8
Word16
Word32
_msgVelNed_flags :: Word8
_msgVelNed_n_sats :: Word8
_msgVelNed_v_accuracy :: Word16
_msgVelNed_h_accuracy :: Word16
_msgVelNed_d :: Int32
_msgVelNed_e :: Int32
_msgVelNed_n :: Int32
_msgVelNed_tow :: Word32
_msgVelNed_flags :: MsgVelNed -> Word8
_msgVelNed_n_sats :: MsgVelNed -> Word8
_msgVelNed_v_accuracy :: MsgVelNed -> Word16
_msgVelNed_h_accuracy :: MsgVelNed -> Word16
_msgVelNed_d :: MsgVelNed -> Int32
_msgVelNed_e :: MsgVelNed -> Int32
_msgVelNed_n :: MsgVelNed -> Int32
_msgVelNed_tow :: MsgVelNed -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgVelNed_tow
    (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
_msgVelNed_n
    (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
_msgVelNed_e
    (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
_msgVelNed_d
    Word16 -> Put
putWord16le Word16
_msgVelNed_h_accuracy
    Word16 -> Put
putWord16le Word16
_msgVelNed_v_accuracy
    Word8 -> Put
putWord8 Word8
_msgVelNed_n_sats
    Word8 -> Put
putWord8 Word8
_msgVelNed_flags

$(makeSBP 'msgVelNed ''MsgVelNed)
$(makeJSON "_msgVelNed_" ''MsgVelNed)
$(makeLenses ''MsgVelNed)

msgVelNedCov :: Word16
msgVelNedCov :: Word16
msgVelNedCov = Word16
0x0212

-- | SBP class for message MSG_VEL_NED_COV (0x0212).
--
-- This message reports the velocity in local North East Down (NED)
-- coordinates. The NED coordinate system is defined as the local WGS84
-- tangent plane centered at the current position. The full GPS time is given
-- by the preceding MSG_GPS_TIME with the matching time-of-week (tow). This
-- message is similar to the MSG_VEL_NED, but it includes the upper triangular
-- portion of the 3x3 covariance matrix.
data MsgVelNedCov = MsgVelNedCov
  { MsgVelNedCov -> Word32
_msgVelNedCov_tow   :: !Word32
    -- ^ GPS Time of Week
  , MsgVelNedCov -> Int32
_msgVelNedCov_n     :: !Int32
    -- ^ Velocity North coordinate
  , MsgVelNedCov -> Int32
_msgVelNedCov_e     :: !Int32
    -- ^ Velocity East coordinate
  , MsgVelNedCov -> Int32
_msgVelNedCov_d     :: !Int32
    -- ^ Velocity Down coordinate
  , MsgVelNedCov -> Float
_msgVelNedCov_cov_n_n :: !Float
    -- ^ Estimated variance of northward measurement
  , MsgVelNedCov -> Float
_msgVelNedCov_cov_n_e :: !Float
    -- ^ Covariance of northward and eastward measurement
  , MsgVelNedCov -> Float
_msgVelNedCov_cov_n_d :: !Float
    -- ^ Covariance of northward and downward measurement
  , MsgVelNedCov -> Float
_msgVelNedCov_cov_e_e :: !Float
    -- ^ Estimated variance of eastward measurement
  , MsgVelNedCov -> Float
_msgVelNedCov_cov_e_d :: !Float
    -- ^ Covariance of eastward and downward measurement
  , MsgVelNedCov -> Float
_msgVelNedCov_cov_d_d :: !Float
    -- ^ Estimated variance of downward measurement
  , MsgVelNedCov -> Word8
_msgVelNedCov_n_sats :: !Word8
    -- ^ Number of satellites used in solution
  , MsgVelNedCov -> Word8
_msgVelNedCov_flags :: !Word8
    -- ^ Status flags
  } deriving ( Int -> MsgVelNedCov -> ShowS
[MsgVelNedCov] -> ShowS
MsgVelNedCov -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgVelNedCov] -> ShowS
$cshowList :: [MsgVelNedCov] -> ShowS
show :: MsgVelNedCov -> String
$cshow :: MsgVelNedCov -> String
showsPrec :: Int -> MsgVelNedCov -> ShowS
$cshowsPrec :: Int -> MsgVelNedCov -> ShowS
Show, ReadPrec [MsgVelNedCov]
ReadPrec MsgVelNedCov
Int -> ReadS MsgVelNedCov
ReadS [MsgVelNedCov]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgVelNedCov]
$creadListPrec :: ReadPrec [MsgVelNedCov]
readPrec :: ReadPrec MsgVelNedCov
$creadPrec :: ReadPrec MsgVelNedCov
readList :: ReadS [MsgVelNedCov]
$creadList :: ReadS [MsgVelNedCov]
readsPrec :: Int -> ReadS MsgVelNedCov
$creadsPrec :: Int -> ReadS MsgVelNedCov
Read, MsgVelNedCov -> MsgVelNedCov -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgVelNedCov -> MsgVelNedCov -> Bool
$c/= :: MsgVelNedCov -> MsgVelNedCov -> Bool
== :: MsgVelNedCov -> MsgVelNedCov -> Bool
$c== :: MsgVelNedCov -> MsgVelNedCov -> Bool
Eq )

instance Binary MsgVelNedCov where
  get :: Get MsgVelNedCov
get = do
    Word32
_msgVelNedCov_tow <- Get Word32
getWord32le
    Int32
_msgVelNedCov_n <- (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
_msgVelNedCov_e <- (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
_msgVelNedCov_d <- (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)
    Float
_msgVelNedCov_cov_n_n <- Get Float
getFloat32le
    Float
_msgVelNedCov_cov_n_e <- Get Float
getFloat32le
    Float
_msgVelNedCov_cov_n_d <- Get Float
getFloat32le
    Float
_msgVelNedCov_cov_e_e <- Get Float
getFloat32le
    Float
_msgVelNedCov_cov_e_d <- Get Float
getFloat32le
    Float
_msgVelNedCov_cov_d_d <- Get Float
getFloat32le
    Word8
_msgVelNedCov_n_sats <- Get Word8
getWord8
    Word8
_msgVelNedCov_flags <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgVelNedCov {Float
Int32
Word8
Word32
_msgVelNedCov_flags :: Word8
_msgVelNedCov_n_sats :: Word8
_msgVelNedCov_cov_d_d :: Float
_msgVelNedCov_cov_e_d :: Float
_msgVelNedCov_cov_e_e :: Float
_msgVelNedCov_cov_n_d :: Float
_msgVelNedCov_cov_n_e :: Float
_msgVelNedCov_cov_n_n :: Float
_msgVelNedCov_d :: Int32
_msgVelNedCov_e :: Int32
_msgVelNedCov_n :: Int32
_msgVelNedCov_tow :: Word32
_msgVelNedCov_flags :: Word8
_msgVelNedCov_n_sats :: Word8
_msgVelNedCov_cov_d_d :: Float
_msgVelNedCov_cov_e_d :: Float
_msgVelNedCov_cov_e_e :: Float
_msgVelNedCov_cov_n_d :: Float
_msgVelNedCov_cov_n_e :: Float
_msgVelNedCov_cov_n_n :: Float
_msgVelNedCov_d :: Int32
_msgVelNedCov_e :: Int32
_msgVelNedCov_n :: Int32
_msgVelNedCov_tow :: Word32
..}

  put :: MsgVelNedCov -> Put
put MsgVelNedCov {Float
Int32
Word8
Word32
_msgVelNedCov_flags :: Word8
_msgVelNedCov_n_sats :: Word8
_msgVelNedCov_cov_d_d :: Float
_msgVelNedCov_cov_e_d :: Float
_msgVelNedCov_cov_e_e :: Float
_msgVelNedCov_cov_n_d :: Float
_msgVelNedCov_cov_n_e :: Float
_msgVelNedCov_cov_n_n :: Float
_msgVelNedCov_d :: Int32
_msgVelNedCov_e :: Int32
_msgVelNedCov_n :: Int32
_msgVelNedCov_tow :: Word32
_msgVelNedCov_flags :: MsgVelNedCov -> Word8
_msgVelNedCov_n_sats :: MsgVelNedCov -> Word8
_msgVelNedCov_cov_d_d :: MsgVelNedCov -> Float
_msgVelNedCov_cov_e_d :: MsgVelNedCov -> Float
_msgVelNedCov_cov_e_e :: MsgVelNedCov -> Float
_msgVelNedCov_cov_n_d :: MsgVelNedCov -> Float
_msgVelNedCov_cov_n_e :: MsgVelNedCov -> Float
_msgVelNedCov_cov_n_n :: MsgVelNedCov -> Float
_msgVelNedCov_d :: MsgVelNedCov -> Int32
_msgVelNedCov_e :: MsgVelNedCov -> Int32
_msgVelNedCov_n :: MsgVelNedCov -> Int32
_msgVelNedCov_tow :: MsgVelNedCov -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgVelNedCov_tow
    (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
_msgVelNedCov_n
    (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
_msgVelNedCov_e
    (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
_msgVelNedCov_d
    Float -> Put
putFloat32le Float
_msgVelNedCov_cov_n_n
    Float -> Put
putFloat32le Float
_msgVelNedCov_cov_n_e
    Float -> Put
putFloat32le Float
_msgVelNedCov_cov_n_d
    Float -> Put
putFloat32le Float
_msgVelNedCov_cov_e_e
    Float -> Put
putFloat32le Float
_msgVelNedCov_cov_e_d
    Float -> Put
putFloat32le Float
_msgVelNedCov_cov_d_d
    Word8 -> Put
putWord8 Word8
_msgVelNedCov_n_sats
    Word8 -> Put
putWord8 Word8
_msgVelNedCov_flags

$(makeSBP 'msgVelNedCov ''MsgVelNedCov)
$(makeJSON "_msgVelNedCov_" ''MsgVelNedCov)
$(makeLenses ''MsgVelNedCov)

msgPosEcefGnss :: Word16
msgPosEcefGnss :: Word16
msgPosEcefGnss = Word16
0x0229

-- | SBP class for message MSG_POS_ECEF_GNSS (0x0229).
--
-- The position solution message reports absolute Earth Centered Earth Fixed
-- (ECEF) coordinates and the status (single point vs pseudo-absolute RTK) of
-- the position solution. If the rover receiver knows the surveyed position of
-- the base station and has an RTK solution, this reports a pseudo-absolute
-- position solution using the base station position and the rover's RTK
-- baseline vector. The full GPS time is given by the preceding MSG_GPS_TIME
-- with the matching time-of-week (tow).
data MsgPosEcefGnss = MsgPosEcefGnss
  { MsgPosEcefGnss -> Word32
_msgPosEcefGnss_tow    :: !Word32
    -- ^ GPS Time of Week
  , MsgPosEcefGnss -> Double
_msgPosEcefGnss_x      :: !Double
    -- ^ ECEF X coordinate
  , MsgPosEcefGnss -> Double
_msgPosEcefGnss_y      :: !Double
    -- ^ ECEF Y coordinate
  , MsgPosEcefGnss -> Double
_msgPosEcefGnss_z      :: !Double
    -- ^ ECEF Z coordinate
  , MsgPosEcefGnss -> Word16
_msgPosEcefGnss_accuracy :: !Word16
    -- ^ Position estimated standard deviation
  , MsgPosEcefGnss -> Word8
_msgPosEcefGnss_n_sats :: !Word8
    -- ^ Number of satellites used in solution
  , MsgPosEcefGnss -> Word8
_msgPosEcefGnss_flags  :: !Word8
    -- ^ Status flags
  } deriving ( Int -> MsgPosEcefGnss -> ShowS
[MsgPosEcefGnss] -> ShowS
MsgPosEcefGnss -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgPosEcefGnss] -> ShowS
$cshowList :: [MsgPosEcefGnss] -> ShowS
show :: MsgPosEcefGnss -> String
$cshow :: MsgPosEcefGnss -> String
showsPrec :: Int -> MsgPosEcefGnss -> ShowS
$cshowsPrec :: Int -> MsgPosEcefGnss -> ShowS
Show, ReadPrec [MsgPosEcefGnss]
ReadPrec MsgPosEcefGnss
Int -> ReadS MsgPosEcefGnss
ReadS [MsgPosEcefGnss]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgPosEcefGnss]
$creadListPrec :: ReadPrec [MsgPosEcefGnss]
readPrec :: ReadPrec MsgPosEcefGnss
$creadPrec :: ReadPrec MsgPosEcefGnss
readList :: ReadS [MsgPosEcefGnss]
$creadList :: ReadS [MsgPosEcefGnss]
readsPrec :: Int -> ReadS MsgPosEcefGnss
$creadsPrec :: Int -> ReadS MsgPosEcefGnss
Read, MsgPosEcefGnss -> MsgPosEcefGnss -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgPosEcefGnss -> MsgPosEcefGnss -> Bool
$c/= :: MsgPosEcefGnss -> MsgPosEcefGnss -> Bool
== :: MsgPosEcefGnss -> MsgPosEcefGnss -> Bool
$c== :: MsgPosEcefGnss -> MsgPosEcefGnss -> Bool
Eq )

instance Binary MsgPosEcefGnss where
  get :: Get MsgPosEcefGnss
get = do
    Word32
_msgPosEcefGnss_tow <- Get Word32
getWord32le
    Double
_msgPosEcefGnss_x <- Get Double
getFloat64le
    Double
_msgPosEcefGnss_y <- Get Double
getFloat64le
    Double
_msgPosEcefGnss_z <- Get Double
getFloat64le
    Word16
_msgPosEcefGnss_accuracy <- Get Word16
getWord16le
    Word8
_msgPosEcefGnss_n_sats <- Get Word8
getWord8
    Word8
_msgPosEcefGnss_flags <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgPosEcefGnss {Double
Word8
Word16
Word32
_msgPosEcefGnss_flags :: Word8
_msgPosEcefGnss_n_sats :: Word8
_msgPosEcefGnss_accuracy :: Word16
_msgPosEcefGnss_z :: Double
_msgPosEcefGnss_y :: Double
_msgPosEcefGnss_x :: Double
_msgPosEcefGnss_tow :: Word32
_msgPosEcefGnss_flags :: Word8
_msgPosEcefGnss_n_sats :: Word8
_msgPosEcefGnss_accuracy :: Word16
_msgPosEcefGnss_z :: Double
_msgPosEcefGnss_y :: Double
_msgPosEcefGnss_x :: Double
_msgPosEcefGnss_tow :: Word32
..}

  put :: MsgPosEcefGnss -> Put
put MsgPosEcefGnss {Double
Word8
Word16
Word32
_msgPosEcefGnss_flags :: Word8
_msgPosEcefGnss_n_sats :: Word8
_msgPosEcefGnss_accuracy :: Word16
_msgPosEcefGnss_z :: Double
_msgPosEcefGnss_y :: Double
_msgPosEcefGnss_x :: Double
_msgPosEcefGnss_tow :: Word32
_msgPosEcefGnss_flags :: MsgPosEcefGnss -> Word8
_msgPosEcefGnss_n_sats :: MsgPosEcefGnss -> Word8
_msgPosEcefGnss_accuracy :: MsgPosEcefGnss -> Word16
_msgPosEcefGnss_z :: MsgPosEcefGnss -> Double
_msgPosEcefGnss_y :: MsgPosEcefGnss -> Double
_msgPosEcefGnss_x :: MsgPosEcefGnss -> Double
_msgPosEcefGnss_tow :: MsgPosEcefGnss -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgPosEcefGnss_tow
    Double -> Put
putFloat64le Double
_msgPosEcefGnss_x
    Double -> Put
putFloat64le Double
_msgPosEcefGnss_y
    Double -> Put
putFloat64le Double
_msgPosEcefGnss_z
    Word16 -> Put
putWord16le Word16
_msgPosEcefGnss_accuracy
    Word8 -> Put
putWord8 Word8
_msgPosEcefGnss_n_sats
    Word8 -> Put
putWord8 Word8
_msgPosEcefGnss_flags

$(makeSBP 'msgPosEcefGnss ''MsgPosEcefGnss)
$(makeJSON "_msgPosEcefGnss_" ''MsgPosEcefGnss)
$(makeLenses ''MsgPosEcefGnss)

msgPosEcefCovGnss :: Word16
msgPosEcefCovGnss :: Word16
msgPosEcefCovGnss = Word16
0x0234

-- | SBP class for message MSG_POS_ECEF_COV_GNSS (0x0234).
--
-- The position solution message reports absolute Earth Centered Earth Fixed
-- (ECEF) coordinates and the status (single point vs pseudo-absolute RTK) of
-- the position solution. The message also reports the upper triangular
-- portion of the 3x3 covariance matrix. If the receiver knows the surveyed
-- position of the base station and has an RTK solution, this reports a
-- pseudo-absolute position solution using the base station position and the
-- rover's RTK baseline vector. The full GPS time is given by the preceding
-- MSG_GPS_TIME with the matching time-of-week (tow).
data MsgPosEcefCovGnss = MsgPosEcefCovGnss
  { MsgPosEcefCovGnss -> Word32
_msgPosEcefCovGnss_tow   :: !Word32
    -- ^ GPS Time of Week
  , MsgPosEcefCovGnss -> Double
_msgPosEcefCovGnss_x     :: !Double
    -- ^ ECEF X coordinate
  , MsgPosEcefCovGnss -> Double
_msgPosEcefCovGnss_y     :: !Double
    -- ^ ECEF Y coordinate
  , MsgPosEcefCovGnss -> Double
_msgPosEcefCovGnss_z     :: !Double
    -- ^ ECEF Z coordinate
  , MsgPosEcefCovGnss -> Float
_msgPosEcefCovGnss_cov_x_x :: !Float
    -- ^ Estimated variance of x
  , MsgPosEcefCovGnss -> Float
_msgPosEcefCovGnss_cov_x_y :: !Float
    -- ^ Estimated covariance of x and y
  , MsgPosEcefCovGnss -> Float
_msgPosEcefCovGnss_cov_x_z :: !Float
    -- ^ Estimated covariance of x and z
  , MsgPosEcefCovGnss -> Float
_msgPosEcefCovGnss_cov_y_y :: !Float
    -- ^ Estimated variance of y
  , MsgPosEcefCovGnss -> Float
_msgPosEcefCovGnss_cov_y_z :: !Float
    -- ^ Estimated covariance of y and z
  , MsgPosEcefCovGnss -> Float
_msgPosEcefCovGnss_cov_z_z :: !Float
    -- ^ Estimated variance of z
  , MsgPosEcefCovGnss -> Word8
_msgPosEcefCovGnss_n_sats :: !Word8
    -- ^ Number of satellites used in solution
  , MsgPosEcefCovGnss -> Word8
_msgPosEcefCovGnss_flags :: !Word8
    -- ^ Status flags
  } deriving ( Int -> MsgPosEcefCovGnss -> ShowS
[MsgPosEcefCovGnss] -> ShowS
MsgPosEcefCovGnss -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgPosEcefCovGnss] -> ShowS
$cshowList :: [MsgPosEcefCovGnss] -> ShowS
show :: MsgPosEcefCovGnss -> String
$cshow :: MsgPosEcefCovGnss -> String
showsPrec :: Int -> MsgPosEcefCovGnss -> ShowS
$cshowsPrec :: Int -> MsgPosEcefCovGnss -> ShowS
Show, ReadPrec [MsgPosEcefCovGnss]
ReadPrec MsgPosEcefCovGnss
Int -> ReadS MsgPosEcefCovGnss
ReadS [MsgPosEcefCovGnss]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgPosEcefCovGnss]
$creadListPrec :: ReadPrec [MsgPosEcefCovGnss]
readPrec :: ReadPrec MsgPosEcefCovGnss
$creadPrec :: ReadPrec MsgPosEcefCovGnss
readList :: ReadS [MsgPosEcefCovGnss]
$creadList :: ReadS [MsgPosEcefCovGnss]
readsPrec :: Int -> ReadS MsgPosEcefCovGnss
$creadsPrec :: Int -> ReadS MsgPosEcefCovGnss
Read, MsgPosEcefCovGnss -> MsgPosEcefCovGnss -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgPosEcefCovGnss -> MsgPosEcefCovGnss -> Bool
$c/= :: MsgPosEcefCovGnss -> MsgPosEcefCovGnss -> Bool
== :: MsgPosEcefCovGnss -> MsgPosEcefCovGnss -> Bool
$c== :: MsgPosEcefCovGnss -> MsgPosEcefCovGnss -> Bool
Eq )

instance Binary MsgPosEcefCovGnss where
  get :: Get MsgPosEcefCovGnss
get = do
    Word32
_msgPosEcefCovGnss_tow <- Get Word32
getWord32le
    Double
_msgPosEcefCovGnss_x <- Get Double
getFloat64le
    Double
_msgPosEcefCovGnss_y <- Get Double
getFloat64le
    Double
_msgPosEcefCovGnss_z <- Get Double
getFloat64le
    Float
_msgPosEcefCovGnss_cov_x_x <- Get Float
getFloat32le
    Float
_msgPosEcefCovGnss_cov_x_y <- Get Float
getFloat32le
    Float
_msgPosEcefCovGnss_cov_x_z <- Get Float
getFloat32le
    Float
_msgPosEcefCovGnss_cov_y_y <- Get Float
getFloat32le
    Float
_msgPosEcefCovGnss_cov_y_z <- Get Float
getFloat32le
    Float
_msgPosEcefCovGnss_cov_z_z <- Get Float
getFloat32le
    Word8
_msgPosEcefCovGnss_n_sats <- Get Word8
getWord8
    Word8
_msgPosEcefCovGnss_flags <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgPosEcefCovGnss {Double
Float
Word8
Word32
_msgPosEcefCovGnss_flags :: Word8
_msgPosEcefCovGnss_n_sats :: Word8
_msgPosEcefCovGnss_cov_z_z :: Float
_msgPosEcefCovGnss_cov_y_z :: Float
_msgPosEcefCovGnss_cov_y_y :: Float
_msgPosEcefCovGnss_cov_x_z :: Float
_msgPosEcefCovGnss_cov_x_y :: Float
_msgPosEcefCovGnss_cov_x_x :: Float
_msgPosEcefCovGnss_z :: Double
_msgPosEcefCovGnss_y :: Double
_msgPosEcefCovGnss_x :: Double
_msgPosEcefCovGnss_tow :: Word32
_msgPosEcefCovGnss_flags :: Word8
_msgPosEcefCovGnss_n_sats :: Word8
_msgPosEcefCovGnss_cov_z_z :: Float
_msgPosEcefCovGnss_cov_y_z :: Float
_msgPosEcefCovGnss_cov_y_y :: Float
_msgPosEcefCovGnss_cov_x_z :: Float
_msgPosEcefCovGnss_cov_x_y :: Float
_msgPosEcefCovGnss_cov_x_x :: Float
_msgPosEcefCovGnss_z :: Double
_msgPosEcefCovGnss_y :: Double
_msgPosEcefCovGnss_x :: Double
_msgPosEcefCovGnss_tow :: Word32
..}

  put :: MsgPosEcefCovGnss -> Put
put MsgPosEcefCovGnss {Double
Float
Word8
Word32
_msgPosEcefCovGnss_flags :: Word8
_msgPosEcefCovGnss_n_sats :: Word8
_msgPosEcefCovGnss_cov_z_z :: Float
_msgPosEcefCovGnss_cov_y_z :: Float
_msgPosEcefCovGnss_cov_y_y :: Float
_msgPosEcefCovGnss_cov_x_z :: Float
_msgPosEcefCovGnss_cov_x_y :: Float
_msgPosEcefCovGnss_cov_x_x :: Float
_msgPosEcefCovGnss_z :: Double
_msgPosEcefCovGnss_y :: Double
_msgPosEcefCovGnss_x :: Double
_msgPosEcefCovGnss_tow :: Word32
_msgPosEcefCovGnss_flags :: MsgPosEcefCovGnss -> Word8
_msgPosEcefCovGnss_n_sats :: MsgPosEcefCovGnss -> Word8
_msgPosEcefCovGnss_cov_z_z :: MsgPosEcefCovGnss -> Float
_msgPosEcefCovGnss_cov_y_z :: MsgPosEcefCovGnss -> Float
_msgPosEcefCovGnss_cov_y_y :: MsgPosEcefCovGnss -> Float
_msgPosEcefCovGnss_cov_x_z :: MsgPosEcefCovGnss -> Float
_msgPosEcefCovGnss_cov_x_y :: MsgPosEcefCovGnss -> Float
_msgPosEcefCovGnss_cov_x_x :: MsgPosEcefCovGnss -> Float
_msgPosEcefCovGnss_z :: MsgPosEcefCovGnss -> Double
_msgPosEcefCovGnss_y :: MsgPosEcefCovGnss -> Double
_msgPosEcefCovGnss_x :: MsgPosEcefCovGnss -> Double
_msgPosEcefCovGnss_tow :: MsgPosEcefCovGnss -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgPosEcefCovGnss_tow
    Double -> Put
putFloat64le Double
_msgPosEcefCovGnss_x
    Double -> Put
putFloat64le Double
_msgPosEcefCovGnss_y
    Double -> Put
putFloat64le Double
_msgPosEcefCovGnss_z
    Float -> Put
putFloat32le Float
_msgPosEcefCovGnss_cov_x_x
    Float -> Put
putFloat32le Float
_msgPosEcefCovGnss_cov_x_y
    Float -> Put
putFloat32le Float
_msgPosEcefCovGnss_cov_x_z
    Float -> Put
putFloat32le Float
_msgPosEcefCovGnss_cov_y_y
    Float -> Put
putFloat32le Float
_msgPosEcefCovGnss_cov_y_z
    Float -> Put
putFloat32le Float
_msgPosEcefCovGnss_cov_z_z
    Word8 -> Put
putWord8 Word8
_msgPosEcefCovGnss_n_sats
    Word8 -> Put
putWord8 Word8
_msgPosEcefCovGnss_flags

$(makeSBP 'msgPosEcefCovGnss ''MsgPosEcefCovGnss)
$(makeJSON "_msgPosEcefCovGnss_" ''MsgPosEcefCovGnss)
$(makeLenses ''MsgPosEcefCovGnss)

msgPosLlhGnss :: Word16
msgPosLlhGnss :: Word16
msgPosLlhGnss = Word16
0x022A

-- | SBP class for message MSG_POS_LLH_GNSS (0x022A).
--
-- This position solution message reports the absolute geodetic coordinates
-- and the status (single point vs pseudo-absolute RTK) of the position
-- solution. If the rover receiver knows the surveyed position of the base
-- station and has an RTK solution, this reports a pseudo-absolute position
-- solution using the base station position and the rover's RTK baseline
-- vector. The full GPS time is given by the preceding MSG_GPS_TIME with the
-- matching time-of-week (tow).
data MsgPosLlhGnss = MsgPosLlhGnss
  { MsgPosLlhGnss -> Word32
_msgPosLlhGnss_tow      :: !Word32
    -- ^ GPS Time of Week
  , MsgPosLlhGnss -> Double
_msgPosLlhGnss_lat      :: !Double
    -- ^ Latitude
  , MsgPosLlhGnss -> Double
_msgPosLlhGnss_lon      :: !Double
    -- ^ Longitude
  , MsgPosLlhGnss -> Double
_msgPosLlhGnss_height   :: !Double
    -- ^ Height above WGS84 ellipsoid
  , MsgPosLlhGnss -> Word16
_msgPosLlhGnss_h_accuracy :: !Word16
    -- ^ Horizontal position estimated standard deviation
  , MsgPosLlhGnss -> Word16
_msgPosLlhGnss_v_accuracy :: !Word16
    -- ^ Vertical position estimated standard deviation
  , MsgPosLlhGnss -> Word8
_msgPosLlhGnss_n_sats   :: !Word8
    -- ^ Number of satellites used in solution.
  , MsgPosLlhGnss -> Word8
_msgPosLlhGnss_flags    :: !Word8
    -- ^ Status flags
  } deriving ( Int -> MsgPosLlhGnss -> ShowS
[MsgPosLlhGnss] -> ShowS
MsgPosLlhGnss -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgPosLlhGnss] -> ShowS
$cshowList :: [MsgPosLlhGnss] -> ShowS
show :: MsgPosLlhGnss -> String
$cshow :: MsgPosLlhGnss -> String
showsPrec :: Int -> MsgPosLlhGnss -> ShowS
$cshowsPrec :: Int -> MsgPosLlhGnss -> ShowS
Show, ReadPrec [MsgPosLlhGnss]
ReadPrec MsgPosLlhGnss
Int -> ReadS MsgPosLlhGnss
ReadS [MsgPosLlhGnss]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgPosLlhGnss]
$creadListPrec :: ReadPrec [MsgPosLlhGnss]
readPrec :: ReadPrec MsgPosLlhGnss
$creadPrec :: ReadPrec MsgPosLlhGnss
readList :: ReadS [MsgPosLlhGnss]
$creadList :: ReadS [MsgPosLlhGnss]
readsPrec :: Int -> ReadS MsgPosLlhGnss
$creadsPrec :: Int -> ReadS MsgPosLlhGnss
Read, MsgPosLlhGnss -> MsgPosLlhGnss -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgPosLlhGnss -> MsgPosLlhGnss -> Bool
$c/= :: MsgPosLlhGnss -> MsgPosLlhGnss -> Bool
== :: MsgPosLlhGnss -> MsgPosLlhGnss -> Bool
$c== :: MsgPosLlhGnss -> MsgPosLlhGnss -> Bool
Eq )

instance Binary MsgPosLlhGnss where
  get :: Get MsgPosLlhGnss
get = do
    Word32
_msgPosLlhGnss_tow <- Get Word32
getWord32le
    Double
_msgPosLlhGnss_lat <- Get Double
getFloat64le
    Double
_msgPosLlhGnss_lon <- Get Double
getFloat64le
    Double
_msgPosLlhGnss_height <- Get Double
getFloat64le
    Word16
_msgPosLlhGnss_h_accuracy <- Get Word16
getWord16le
    Word16
_msgPosLlhGnss_v_accuracy <- Get Word16
getWord16le
    Word8
_msgPosLlhGnss_n_sats <- Get Word8
getWord8
    Word8
_msgPosLlhGnss_flags <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgPosLlhGnss {Double
Word8
Word16
Word32
_msgPosLlhGnss_flags :: Word8
_msgPosLlhGnss_n_sats :: Word8
_msgPosLlhGnss_v_accuracy :: Word16
_msgPosLlhGnss_h_accuracy :: Word16
_msgPosLlhGnss_height :: Double
_msgPosLlhGnss_lon :: Double
_msgPosLlhGnss_lat :: Double
_msgPosLlhGnss_tow :: Word32
_msgPosLlhGnss_flags :: Word8
_msgPosLlhGnss_n_sats :: Word8
_msgPosLlhGnss_v_accuracy :: Word16
_msgPosLlhGnss_h_accuracy :: Word16
_msgPosLlhGnss_height :: Double
_msgPosLlhGnss_lon :: Double
_msgPosLlhGnss_lat :: Double
_msgPosLlhGnss_tow :: Word32
..}

  put :: MsgPosLlhGnss -> Put
put MsgPosLlhGnss {Double
Word8
Word16
Word32
_msgPosLlhGnss_flags :: Word8
_msgPosLlhGnss_n_sats :: Word8
_msgPosLlhGnss_v_accuracy :: Word16
_msgPosLlhGnss_h_accuracy :: Word16
_msgPosLlhGnss_height :: Double
_msgPosLlhGnss_lon :: Double
_msgPosLlhGnss_lat :: Double
_msgPosLlhGnss_tow :: Word32
_msgPosLlhGnss_flags :: MsgPosLlhGnss -> Word8
_msgPosLlhGnss_n_sats :: MsgPosLlhGnss -> Word8
_msgPosLlhGnss_v_accuracy :: MsgPosLlhGnss -> Word16
_msgPosLlhGnss_h_accuracy :: MsgPosLlhGnss -> Word16
_msgPosLlhGnss_height :: MsgPosLlhGnss -> Double
_msgPosLlhGnss_lon :: MsgPosLlhGnss -> Double
_msgPosLlhGnss_lat :: MsgPosLlhGnss -> Double
_msgPosLlhGnss_tow :: MsgPosLlhGnss -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgPosLlhGnss_tow
    Double -> Put
putFloat64le Double
_msgPosLlhGnss_lat
    Double -> Put
putFloat64le Double
_msgPosLlhGnss_lon
    Double -> Put
putFloat64le Double
_msgPosLlhGnss_height
    Word16 -> Put
putWord16le Word16
_msgPosLlhGnss_h_accuracy
    Word16 -> Put
putWord16le Word16
_msgPosLlhGnss_v_accuracy
    Word8 -> Put
putWord8 Word8
_msgPosLlhGnss_n_sats
    Word8 -> Put
putWord8 Word8
_msgPosLlhGnss_flags

$(makeSBP 'msgPosLlhGnss ''MsgPosLlhGnss)
$(makeJSON "_msgPosLlhGnss_" ''MsgPosLlhGnss)
$(makeLenses ''MsgPosLlhGnss)

msgPosLlhCovGnss :: Word16
msgPosLlhCovGnss :: Word16
msgPosLlhCovGnss = Word16
0x0231

-- | SBP class for message MSG_POS_LLH_COV_GNSS (0x0231).
--
-- This position solution message reports the absolute geodetic coordinates
-- and the status (single point vs pseudo-absolute RTK) of the position
-- solution as well as the upper triangle of the 3x3 covariance matrix.  The
-- position information and Fix Mode flags should follow the MSG_POS_LLH
-- message.  Since the covariance matrix is computed in the local-level North,
-- East, Down frame, the covariance terms follow with that convention. Thus,
-- covariances are reported against the "downward" measurement and care should
-- be taken with the sign convention.
data MsgPosLlhCovGnss = MsgPosLlhCovGnss
  { MsgPosLlhCovGnss -> Word32
_msgPosLlhCovGnss_tow   :: !Word32
    -- ^ GPS Time of Week
  , MsgPosLlhCovGnss -> Double
_msgPosLlhCovGnss_lat   :: !Double
    -- ^ Latitude
  , MsgPosLlhCovGnss -> Double
_msgPosLlhCovGnss_lon   :: !Double
    -- ^ Longitude
  , MsgPosLlhCovGnss -> Double
_msgPosLlhCovGnss_height :: !Double
    -- ^ Height above WGS84 ellipsoid
  , MsgPosLlhCovGnss -> Float
_msgPosLlhCovGnss_cov_n_n :: !Float
    -- ^ Estimated variance of northing
  , MsgPosLlhCovGnss -> Float
_msgPosLlhCovGnss_cov_n_e :: !Float
    -- ^ Covariance of northing and easting
  , MsgPosLlhCovGnss -> Float
_msgPosLlhCovGnss_cov_n_d :: !Float
    -- ^ Covariance of northing and downward measurement
  , MsgPosLlhCovGnss -> Float
_msgPosLlhCovGnss_cov_e_e :: !Float
    -- ^ Estimated variance of easting
  , MsgPosLlhCovGnss -> Float
_msgPosLlhCovGnss_cov_e_d :: !Float
    -- ^ Covariance of easting and downward measurement
  , MsgPosLlhCovGnss -> Float
_msgPosLlhCovGnss_cov_d_d :: !Float
    -- ^ Estimated variance of downward measurement
  , MsgPosLlhCovGnss -> Word8
_msgPosLlhCovGnss_n_sats :: !Word8
    -- ^ Number of satellites used in solution.
  , MsgPosLlhCovGnss -> Word8
_msgPosLlhCovGnss_flags :: !Word8
    -- ^ Status flags
  } deriving ( Int -> MsgPosLlhCovGnss -> ShowS
[MsgPosLlhCovGnss] -> ShowS
MsgPosLlhCovGnss -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgPosLlhCovGnss] -> ShowS
$cshowList :: [MsgPosLlhCovGnss] -> ShowS
show :: MsgPosLlhCovGnss -> String
$cshow :: MsgPosLlhCovGnss -> String
showsPrec :: Int -> MsgPosLlhCovGnss -> ShowS
$cshowsPrec :: Int -> MsgPosLlhCovGnss -> ShowS
Show, ReadPrec [MsgPosLlhCovGnss]
ReadPrec MsgPosLlhCovGnss
Int -> ReadS MsgPosLlhCovGnss
ReadS [MsgPosLlhCovGnss]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgPosLlhCovGnss]
$creadListPrec :: ReadPrec [MsgPosLlhCovGnss]
readPrec :: ReadPrec MsgPosLlhCovGnss
$creadPrec :: ReadPrec MsgPosLlhCovGnss
readList :: ReadS [MsgPosLlhCovGnss]
$creadList :: ReadS [MsgPosLlhCovGnss]
readsPrec :: Int -> ReadS MsgPosLlhCovGnss
$creadsPrec :: Int -> ReadS MsgPosLlhCovGnss
Read, MsgPosLlhCovGnss -> MsgPosLlhCovGnss -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgPosLlhCovGnss -> MsgPosLlhCovGnss -> Bool
$c/= :: MsgPosLlhCovGnss -> MsgPosLlhCovGnss -> Bool
== :: MsgPosLlhCovGnss -> MsgPosLlhCovGnss -> Bool
$c== :: MsgPosLlhCovGnss -> MsgPosLlhCovGnss -> Bool
Eq )

instance Binary MsgPosLlhCovGnss where
  get :: Get MsgPosLlhCovGnss
get = do
    Word32
_msgPosLlhCovGnss_tow <- Get Word32
getWord32le
    Double
_msgPosLlhCovGnss_lat <- Get Double
getFloat64le
    Double
_msgPosLlhCovGnss_lon <- Get Double
getFloat64le
    Double
_msgPosLlhCovGnss_height <- Get Double
getFloat64le
    Float
_msgPosLlhCovGnss_cov_n_n <- Get Float
getFloat32le
    Float
_msgPosLlhCovGnss_cov_n_e <- Get Float
getFloat32le
    Float
_msgPosLlhCovGnss_cov_n_d <- Get Float
getFloat32le
    Float
_msgPosLlhCovGnss_cov_e_e <- Get Float
getFloat32le
    Float
_msgPosLlhCovGnss_cov_e_d <- Get Float
getFloat32le
    Float
_msgPosLlhCovGnss_cov_d_d <- Get Float
getFloat32le
    Word8
_msgPosLlhCovGnss_n_sats <- Get Word8
getWord8
    Word8
_msgPosLlhCovGnss_flags <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgPosLlhCovGnss {Double
Float
Word8
Word32
_msgPosLlhCovGnss_flags :: Word8
_msgPosLlhCovGnss_n_sats :: Word8
_msgPosLlhCovGnss_cov_d_d :: Float
_msgPosLlhCovGnss_cov_e_d :: Float
_msgPosLlhCovGnss_cov_e_e :: Float
_msgPosLlhCovGnss_cov_n_d :: Float
_msgPosLlhCovGnss_cov_n_e :: Float
_msgPosLlhCovGnss_cov_n_n :: Float
_msgPosLlhCovGnss_height :: Double
_msgPosLlhCovGnss_lon :: Double
_msgPosLlhCovGnss_lat :: Double
_msgPosLlhCovGnss_tow :: Word32
_msgPosLlhCovGnss_flags :: Word8
_msgPosLlhCovGnss_n_sats :: Word8
_msgPosLlhCovGnss_cov_d_d :: Float
_msgPosLlhCovGnss_cov_e_d :: Float
_msgPosLlhCovGnss_cov_e_e :: Float
_msgPosLlhCovGnss_cov_n_d :: Float
_msgPosLlhCovGnss_cov_n_e :: Float
_msgPosLlhCovGnss_cov_n_n :: Float
_msgPosLlhCovGnss_height :: Double
_msgPosLlhCovGnss_lon :: Double
_msgPosLlhCovGnss_lat :: Double
_msgPosLlhCovGnss_tow :: Word32
..}

  put :: MsgPosLlhCovGnss -> Put
put MsgPosLlhCovGnss {Double
Float
Word8
Word32
_msgPosLlhCovGnss_flags :: Word8
_msgPosLlhCovGnss_n_sats :: Word8
_msgPosLlhCovGnss_cov_d_d :: Float
_msgPosLlhCovGnss_cov_e_d :: Float
_msgPosLlhCovGnss_cov_e_e :: Float
_msgPosLlhCovGnss_cov_n_d :: Float
_msgPosLlhCovGnss_cov_n_e :: Float
_msgPosLlhCovGnss_cov_n_n :: Float
_msgPosLlhCovGnss_height :: Double
_msgPosLlhCovGnss_lon :: Double
_msgPosLlhCovGnss_lat :: Double
_msgPosLlhCovGnss_tow :: Word32
_msgPosLlhCovGnss_flags :: MsgPosLlhCovGnss -> Word8
_msgPosLlhCovGnss_n_sats :: MsgPosLlhCovGnss -> Word8
_msgPosLlhCovGnss_cov_d_d :: MsgPosLlhCovGnss -> Float
_msgPosLlhCovGnss_cov_e_d :: MsgPosLlhCovGnss -> Float
_msgPosLlhCovGnss_cov_e_e :: MsgPosLlhCovGnss -> Float
_msgPosLlhCovGnss_cov_n_d :: MsgPosLlhCovGnss -> Float
_msgPosLlhCovGnss_cov_n_e :: MsgPosLlhCovGnss -> Float
_msgPosLlhCovGnss_cov_n_n :: MsgPosLlhCovGnss -> Float
_msgPosLlhCovGnss_height :: MsgPosLlhCovGnss -> Double
_msgPosLlhCovGnss_lon :: MsgPosLlhCovGnss -> Double
_msgPosLlhCovGnss_lat :: MsgPosLlhCovGnss -> Double
_msgPosLlhCovGnss_tow :: MsgPosLlhCovGnss -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgPosLlhCovGnss_tow
    Double -> Put
putFloat64le Double
_msgPosLlhCovGnss_lat
    Double -> Put
putFloat64le Double
_msgPosLlhCovGnss_lon
    Double -> Put
putFloat64le Double
_msgPosLlhCovGnss_height
    Float -> Put
putFloat32le Float
_msgPosLlhCovGnss_cov_n_n
    Float -> Put
putFloat32le Float
_msgPosLlhCovGnss_cov_n_e
    Float -> Put
putFloat32le Float
_msgPosLlhCovGnss_cov_n_d
    Float -> Put
putFloat32le Float
_msgPosLlhCovGnss_cov_e_e
    Float -> Put
putFloat32le Float
_msgPosLlhCovGnss_cov_e_d
    Float -> Put
putFloat32le Float
_msgPosLlhCovGnss_cov_d_d
    Word8 -> Put
putWord8 Word8
_msgPosLlhCovGnss_n_sats
    Word8 -> Put
putWord8 Word8
_msgPosLlhCovGnss_flags

$(makeSBP 'msgPosLlhCovGnss ''MsgPosLlhCovGnss)
$(makeJSON "_msgPosLlhCovGnss_" ''MsgPosLlhCovGnss)
$(makeLenses ''MsgPosLlhCovGnss)

msgVelEcefGnss :: Word16
msgVelEcefGnss :: Word16
msgVelEcefGnss = Word16
0x022D

-- | SBP class for message MSG_VEL_ECEF_GNSS (0x022D).
--
-- This message reports the velocity in Earth Centered Earth Fixed (ECEF)
-- coordinates. The full GPS time is given by the preceding MSG_GPS_TIME with
-- the matching time-of-week (tow).
data MsgVelEcefGnss = MsgVelEcefGnss
  { MsgVelEcefGnss -> Word32
_msgVelEcefGnss_tow    :: !Word32
    -- ^ GPS Time of Week
  , MsgVelEcefGnss -> Int32
_msgVelEcefGnss_x      :: !Int32
    -- ^ Velocity ECEF X coordinate
  , MsgVelEcefGnss -> Int32
_msgVelEcefGnss_y      :: !Int32
    -- ^ Velocity ECEF Y coordinate
  , MsgVelEcefGnss -> Int32
_msgVelEcefGnss_z      :: !Int32
    -- ^ Velocity ECEF Z coordinate
  , MsgVelEcefGnss -> Word16
_msgVelEcefGnss_accuracy :: !Word16
    -- ^ Velocity estimated standard deviation
  , MsgVelEcefGnss -> Word8
_msgVelEcefGnss_n_sats :: !Word8
    -- ^ Number of satellites used in solution
  , MsgVelEcefGnss -> Word8
_msgVelEcefGnss_flags  :: !Word8
    -- ^ Status flags
  } deriving ( Int -> MsgVelEcefGnss -> ShowS
[MsgVelEcefGnss] -> ShowS
MsgVelEcefGnss -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgVelEcefGnss] -> ShowS
$cshowList :: [MsgVelEcefGnss] -> ShowS
show :: MsgVelEcefGnss -> String
$cshow :: MsgVelEcefGnss -> String
showsPrec :: Int -> MsgVelEcefGnss -> ShowS
$cshowsPrec :: Int -> MsgVelEcefGnss -> ShowS
Show, ReadPrec [MsgVelEcefGnss]
ReadPrec MsgVelEcefGnss
Int -> ReadS MsgVelEcefGnss
ReadS [MsgVelEcefGnss]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgVelEcefGnss]
$creadListPrec :: ReadPrec [MsgVelEcefGnss]
readPrec :: ReadPrec MsgVelEcefGnss
$creadPrec :: ReadPrec MsgVelEcefGnss
readList :: ReadS [MsgVelEcefGnss]
$creadList :: ReadS [MsgVelEcefGnss]
readsPrec :: Int -> ReadS MsgVelEcefGnss
$creadsPrec :: Int -> ReadS MsgVelEcefGnss
Read, MsgVelEcefGnss -> MsgVelEcefGnss -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgVelEcefGnss -> MsgVelEcefGnss -> Bool
$c/= :: MsgVelEcefGnss -> MsgVelEcefGnss -> Bool
== :: MsgVelEcefGnss -> MsgVelEcefGnss -> Bool
$c== :: MsgVelEcefGnss -> MsgVelEcefGnss -> Bool
Eq )

instance Binary MsgVelEcefGnss where
  get :: Get MsgVelEcefGnss
get = do
    Word32
_msgVelEcefGnss_tow <- Get Word32
getWord32le
    Int32
_msgVelEcefGnss_x <- (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
_msgVelEcefGnss_y <- (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
_msgVelEcefGnss_z <- (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)
    Word16
_msgVelEcefGnss_accuracy <- Get Word16
getWord16le
    Word8
_msgVelEcefGnss_n_sats <- Get Word8
getWord8
    Word8
_msgVelEcefGnss_flags <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgVelEcefGnss {Int32
Word8
Word16
Word32
_msgVelEcefGnss_flags :: Word8
_msgVelEcefGnss_n_sats :: Word8
_msgVelEcefGnss_accuracy :: Word16
_msgVelEcefGnss_z :: Int32
_msgVelEcefGnss_y :: Int32
_msgVelEcefGnss_x :: Int32
_msgVelEcefGnss_tow :: Word32
_msgVelEcefGnss_flags :: Word8
_msgVelEcefGnss_n_sats :: Word8
_msgVelEcefGnss_accuracy :: Word16
_msgVelEcefGnss_z :: Int32
_msgVelEcefGnss_y :: Int32
_msgVelEcefGnss_x :: Int32
_msgVelEcefGnss_tow :: Word32
..}

  put :: MsgVelEcefGnss -> Put
put MsgVelEcefGnss {Int32
Word8
Word16
Word32
_msgVelEcefGnss_flags :: Word8
_msgVelEcefGnss_n_sats :: Word8
_msgVelEcefGnss_accuracy :: Word16
_msgVelEcefGnss_z :: Int32
_msgVelEcefGnss_y :: Int32
_msgVelEcefGnss_x :: Int32
_msgVelEcefGnss_tow :: Word32
_msgVelEcefGnss_flags :: MsgVelEcefGnss -> Word8
_msgVelEcefGnss_n_sats :: MsgVelEcefGnss -> Word8
_msgVelEcefGnss_accuracy :: MsgVelEcefGnss -> Word16
_msgVelEcefGnss_z :: MsgVelEcefGnss -> Int32
_msgVelEcefGnss_y :: MsgVelEcefGnss -> Int32
_msgVelEcefGnss_x :: MsgVelEcefGnss -> Int32
_msgVelEcefGnss_tow :: MsgVelEcefGnss -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgVelEcefGnss_tow
    (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
_msgVelEcefGnss_x
    (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
_msgVelEcefGnss_y
    (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
_msgVelEcefGnss_z
    Word16 -> Put
putWord16le Word16
_msgVelEcefGnss_accuracy
    Word8 -> Put
putWord8 Word8
_msgVelEcefGnss_n_sats
    Word8 -> Put
putWord8 Word8
_msgVelEcefGnss_flags

$(makeSBP 'msgVelEcefGnss ''MsgVelEcefGnss)
$(makeJSON "_msgVelEcefGnss_" ''MsgVelEcefGnss)
$(makeLenses ''MsgVelEcefGnss)

msgVelEcefCovGnss :: Word16
msgVelEcefCovGnss :: Word16
msgVelEcefCovGnss = Word16
0x0235

-- | SBP class for message MSG_VEL_ECEF_COV_GNSS (0x0235).
--
-- This message reports the velocity in Earth Centered Earth Fixed (ECEF)
-- coordinates. The full GPS time is given by the preceding MSG_GPS_TIME with
-- the matching time-of-week (tow).
data MsgVelEcefCovGnss = MsgVelEcefCovGnss
  { MsgVelEcefCovGnss -> Word32
_msgVelEcefCovGnss_tow   :: !Word32
    -- ^ GPS Time of Week
  , MsgVelEcefCovGnss -> Int32
_msgVelEcefCovGnss_x     :: !Int32
    -- ^ Velocity ECEF X coordinate
  , MsgVelEcefCovGnss -> Int32
_msgVelEcefCovGnss_y     :: !Int32
    -- ^ Velocity ECEF Y coordinate
  , MsgVelEcefCovGnss -> Int32
_msgVelEcefCovGnss_z     :: !Int32
    -- ^ Velocity ECEF Z coordinate
  , MsgVelEcefCovGnss -> Float
_msgVelEcefCovGnss_cov_x_x :: !Float
    -- ^ Estimated variance of x
  , MsgVelEcefCovGnss -> Float
_msgVelEcefCovGnss_cov_x_y :: !Float
    -- ^ Estimated covariance of x and y
  , MsgVelEcefCovGnss -> Float
_msgVelEcefCovGnss_cov_x_z :: !Float
    -- ^ Estimated covariance of x and z
  , MsgVelEcefCovGnss -> Float
_msgVelEcefCovGnss_cov_y_y :: !Float
    -- ^ Estimated variance of y
  , MsgVelEcefCovGnss -> Float
_msgVelEcefCovGnss_cov_y_z :: !Float
    -- ^ Estimated covariance of y and z
  , MsgVelEcefCovGnss -> Float
_msgVelEcefCovGnss_cov_z_z :: !Float
    -- ^ Estimated variance of z
  , MsgVelEcefCovGnss -> Word8
_msgVelEcefCovGnss_n_sats :: !Word8
    -- ^ Number of satellites used in solution
  , MsgVelEcefCovGnss -> Word8
_msgVelEcefCovGnss_flags :: !Word8
    -- ^ Status flags
  } deriving ( Int -> MsgVelEcefCovGnss -> ShowS
[MsgVelEcefCovGnss] -> ShowS
MsgVelEcefCovGnss -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgVelEcefCovGnss] -> ShowS
$cshowList :: [MsgVelEcefCovGnss] -> ShowS
show :: MsgVelEcefCovGnss -> String
$cshow :: MsgVelEcefCovGnss -> String
showsPrec :: Int -> MsgVelEcefCovGnss -> ShowS
$cshowsPrec :: Int -> MsgVelEcefCovGnss -> ShowS
Show, ReadPrec [MsgVelEcefCovGnss]
ReadPrec MsgVelEcefCovGnss
Int -> ReadS MsgVelEcefCovGnss
ReadS [MsgVelEcefCovGnss]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgVelEcefCovGnss]
$creadListPrec :: ReadPrec [MsgVelEcefCovGnss]
readPrec :: ReadPrec MsgVelEcefCovGnss
$creadPrec :: ReadPrec MsgVelEcefCovGnss
readList :: ReadS [MsgVelEcefCovGnss]
$creadList :: ReadS [MsgVelEcefCovGnss]
readsPrec :: Int -> ReadS MsgVelEcefCovGnss
$creadsPrec :: Int -> ReadS MsgVelEcefCovGnss
Read, MsgVelEcefCovGnss -> MsgVelEcefCovGnss -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgVelEcefCovGnss -> MsgVelEcefCovGnss -> Bool
$c/= :: MsgVelEcefCovGnss -> MsgVelEcefCovGnss -> Bool
== :: MsgVelEcefCovGnss -> MsgVelEcefCovGnss -> Bool
$c== :: MsgVelEcefCovGnss -> MsgVelEcefCovGnss -> Bool
Eq )

instance Binary MsgVelEcefCovGnss where
  get :: Get MsgVelEcefCovGnss
get = do
    Word32
_msgVelEcefCovGnss_tow <- Get Word32
getWord32le
    Int32
_msgVelEcefCovGnss_x <- (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
_msgVelEcefCovGnss_y <- (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
_msgVelEcefCovGnss_z <- (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)
    Float
_msgVelEcefCovGnss_cov_x_x <- Get Float
getFloat32le
    Float
_msgVelEcefCovGnss_cov_x_y <- Get Float
getFloat32le
    Float
_msgVelEcefCovGnss_cov_x_z <- Get Float
getFloat32le
    Float
_msgVelEcefCovGnss_cov_y_y <- Get Float
getFloat32le
    Float
_msgVelEcefCovGnss_cov_y_z <- Get Float
getFloat32le
    Float
_msgVelEcefCovGnss_cov_z_z <- Get Float
getFloat32le
    Word8
_msgVelEcefCovGnss_n_sats <- Get Word8
getWord8
    Word8
_msgVelEcefCovGnss_flags <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgVelEcefCovGnss {Float
Int32
Word8
Word32
_msgVelEcefCovGnss_flags :: Word8
_msgVelEcefCovGnss_n_sats :: Word8
_msgVelEcefCovGnss_cov_z_z :: Float
_msgVelEcefCovGnss_cov_y_z :: Float
_msgVelEcefCovGnss_cov_y_y :: Float
_msgVelEcefCovGnss_cov_x_z :: Float
_msgVelEcefCovGnss_cov_x_y :: Float
_msgVelEcefCovGnss_cov_x_x :: Float
_msgVelEcefCovGnss_z :: Int32
_msgVelEcefCovGnss_y :: Int32
_msgVelEcefCovGnss_x :: Int32
_msgVelEcefCovGnss_tow :: Word32
_msgVelEcefCovGnss_flags :: Word8
_msgVelEcefCovGnss_n_sats :: Word8
_msgVelEcefCovGnss_cov_z_z :: Float
_msgVelEcefCovGnss_cov_y_z :: Float
_msgVelEcefCovGnss_cov_y_y :: Float
_msgVelEcefCovGnss_cov_x_z :: Float
_msgVelEcefCovGnss_cov_x_y :: Float
_msgVelEcefCovGnss_cov_x_x :: Float
_msgVelEcefCovGnss_z :: Int32
_msgVelEcefCovGnss_y :: Int32
_msgVelEcefCovGnss_x :: Int32
_msgVelEcefCovGnss_tow :: Word32
..}

  put :: MsgVelEcefCovGnss -> Put
put MsgVelEcefCovGnss {Float
Int32
Word8
Word32
_msgVelEcefCovGnss_flags :: Word8
_msgVelEcefCovGnss_n_sats :: Word8
_msgVelEcefCovGnss_cov_z_z :: Float
_msgVelEcefCovGnss_cov_y_z :: Float
_msgVelEcefCovGnss_cov_y_y :: Float
_msgVelEcefCovGnss_cov_x_z :: Float
_msgVelEcefCovGnss_cov_x_y :: Float
_msgVelEcefCovGnss_cov_x_x :: Float
_msgVelEcefCovGnss_z :: Int32
_msgVelEcefCovGnss_y :: Int32
_msgVelEcefCovGnss_x :: Int32
_msgVelEcefCovGnss_tow :: Word32
_msgVelEcefCovGnss_flags :: MsgVelEcefCovGnss -> Word8
_msgVelEcefCovGnss_n_sats :: MsgVelEcefCovGnss -> Word8
_msgVelEcefCovGnss_cov_z_z :: MsgVelEcefCovGnss -> Float
_msgVelEcefCovGnss_cov_y_z :: MsgVelEcefCovGnss -> Float
_msgVelEcefCovGnss_cov_y_y :: MsgVelEcefCovGnss -> Float
_msgVelEcefCovGnss_cov_x_z :: MsgVelEcefCovGnss -> Float
_msgVelEcefCovGnss_cov_x_y :: MsgVelEcefCovGnss -> Float
_msgVelEcefCovGnss_cov_x_x :: MsgVelEcefCovGnss -> Float
_msgVelEcefCovGnss_z :: MsgVelEcefCovGnss -> Int32
_msgVelEcefCovGnss_y :: MsgVelEcefCovGnss -> Int32
_msgVelEcefCovGnss_x :: MsgVelEcefCovGnss -> Int32
_msgVelEcefCovGnss_tow :: MsgVelEcefCovGnss -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgVelEcefCovGnss_tow
    (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
_msgVelEcefCovGnss_x
    (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
_msgVelEcefCovGnss_y
    (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
_msgVelEcefCovGnss_z
    Float -> Put
putFloat32le Float
_msgVelEcefCovGnss_cov_x_x
    Float -> Put
putFloat32le Float
_msgVelEcefCovGnss_cov_x_y
    Float -> Put
putFloat32le Float
_msgVelEcefCovGnss_cov_x_z
    Float -> Put
putFloat32le Float
_msgVelEcefCovGnss_cov_y_y
    Float -> Put
putFloat32le Float
_msgVelEcefCovGnss_cov_y_z
    Float -> Put
putFloat32le Float
_msgVelEcefCovGnss_cov_z_z
    Word8 -> Put
putWord8 Word8
_msgVelEcefCovGnss_n_sats
    Word8 -> Put
putWord8 Word8
_msgVelEcefCovGnss_flags

$(makeSBP 'msgVelEcefCovGnss ''MsgVelEcefCovGnss)
$(makeJSON "_msgVelEcefCovGnss_" ''MsgVelEcefCovGnss)
$(makeLenses ''MsgVelEcefCovGnss)

msgVelNedGnss :: Word16
msgVelNedGnss :: Word16
msgVelNedGnss = Word16
0x022E

-- | SBP class for message MSG_VEL_NED_GNSS (0x022E).
--
-- This message reports the velocity in local North East Down (NED)
-- coordinates. The NED coordinate system is defined as the local WGS84
-- tangent plane centered at the current position. The full GPS time is given
-- by the preceding MSG_GPS_TIME with the matching time-of-week (tow).
data MsgVelNedGnss = MsgVelNedGnss
  { MsgVelNedGnss -> Word32
_msgVelNedGnss_tow      :: !Word32
    -- ^ GPS Time of Week
  , MsgVelNedGnss -> Int32
_msgVelNedGnss_n        :: !Int32
    -- ^ Velocity North coordinate
  , MsgVelNedGnss -> Int32
_msgVelNedGnss_e        :: !Int32
    -- ^ Velocity East coordinate
  , MsgVelNedGnss -> Int32
_msgVelNedGnss_d        :: !Int32
    -- ^ Velocity Down coordinate
  , MsgVelNedGnss -> Word16
_msgVelNedGnss_h_accuracy :: !Word16
    -- ^ Horizontal velocity estimated standard deviation
  , MsgVelNedGnss -> Word16
_msgVelNedGnss_v_accuracy :: !Word16
    -- ^ Vertical velocity estimated standard deviation
  , MsgVelNedGnss -> Word8
_msgVelNedGnss_n_sats   :: !Word8
    -- ^ Number of satellites used in solution
  , MsgVelNedGnss -> Word8
_msgVelNedGnss_flags    :: !Word8
    -- ^ Status flags
  } deriving ( Int -> MsgVelNedGnss -> ShowS
[MsgVelNedGnss] -> ShowS
MsgVelNedGnss -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgVelNedGnss] -> ShowS
$cshowList :: [MsgVelNedGnss] -> ShowS
show :: MsgVelNedGnss -> String
$cshow :: MsgVelNedGnss -> String
showsPrec :: Int -> MsgVelNedGnss -> ShowS
$cshowsPrec :: Int -> MsgVelNedGnss -> ShowS
Show, ReadPrec [MsgVelNedGnss]
ReadPrec MsgVelNedGnss
Int -> ReadS MsgVelNedGnss
ReadS [MsgVelNedGnss]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgVelNedGnss]
$creadListPrec :: ReadPrec [MsgVelNedGnss]
readPrec :: ReadPrec MsgVelNedGnss
$creadPrec :: ReadPrec MsgVelNedGnss
readList :: ReadS [MsgVelNedGnss]
$creadList :: ReadS [MsgVelNedGnss]
readsPrec :: Int -> ReadS MsgVelNedGnss
$creadsPrec :: Int -> ReadS MsgVelNedGnss
Read, MsgVelNedGnss -> MsgVelNedGnss -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgVelNedGnss -> MsgVelNedGnss -> Bool
$c/= :: MsgVelNedGnss -> MsgVelNedGnss -> Bool
== :: MsgVelNedGnss -> MsgVelNedGnss -> Bool
$c== :: MsgVelNedGnss -> MsgVelNedGnss -> Bool
Eq )

instance Binary MsgVelNedGnss where
  get :: Get MsgVelNedGnss
get = do
    Word32
_msgVelNedGnss_tow <- Get Word32
getWord32le
    Int32
_msgVelNedGnss_n <- (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
_msgVelNedGnss_e <- (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
_msgVelNedGnss_d <- (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)
    Word16
_msgVelNedGnss_h_accuracy <- Get Word16
getWord16le
    Word16
_msgVelNedGnss_v_accuracy <- Get Word16
getWord16le
    Word8
_msgVelNedGnss_n_sats <- Get Word8
getWord8
    Word8
_msgVelNedGnss_flags <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgVelNedGnss {Int32
Word8
Word16
Word32
_msgVelNedGnss_flags :: Word8
_msgVelNedGnss_n_sats :: Word8
_msgVelNedGnss_v_accuracy :: Word16
_msgVelNedGnss_h_accuracy :: Word16
_msgVelNedGnss_d :: Int32
_msgVelNedGnss_e :: Int32
_msgVelNedGnss_n :: Int32
_msgVelNedGnss_tow :: Word32
_msgVelNedGnss_flags :: Word8
_msgVelNedGnss_n_sats :: Word8
_msgVelNedGnss_v_accuracy :: Word16
_msgVelNedGnss_h_accuracy :: Word16
_msgVelNedGnss_d :: Int32
_msgVelNedGnss_e :: Int32
_msgVelNedGnss_n :: Int32
_msgVelNedGnss_tow :: Word32
..}

  put :: MsgVelNedGnss -> Put
put MsgVelNedGnss {Int32
Word8
Word16
Word32
_msgVelNedGnss_flags :: Word8
_msgVelNedGnss_n_sats :: Word8
_msgVelNedGnss_v_accuracy :: Word16
_msgVelNedGnss_h_accuracy :: Word16
_msgVelNedGnss_d :: Int32
_msgVelNedGnss_e :: Int32
_msgVelNedGnss_n :: Int32
_msgVelNedGnss_tow :: Word32
_msgVelNedGnss_flags :: MsgVelNedGnss -> Word8
_msgVelNedGnss_n_sats :: MsgVelNedGnss -> Word8
_msgVelNedGnss_v_accuracy :: MsgVelNedGnss -> Word16
_msgVelNedGnss_h_accuracy :: MsgVelNedGnss -> Word16
_msgVelNedGnss_d :: MsgVelNedGnss -> Int32
_msgVelNedGnss_e :: MsgVelNedGnss -> Int32
_msgVelNedGnss_n :: MsgVelNedGnss -> Int32
_msgVelNedGnss_tow :: MsgVelNedGnss -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgVelNedGnss_tow
    (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
_msgVelNedGnss_n
    (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
_msgVelNedGnss_e
    (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
_msgVelNedGnss_d
    Word16 -> Put
putWord16le Word16
_msgVelNedGnss_h_accuracy
    Word16 -> Put
putWord16le Word16
_msgVelNedGnss_v_accuracy
    Word8 -> Put
putWord8 Word8
_msgVelNedGnss_n_sats
    Word8 -> Put
putWord8 Word8
_msgVelNedGnss_flags

$(makeSBP 'msgVelNedGnss ''MsgVelNedGnss)
$(makeJSON "_msgVelNedGnss_" ''MsgVelNedGnss)
$(makeLenses ''MsgVelNedGnss)

msgVelNedCovGnss :: Word16
msgVelNedCovGnss :: Word16
msgVelNedCovGnss = Word16
0x0232

-- | SBP class for message MSG_VEL_NED_COV_GNSS (0x0232).
--
-- This message reports the velocity in local North East Down (NED)
-- coordinates. The NED coordinate system is defined as the local WGS84
-- tangent plane centered at the current position. The full GPS time is given
-- by the preceding MSG_GPS_TIME with the matching time-of-week (tow). This
-- message is similar to the MSG_VEL_NED, but it includes the upper triangular
-- portion of the 3x3 covariance matrix.
data MsgVelNedCovGnss = MsgVelNedCovGnss
  { MsgVelNedCovGnss -> Word32
_msgVelNedCovGnss_tow   :: !Word32
    -- ^ GPS Time of Week
  , MsgVelNedCovGnss -> Int32
_msgVelNedCovGnss_n     :: !Int32
    -- ^ Velocity North coordinate
  , MsgVelNedCovGnss -> Int32
_msgVelNedCovGnss_e     :: !Int32
    -- ^ Velocity East coordinate
  , MsgVelNedCovGnss -> Int32
_msgVelNedCovGnss_d     :: !Int32
    -- ^ Velocity Down coordinate
  , MsgVelNedCovGnss -> Float
_msgVelNedCovGnss_cov_n_n :: !Float
    -- ^ Estimated variance of northward measurement
  , MsgVelNedCovGnss -> Float
_msgVelNedCovGnss_cov_n_e :: !Float
    -- ^ Covariance of northward and eastward measurement
  , MsgVelNedCovGnss -> Float
_msgVelNedCovGnss_cov_n_d :: !Float
    -- ^ Covariance of northward and downward measurement
  , MsgVelNedCovGnss -> Float
_msgVelNedCovGnss_cov_e_e :: !Float
    -- ^ Estimated variance of eastward measurement
  , MsgVelNedCovGnss -> Float
_msgVelNedCovGnss_cov_e_d :: !Float
    -- ^ Covariance of eastward and downward measurement
  , MsgVelNedCovGnss -> Float
_msgVelNedCovGnss_cov_d_d :: !Float
    -- ^ Estimated variance of downward measurement
  , MsgVelNedCovGnss -> Word8
_msgVelNedCovGnss_n_sats :: !Word8
    -- ^ Number of satellites used in solution
  , MsgVelNedCovGnss -> Word8
_msgVelNedCovGnss_flags :: !Word8
    -- ^ Status flags
  } deriving ( Int -> MsgVelNedCovGnss -> ShowS
[MsgVelNedCovGnss] -> ShowS
MsgVelNedCovGnss -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgVelNedCovGnss] -> ShowS
$cshowList :: [MsgVelNedCovGnss] -> ShowS
show :: MsgVelNedCovGnss -> String
$cshow :: MsgVelNedCovGnss -> String
showsPrec :: Int -> MsgVelNedCovGnss -> ShowS
$cshowsPrec :: Int -> MsgVelNedCovGnss -> ShowS
Show, ReadPrec [MsgVelNedCovGnss]
ReadPrec MsgVelNedCovGnss
Int -> ReadS MsgVelNedCovGnss
ReadS [MsgVelNedCovGnss]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgVelNedCovGnss]
$creadListPrec :: ReadPrec [MsgVelNedCovGnss]
readPrec :: ReadPrec MsgVelNedCovGnss
$creadPrec :: ReadPrec MsgVelNedCovGnss
readList :: ReadS [MsgVelNedCovGnss]
$creadList :: ReadS [MsgVelNedCovGnss]
readsPrec :: Int -> ReadS MsgVelNedCovGnss
$creadsPrec :: Int -> ReadS MsgVelNedCovGnss
Read, MsgVelNedCovGnss -> MsgVelNedCovGnss -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgVelNedCovGnss -> MsgVelNedCovGnss -> Bool
$c/= :: MsgVelNedCovGnss -> MsgVelNedCovGnss -> Bool
== :: MsgVelNedCovGnss -> MsgVelNedCovGnss -> Bool
$c== :: MsgVelNedCovGnss -> MsgVelNedCovGnss -> Bool
Eq )

instance Binary MsgVelNedCovGnss where
  get :: Get MsgVelNedCovGnss
get = do
    Word32
_msgVelNedCovGnss_tow <- Get Word32
getWord32le
    Int32
_msgVelNedCovGnss_n <- (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
_msgVelNedCovGnss_e <- (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
_msgVelNedCovGnss_d <- (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)
    Float
_msgVelNedCovGnss_cov_n_n <- Get Float
getFloat32le
    Float
_msgVelNedCovGnss_cov_n_e <- Get Float
getFloat32le
    Float
_msgVelNedCovGnss_cov_n_d <- Get Float
getFloat32le
    Float
_msgVelNedCovGnss_cov_e_e <- Get Float
getFloat32le
    Float
_msgVelNedCovGnss_cov_e_d <- Get Float
getFloat32le
    Float
_msgVelNedCovGnss_cov_d_d <- Get Float
getFloat32le
    Word8
_msgVelNedCovGnss_n_sats <- Get Word8
getWord8
    Word8
_msgVelNedCovGnss_flags <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgVelNedCovGnss {Float
Int32
Word8
Word32
_msgVelNedCovGnss_flags :: Word8
_msgVelNedCovGnss_n_sats :: Word8
_msgVelNedCovGnss_cov_d_d :: Float
_msgVelNedCovGnss_cov_e_d :: Float
_msgVelNedCovGnss_cov_e_e :: Float
_msgVelNedCovGnss_cov_n_d :: Float
_msgVelNedCovGnss_cov_n_e :: Float
_msgVelNedCovGnss_cov_n_n :: Float
_msgVelNedCovGnss_d :: Int32
_msgVelNedCovGnss_e :: Int32
_msgVelNedCovGnss_n :: Int32
_msgVelNedCovGnss_tow :: Word32
_msgVelNedCovGnss_flags :: Word8
_msgVelNedCovGnss_n_sats :: Word8
_msgVelNedCovGnss_cov_d_d :: Float
_msgVelNedCovGnss_cov_e_d :: Float
_msgVelNedCovGnss_cov_e_e :: Float
_msgVelNedCovGnss_cov_n_d :: Float
_msgVelNedCovGnss_cov_n_e :: Float
_msgVelNedCovGnss_cov_n_n :: Float
_msgVelNedCovGnss_d :: Int32
_msgVelNedCovGnss_e :: Int32
_msgVelNedCovGnss_n :: Int32
_msgVelNedCovGnss_tow :: Word32
..}

  put :: MsgVelNedCovGnss -> Put
put MsgVelNedCovGnss {Float
Int32
Word8
Word32
_msgVelNedCovGnss_flags :: Word8
_msgVelNedCovGnss_n_sats :: Word8
_msgVelNedCovGnss_cov_d_d :: Float
_msgVelNedCovGnss_cov_e_d :: Float
_msgVelNedCovGnss_cov_e_e :: Float
_msgVelNedCovGnss_cov_n_d :: Float
_msgVelNedCovGnss_cov_n_e :: Float
_msgVelNedCovGnss_cov_n_n :: Float
_msgVelNedCovGnss_d :: Int32
_msgVelNedCovGnss_e :: Int32
_msgVelNedCovGnss_n :: Int32
_msgVelNedCovGnss_tow :: Word32
_msgVelNedCovGnss_flags :: MsgVelNedCovGnss -> Word8
_msgVelNedCovGnss_n_sats :: MsgVelNedCovGnss -> Word8
_msgVelNedCovGnss_cov_d_d :: MsgVelNedCovGnss -> Float
_msgVelNedCovGnss_cov_e_d :: MsgVelNedCovGnss -> Float
_msgVelNedCovGnss_cov_e_e :: MsgVelNedCovGnss -> Float
_msgVelNedCovGnss_cov_n_d :: MsgVelNedCovGnss -> Float
_msgVelNedCovGnss_cov_n_e :: MsgVelNedCovGnss -> Float
_msgVelNedCovGnss_cov_n_n :: MsgVelNedCovGnss -> Float
_msgVelNedCovGnss_d :: MsgVelNedCovGnss -> Int32
_msgVelNedCovGnss_e :: MsgVelNedCovGnss -> Int32
_msgVelNedCovGnss_n :: MsgVelNedCovGnss -> Int32
_msgVelNedCovGnss_tow :: MsgVelNedCovGnss -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgVelNedCovGnss_tow
    (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
_msgVelNedCovGnss_n
    (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
_msgVelNedCovGnss_e
    (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
_msgVelNedCovGnss_d
    Float -> Put
putFloat32le Float
_msgVelNedCovGnss_cov_n_n
    Float -> Put
putFloat32le Float
_msgVelNedCovGnss_cov_n_e
    Float -> Put
putFloat32le Float
_msgVelNedCovGnss_cov_n_d
    Float -> Put
putFloat32le Float
_msgVelNedCovGnss_cov_e_e
    Float -> Put
putFloat32le Float
_msgVelNedCovGnss_cov_e_d
    Float -> Put
putFloat32le Float
_msgVelNedCovGnss_cov_d_d
    Word8 -> Put
putWord8 Word8
_msgVelNedCovGnss_n_sats
    Word8 -> Put
putWord8 Word8
_msgVelNedCovGnss_flags

$(makeSBP 'msgVelNedCovGnss ''MsgVelNedCovGnss)
$(makeJSON "_msgVelNedCovGnss_" ''MsgVelNedCovGnss)
$(makeLenses ''MsgVelNedCovGnss)

msgVelBody :: Word16
msgVelBody :: Word16
msgVelBody = Word16
0x0213

-- | SBP class for message MSG_VEL_BODY (0x0213).
--
-- This message reports the velocity in the Vehicle Body Frame. By convention,
-- the x-axis should point out the nose of the vehicle and represent the
-- forward direction, while as the y-axis should point out the right hand side
-- of the vehicle. Since this is a right handed system, z should point out the
-- bottom of the vehicle. The orientation and origin of the Vehicle Body Frame
-- are specified via the device settings. The full GPS time is given by the
-- preceding MSG_GPS_TIME with the matching time-of-week (tow). This message
-- is only produced by inertial versions of Swift products and is not
-- available from Piksi Multi or Duro.
data MsgVelBody = MsgVelBody
  { MsgVelBody -> Word32
_msgVelBody_tow   :: !Word32
    -- ^ GPS Time of Week
  , MsgVelBody -> Int32
_msgVelBody_x     :: !Int32
    -- ^ Velocity in x direction
  , MsgVelBody -> Int32
_msgVelBody_y     :: !Int32
    -- ^ Velocity in y direction
  , MsgVelBody -> Int32
_msgVelBody_z     :: !Int32
    -- ^ Velocity in z direction
  , MsgVelBody -> Float
_msgVelBody_cov_x_x :: !Float
    -- ^ Estimated variance of x
  , MsgVelBody -> Float
_msgVelBody_cov_x_y :: !Float
    -- ^ Covariance of x and y
  , MsgVelBody -> Float
_msgVelBody_cov_x_z :: !Float
    -- ^ Covariance of x and z
  , MsgVelBody -> Float
_msgVelBody_cov_y_y :: !Float
    -- ^ Estimated variance of y
  , MsgVelBody -> Float
_msgVelBody_cov_y_z :: !Float
    -- ^ Covariance of y and z
  , MsgVelBody -> Float
_msgVelBody_cov_z_z :: !Float
    -- ^ Estimated variance of z
  , MsgVelBody -> Word8
_msgVelBody_n_sats :: !Word8
    -- ^ Number of satellites used in solution
  , MsgVelBody -> Word8
_msgVelBody_flags :: !Word8
    -- ^ Status flags
  } deriving ( Int -> MsgVelBody -> ShowS
[MsgVelBody] -> ShowS
MsgVelBody -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgVelBody] -> ShowS
$cshowList :: [MsgVelBody] -> ShowS
show :: MsgVelBody -> String
$cshow :: MsgVelBody -> String
showsPrec :: Int -> MsgVelBody -> ShowS
$cshowsPrec :: Int -> MsgVelBody -> ShowS
Show, ReadPrec [MsgVelBody]
ReadPrec MsgVelBody
Int -> ReadS MsgVelBody
ReadS [MsgVelBody]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgVelBody]
$creadListPrec :: ReadPrec [MsgVelBody]
readPrec :: ReadPrec MsgVelBody
$creadPrec :: ReadPrec MsgVelBody
readList :: ReadS [MsgVelBody]
$creadList :: ReadS [MsgVelBody]
readsPrec :: Int -> ReadS MsgVelBody
$creadsPrec :: Int -> ReadS MsgVelBody
Read, MsgVelBody -> MsgVelBody -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgVelBody -> MsgVelBody -> Bool
$c/= :: MsgVelBody -> MsgVelBody -> Bool
== :: MsgVelBody -> MsgVelBody -> Bool
$c== :: MsgVelBody -> MsgVelBody -> Bool
Eq )

instance Binary MsgVelBody where
  get :: Get MsgVelBody
get = do
    Word32
_msgVelBody_tow <- Get Word32
getWord32le
    Int32
_msgVelBody_x <- (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
_msgVelBody_y <- (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
_msgVelBody_z <- (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)
    Float
_msgVelBody_cov_x_x <- Get Float
getFloat32le
    Float
_msgVelBody_cov_x_y <- Get Float
getFloat32le
    Float
_msgVelBody_cov_x_z <- Get Float
getFloat32le
    Float
_msgVelBody_cov_y_y <- Get Float
getFloat32le
    Float
_msgVelBody_cov_y_z <- Get Float
getFloat32le
    Float
_msgVelBody_cov_z_z <- Get Float
getFloat32le
    Word8
_msgVelBody_n_sats <- Get Word8
getWord8
    Word8
_msgVelBody_flags <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgVelBody {Float
Int32
Word8
Word32
_msgVelBody_flags :: Word8
_msgVelBody_n_sats :: Word8
_msgVelBody_cov_z_z :: Float
_msgVelBody_cov_y_z :: Float
_msgVelBody_cov_y_y :: Float
_msgVelBody_cov_x_z :: Float
_msgVelBody_cov_x_y :: Float
_msgVelBody_cov_x_x :: Float
_msgVelBody_z :: Int32
_msgVelBody_y :: Int32
_msgVelBody_x :: Int32
_msgVelBody_tow :: Word32
_msgVelBody_flags :: Word8
_msgVelBody_n_sats :: Word8
_msgVelBody_cov_z_z :: Float
_msgVelBody_cov_y_z :: Float
_msgVelBody_cov_y_y :: Float
_msgVelBody_cov_x_z :: Float
_msgVelBody_cov_x_y :: Float
_msgVelBody_cov_x_x :: Float
_msgVelBody_z :: Int32
_msgVelBody_y :: Int32
_msgVelBody_x :: Int32
_msgVelBody_tow :: Word32
..}

  put :: MsgVelBody -> Put
put MsgVelBody {Float
Int32
Word8
Word32
_msgVelBody_flags :: Word8
_msgVelBody_n_sats :: Word8
_msgVelBody_cov_z_z :: Float
_msgVelBody_cov_y_z :: Float
_msgVelBody_cov_y_y :: Float
_msgVelBody_cov_x_z :: Float
_msgVelBody_cov_x_y :: Float
_msgVelBody_cov_x_x :: Float
_msgVelBody_z :: Int32
_msgVelBody_y :: Int32
_msgVelBody_x :: Int32
_msgVelBody_tow :: Word32
_msgVelBody_flags :: MsgVelBody -> Word8
_msgVelBody_n_sats :: MsgVelBody -> Word8
_msgVelBody_cov_z_z :: MsgVelBody -> Float
_msgVelBody_cov_y_z :: MsgVelBody -> Float
_msgVelBody_cov_y_y :: MsgVelBody -> Float
_msgVelBody_cov_x_z :: MsgVelBody -> Float
_msgVelBody_cov_x_y :: MsgVelBody -> Float
_msgVelBody_cov_x_x :: MsgVelBody -> Float
_msgVelBody_z :: MsgVelBody -> Int32
_msgVelBody_y :: MsgVelBody -> Int32
_msgVelBody_x :: MsgVelBody -> Int32
_msgVelBody_tow :: MsgVelBody -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgVelBody_tow
    (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
_msgVelBody_x
    (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
_msgVelBody_y
    (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
_msgVelBody_z
    Float -> Put
putFloat32le Float
_msgVelBody_cov_x_x
    Float -> Put
putFloat32le Float
_msgVelBody_cov_x_y
    Float -> Put
putFloat32le Float
_msgVelBody_cov_x_z
    Float -> Put
putFloat32le Float
_msgVelBody_cov_y_y
    Float -> Put
putFloat32le Float
_msgVelBody_cov_y_z
    Float -> Put
putFloat32le Float
_msgVelBody_cov_z_z
    Word8 -> Put
putWord8 Word8
_msgVelBody_n_sats
    Word8 -> Put
putWord8 Word8
_msgVelBody_flags

$(makeSBP 'msgVelBody ''MsgVelBody)
$(makeJSON "_msgVelBody_" ''MsgVelBody)
$(makeLenses ''MsgVelBody)

msgVelCog :: Word16
msgVelCog :: Word16
msgVelCog = Word16
0x021C

-- | SBP class for message MSG_VEL_COG (0x021C).
--
-- This message reports the receiver course over ground (COG) and speed over
-- ground (SOG) based on the horizontal (N-E) components of the NED velocity
-- vector. It also includes the vertical velocity coordinate. A flag is
-- provided to indicate whether the COG value has been frozen. When  the flag
-- is set to true, the COG field is set to its last valid value until  the
-- system exceeds a minimum velocity threshold. No other fields are  affected
-- by this flag.  The NED coordinate system is defined as the local WGS84
-- tangent  plane centered at the current position. The full GPS time is given
-- by the  preceding MSG_GPS_TIME with the matching time-of-week (tow). Note:
-- course over ground represents the receiver's direction of travel,  but not
-- necessarily the device heading.
data MsgVelCog = MsgVelCog
  { MsgVelCog -> Word32
_msgVelCog_tow         :: !Word32
    -- ^ GPS Time of Week
  , MsgVelCog -> Word32
_msgVelCog_cog         :: !Word32
    -- ^ Course over ground relative to north direction
  , MsgVelCog -> Word32
_msgVelCog_sog         :: !Word32
    -- ^ Speed over ground (based on horizontal velocity)
  , MsgVelCog -> Int32
_msgVelCog_v_up        :: !Int32
    -- ^ Vertical velocity component (positive up)
  , MsgVelCog -> Word32
_msgVelCog_cog_accuracy :: !Word32
    -- ^ Course over ground estimated standard deviation
  , MsgVelCog -> Word32
_msgVelCog_sog_accuracy :: !Word32
    -- ^ Speed over ground estimated standard deviation
  , MsgVelCog -> Word32
_msgVelCog_v_up_accuracy :: !Word32
    -- ^ Vertical velocity estimated standard deviation
  , MsgVelCog -> Word16
_msgVelCog_flags       :: !Word16
    -- ^ Status flags
  } deriving ( Int -> MsgVelCog -> ShowS
[MsgVelCog] -> ShowS
MsgVelCog -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgVelCog] -> ShowS
$cshowList :: [MsgVelCog] -> ShowS
show :: MsgVelCog -> String
$cshow :: MsgVelCog -> String
showsPrec :: Int -> MsgVelCog -> ShowS
$cshowsPrec :: Int -> MsgVelCog -> ShowS
Show, ReadPrec [MsgVelCog]
ReadPrec MsgVelCog
Int -> ReadS MsgVelCog
ReadS [MsgVelCog]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgVelCog]
$creadListPrec :: ReadPrec [MsgVelCog]
readPrec :: ReadPrec MsgVelCog
$creadPrec :: ReadPrec MsgVelCog
readList :: ReadS [MsgVelCog]
$creadList :: ReadS [MsgVelCog]
readsPrec :: Int -> ReadS MsgVelCog
$creadsPrec :: Int -> ReadS MsgVelCog
Read, MsgVelCog -> MsgVelCog -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgVelCog -> MsgVelCog -> Bool
$c/= :: MsgVelCog -> MsgVelCog -> Bool
== :: MsgVelCog -> MsgVelCog -> Bool
$c== :: MsgVelCog -> MsgVelCog -> Bool
Eq )

instance Binary MsgVelCog where
  get :: Get MsgVelCog
get = do
    Word32
_msgVelCog_tow <- Get Word32
getWord32le
    Word32
_msgVelCog_cog <- Get Word32
getWord32le
    Word32
_msgVelCog_sog <- Get Word32
getWord32le
    Int32
_msgVelCog_v_up <- (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)
    Word32
_msgVelCog_cog_accuracy <- Get Word32
getWord32le
    Word32
_msgVelCog_sog_accuracy <- Get Word32
getWord32le
    Word32
_msgVelCog_v_up_accuracy <- Get Word32
getWord32le
    Word16
_msgVelCog_flags <- Get Word16
getWord16le
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgVelCog {Int32
Word16
Word32
_msgVelCog_flags :: Word16
_msgVelCog_v_up_accuracy :: Word32
_msgVelCog_sog_accuracy :: Word32
_msgVelCog_cog_accuracy :: Word32
_msgVelCog_v_up :: Int32
_msgVelCog_sog :: Word32
_msgVelCog_cog :: Word32
_msgVelCog_tow :: Word32
_msgVelCog_flags :: Word16
_msgVelCog_v_up_accuracy :: Word32
_msgVelCog_sog_accuracy :: Word32
_msgVelCog_cog_accuracy :: Word32
_msgVelCog_v_up :: Int32
_msgVelCog_sog :: Word32
_msgVelCog_cog :: Word32
_msgVelCog_tow :: Word32
..}

  put :: MsgVelCog -> Put
put MsgVelCog {Int32
Word16
Word32
_msgVelCog_flags :: Word16
_msgVelCog_v_up_accuracy :: Word32
_msgVelCog_sog_accuracy :: Word32
_msgVelCog_cog_accuracy :: Word32
_msgVelCog_v_up :: Int32
_msgVelCog_sog :: Word32
_msgVelCog_cog :: Word32
_msgVelCog_tow :: Word32
_msgVelCog_flags :: MsgVelCog -> Word16
_msgVelCog_v_up_accuracy :: MsgVelCog -> Word32
_msgVelCog_sog_accuracy :: MsgVelCog -> Word32
_msgVelCog_cog_accuracy :: MsgVelCog -> Word32
_msgVelCog_v_up :: MsgVelCog -> Int32
_msgVelCog_sog :: MsgVelCog -> Word32
_msgVelCog_cog :: MsgVelCog -> Word32
_msgVelCog_tow :: MsgVelCog -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgVelCog_tow
    Word32 -> Put
putWord32le Word32
_msgVelCog_cog
    Word32 -> Put
putWord32le Word32
_msgVelCog_sog
    (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
_msgVelCog_v_up
    Word32 -> Put
putWord32le Word32
_msgVelCog_cog_accuracy
    Word32 -> Put
putWord32le Word32
_msgVelCog_sog_accuracy
    Word32 -> Put
putWord32le Word32
_msgVelCog_v_up_accuracy
    Word16 -> Put
putWord16le Word16
_msgVelCog_flags

$(makeSBP 'msgVelCog ''MsgVelCog)
$(makeJSON "_msgVelCog_" ''MsgVelCog)
$(makeLenses ''MsgVelCog)

msgAgeCorrections :: Word16
msgAgeCorrections :: Word16
msgAgeCorrections = Word16
0x0210

-- | SBP class for message MSG_AGE_CORRECTIONS (0x0210).
--
-- This message reports the Age of the corrections used for the current
-- Differential solution.
data MsgAgeCorrections = MsgAgeCorrections
  { MsgAgeCorrections -> Word32
_msgAgeCorrections_tow :: !Word32
    -- ^ GPS Time of Week
  , MsgAgeCorrections -> Word16
_msgAgeCorrections_age :: !Word16
    -- ^ Age of the corrections (0xFFFF indicates invalid)
  } deriving ( Int -> MsgAgeCorrections -> ShowS
[MsgAgeCorrections] -> ShowS
MsgAgeCorrections -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgAgeCorrections] -> ShowS
$cshowList :: [MsgAgeCorrections] -> ShowS
show :: MsgAgeCorrections -> String
$cshow :: MsgAgeCorrections -> String
showsPrec :: Int -> MsgAgeCorrections -> ShowS
$cshowsPrec :: Int -> MsgAgeCorrections -> ShowS
Show, ReadPrec [MsgAgeCorrections]
ReadPrec MsgAgeCorrections
Int -> ReadS MsgAgeCorrections
ReadS [MsgAgeCorrections]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgAgeCorrections]
$creadListPrec :: ReadPrec [MsgAgeCorrections]
readPrec :: ReadPrec MsgAgeCorrections
$creadPrec :: ReadPrec MsgAgeCorrections
readList :: ReadS [MsgAgeCorrections]
$creadList :: ReadS [MsgAgeCorrections]
readsPrec :: Int -> ReadS MsgAgeCorrections
$creadsPrec :: Int -> ReadS MsgAgeCorrections
Read, MsgAgeCorrections -> MsgAgeCorrections -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgAgeCorrections -> MsgAgeCorrections -> Bool
$c/= :: MsgAgeCorrections -> MsgAgeCorrections -> Bool
== :: MsgAgeCorrections -> MsgAgeCorrections -> Bool
$c== :: MsgAgeCorrections -> MsgAgeCorrections -> Bool
Eq )

instance Binary MsgAgeCorrections where
  get :: Get MsgAgeCorrections
get = do
    Word32
_msgAgeCorrections_tow <- Get Word32
getWord32le
    Word16
_msgAgeCorrections_age <- Get Word16
getWord16le
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgAgeCorrections {Word16
Word32
_msgAgeCorrections_age :: Word16
_msgAgeCorrections_tow :: Word32
_msgAgeCorrections_age :: Word16
_msgAgeCorrections_tow :: Word32
..}

  put :: MsgAgeCorrections -> Put
put MsgAgeCorrections {Word16
Word32
_msgAgeCorrections_age :: Word16
_msgAgeCorrections_tow :: Word32
_msgAgeCorrections_age :: MsgAgeCorrections -> Word16
_msgAgeCorrections_tow :: MsgAgeCorrections -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgAgeCorrections_tow
    Word16 -> Put
putWord16le Word16
_msgAgeCorrections_age

$(makeSBP 'msgAgeCorrections ''MsgAgeCorrections)
$(makeJSON "_msgAgeCorrections_" ''MsgAgeCorrections)
$(makeLenses ''MsgAgeCorrections)

msgGpsTimeDepA :: Word16
msgGpsTimeDepA :: Word16
msgGpsTimeDepA = Word16
0x0100

-- | SBP class for message MSG_GPS_TIME_DEP_A (0x0100).
--
-- This message reports the GPS time, representing the time since the GPS
-- epoch began on midnight January 6, 1980 UTC. GPS time counts the weeks and
-- seconds of the week. The weeks begin at the Saturday/Sunday transition. GPS
-- week 0 began at the beginning of the GPS time scale.
--
-- Within each week number, the GPS time of the week is between between 0 and
-- 604800 seconds (=60*60*24*7). Note that GPS time does not accumulate leap
-- seconds, and as of now, has a small offset from UTC. In a message stream,
-- this message precedes a set of other navigation messages referenced to the
-- same time (but lacking the ns field) and indicates a more precise time of
-- these messages.
data MsgGpsTimeDepA = MsgGpsTimeDepA
  { MsgGpsTimeDepA -> Word16
_msgGpsTimeDepA_wn        :: !Word16
    -- ^ GPS week number
  , MsgGpsTimeDepA -> Word32
_msgGpsTimeDepA_tow       :: !Word32
    -- ^ GPS time of week rounded to the nearest millisecond
  , MsgGpsTimeDepA -> Int32
_msgGpsTimeDepA_ns_residual :: !Int32
    -- ^ Nanosecond residual of millisecond-rounded TOW (ranges from -500000 to
    -- 500000)
  , MsgGpsTimeDepA -> Word8
_msgGpsTimeDepA_flags     :: !Word8
    -- ^ Status flags (reserved)
  } deriving ( Int -> MsgGpsTimeDepA -> ShowS
[MsgGpsTimeDepA] -> ShowS
MsgGpsTimeDepA -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgGpsTimeDepA] -> ShowS
$cshowList :: [MsgGpsTimeDepA] -> ShowS
show :: MsgGpsTimeDepA -> String
$cshow :: MsgGpsTimeDepA -> String
showsPrec :: Int -> MsgGpsTimeDepA -> ShowS
$cshowsPrec :: Int -> MsgGpsTimeDepA -> ShowS
Show, ReadPrec [MsgGpsTimeDepA]
ReadPrec MsgGpsTimeDepA
Int -> ReadS MsgGpsTimeDepA
ReadS [MsgGpsTimeDepA]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgGpsTimeDepA]
$creadListPrec :: ReadPrec [MsgGpsTimeDepA]
readPrec :: ReadPrec MsgGpsTimeDepA
$creadPrec :: ReadPrec MsgGpsTimeDepA
readList :: ReadS [MsgGpsTimeDepA]
$creadList :: ReadS [MsgGpsTimeDepA]
readsPrec :: Int -> ReadS MsgGpsTimeDepA
$creadsPrec :: Int -> ReadS MsgGpsTimeDepA
Read, MsgGpsTimeDepA -> MsgGpsTimeDepA -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgGpsTimeDepA -> MsgGpsTimeDepA -> Bool
$c/= :: MsgGpsTimeDepA -> MsgGpsTimeDepA -> Bool
== :: MsgGpsTimeDepA -> MsgGpsTimeDepA -> Bool
$c== :: MsgGpsTimeDepA -> MsgGpsTimeDepA -> Bool
Eq )

instance Binary MsgGpsTimeDepA where
  get :: Get MsgGpsTimeDepA
get = do
    Word16
_msgGpsTimeDepA_wn <- Get Word16
getWord16le
    Word32
_msgGpsTimeDepA_tow <- Get Word32
getWord32le
    Int32
_msgGpsTimeDepA_ns_residual <- (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)
    Word8
_msgGpsTimeDepA_flags <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgGpsTimeDepA {Int32
Word8
Word16
Word32
_msgGpsTimeDepA_flags :: Word8
_msgGpsTimeDepA_ns_residual :: Int32
_msgGpsTimeDepA_tow :: Word32
_msgGpsTimeDepA_wn :: Word16
_msgGpsTimeDepA_flags :: Word8
_msgGpsTimeDepA_ns_residual :: Int32
_msgGpsTimeDepA_tow :: Word32
_msgGpsTimeDepA_wn :: Word16
..}

  put :: MsgGpsTimeDepA -> Put
put MsgGpsTimeDepA {Int32
Word8
Word16
Word32
_msgGpsTimeDepA_flags :: Word8
_msgGpsTimeDepA_ns_residual :: Int32
_msgGpsTimeDepA_tow :: Word32
_msgGpsTimeDepA_wn :: Word16
_msgGpsTimeDepA_flags :: MsgGpsTimeDepA -> Word8
_msgGpsTimeDepA_ns_residual :: MsgGpsTimeDepA -> Int32
_msgGpsTimeDepA_tow :: MsgGpsTimeDepA -> Word32
_msgGpsTimeDepA_wn :: MsgGpsTimeDepA -> Word16
..} = do
    Word16 -> Put
putWord16le Word16
_msgGpsTimeDepA_wn
    Word32 -> Put
putWord32le Word32
_msgGpsTimeDepA_tow
    (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
_msgGpsTimeDepA_ns_residual
    Word8 -> Put
putWord8 Word8
_msgGpsTimeDepA_flags

$(makeSBP 'msgGpsTimeDepA ''MsgGpsTimeDepA)
$(makeJSON "_msgGpsTimeDepA_" ''MsgGpsTimeDepA)
$(makeLenses ''MsgGpsTimeDepA)

msgDopsDepA :: Word16
msgDopsDepA :: Word16
msgDopsDepA = Word16
0x0206

-- | SBP class for message MSG_DOPS_DEP_A (0x0206).
--
-- This dilution of precision (DOP) message describes the effect of navigation
-- satellite geometry on positional measurement precision.
data MsgDopsDepA = MsgDopsDepA
  { MsgDopsDepA -> Word32
_msgDopsDepA_tow :: !Word32
    -- ^ GPS Time of Week
  , MsgDopsDepA -> Word16
_msgDopsDepA_gdop :: !Word16
    -- ^ Geometric Dilution of Precision
  , MsgDopsDepA -> Word16
_msgDopsDepA_pdop :: !Word16
    -- ^ Position Dilution of Precision
  , MsgDopsDepA -> Word16
_msgDopsDepA_tdop :: !Word16
    -- ^ Time Dilution of Precision
  , MsgDopsDepA -> Word16
_msgDopsDepA_hdop :: !Word16
    -- ^ Horizontal Dilution of Precision
  , MsgDopsDepA -> Word16
_msgDopsDepA_vdop :: !Word16
    -- ^ Vertical Dilution of Precision
  } deriving ( Int -> MsgDopsDepA -> ShowS
[MsgDopsDepA] -> ShowS
MsgDopsDepA -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgDopsDepA] -> ShowS
$cshowList :: [MsgDopsDepA] -> ShowS
show :: MsgDopsDepA -> String
$cshow :: MsgDopsDepA -> String
showsPrec :: Int -> MsgDopsDepA -> ShowS
$cshowsPrec :: Int -> MsgDopsDepA -> ShowS
Show, ReadPrec [MsgDopsDepA]
ReadPrec MsgDopsDepA
Int -> ReadS MsgDopsDepA
ReadS [MsgDopsDepA]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgDopsDepA]
$creadListPrec :: ReadPrec [MsgDopsDepA]
readPrec :: ReadPrec MsgDopsDepA
$creadPrec :: ReadPrec MsgDopsDepA
readList :: ReadS [MsgDopsDepA]
$creadList :: ReadS [MsgDopsDepA]
readsPrec :: Int -> ReadS MsgDopsDepA
$creadsPrec :: Int -> ReadS MsgDopsDepA
Read, MsgDopsDepA -> MsgDopsDepA -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgDopsDepA -> MsgDopsDepA -> Bool
$c/= :: MsgDopsDepA -> MsgDopsDepA -> Bool
== :: MsgDopsDepA -> MsgDopsDepA -> Bool
$c== :: MsgDopsDepA -> MsgDopsDepA -> Bool
Eq )

instance Binary MsgDopsDepA where
  get :: Get MsgDopsDepA
get = do
    Word32
_msgDopsDepA_tow <- Get Word32
getWord32le
    Word16
_msgDopsDepA_gdop <- Get Word16
getWord16le
    Word16
_msgDopsDepA_pdop <- Get Word16
getWord16le
    Word16
_msgDopsDepA_tdop <- Get Word16
getWord16le
    Word16
_msgDopsDepA_hdop <- Get Word16
getWord16le
    Word16
_msgDopsDepA_vdop <- Get Word16
getWord16le
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgDopsDepA {Word16
Word32
_msgDopsDepA_vdop :: Word16
_msgDopsDepA_hdop :: Word16
_msgDopsDepA_tdop :: Word16
_msgDopsDepA_pdop :: Word16
_msgDopsDepA_gdop :: Word16
_msgDopsDepA_tow :: Word32
_msgDopsDepA_vdop :: Word16
_msgDopsDepA_hdop :: Word16
_msgDopsDepA_tdop :: Word16
_msgDopsDepA_pdop :: Word16
_msgDopsDepA_gdop :: Word16
_msgDopsDepA_tow :: Word32
..}

  put :: MsgDopsDepA -> Put
put MsgDopsDepA {Word16
Word32
_msgDopsDepA_vdop :: Word16
_msgDopsDepA_hdop :: Word16
_msgDopsDepA_tdop :: Word16
_msgDopsDepA_pdop :: Word16
_msgDopsDepA_gdop :: Word16
_msgDopsDepA_tow :: Word32
_msgDopsDepA_vdop :: MsgDopsDepA -> Word16
_msgDopsDepA_hdop :: MsgDopsDepA -> Word16
_msgDopsDepA_tdop :: MsgDopsDepA -> Word16
_msgDopsDepA_pdop :: MsgDopsDepA -> Word16
_msgDopsDepA_gdop :: MsgDopsDepA -> Word16
_msgDopsDepA_tow :: MsgDopsDepA -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgDopsDepA_tow
    Word16 -> Put
putWord16le Word16
_msgDopsDepA_gdop
    Word16 -> Put
putWord16le Word16
_msgDopsDepA_pdop
    Word16 -> Put
putWord16le Word16
_msgDopsDepA_tdop
    Word16 -> Put
putWord16le Word16
_msgDopsDepA_hdop
    Word16 -> Put
putWord16le Word16
_msgDopsDepA_vdop

$(makeSBP 'msgDopsDepA ''MsgDopsDepA)
$(makeJSON "_msgDopsDepA_" ''MsgDopsDepA)
$(makeLenses ''MsgDopsDepA)

msgPosEcefDepA :: Word16
msgPosEcefDepA :: Word16
msgPosEcefDepA = Word16
0x0200

-- | SBP class for message MSG_POS_ECEF_DEP_A (0x0200).
--
-- The position solution message reports absolute Earth Centered Earth Fixed
-- (ECEF) coordinates and the status (single point vs pseudo-absolute RTK) of
-- the position solution. If the rover receiver knows the surveyed position of
-- the base station and has an RTK solution, this reports a pseudo-absolute
-- position solution using the base station position and the rover's RTK
-- baseline vector. The full GPS time is given by the preceding MSG_GPS_TIME
-- with the matching time-of-week (tow).
data MsgPosEcefDepA = MsgPosEcefDepA
  { MsgPosEcefDepA -> Word32
_msgPosEcefDepA_tow    :: !Word32
    -- ^ GPS Time of Week
  , MsgPosEcefDepA -> Double
_msgPosEcefDepA_x      :: !Double
    -- ^ ECEF X coordinate
  , MsgPosEcefDepA -> Double
_msgPosEcefDepA_y      :: !Double
    -- ^ ECEF Y coordinate
  , MsgPosEcefDepA -> Double
_msgPosEcefDepA_z      :: !Double
    -- ^ ECEF Z coordinate
  , MsgPosEcefDepA -> Word16
_msgPosEcefDepA_accuracy :: !Word16
    -- ^ Position accuracy estimate (not implemented). Defaults to 0.
  , MsgPosEcefDepA -> Word8
_msgPosEcefDepA_n_sats :: !Word8
    -- ^ Number of satellites used in solution
  , MsgPosEcefDepA -> Word8
_msgPosEcefDepA_flags  :: !Word8
    -- ^ Status flags
  } deriving ( Int -> MsgPosEcefDepA -> ShowS
[MsgPosEcefDepA] -> ShowS
MsgPosEcefDepA -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgPosEcefDepA] -> ShowS
$cshowList :: [MsgPosEcefDepA] -> ShowS
show :: MsgPosEcefDepA -> String
$cshow :: MsgPosEcefDepA -> String
showsPrec :: Int -> MsgPosEcefDepA -> ShowS
$cshowsPrec :: Int -> MsgPosEcefDepA -> ShowS
Show, ReadPrec [MsgPosEcefDepA]
ReadPrec MsgPosEcefDepA
Int -> ReadS MsgPosEcefDepA
ReadS [MsgPosEcefDepA]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgPosEcefDepA]
$creadListPrec :: ReadPrec [MsgPosEcefDepA]
readPrec :: ReadPrec MsgPosEcefDepA
$creadPrec :: ReadPrec MsgPosEcefDepA
readList :: ReadS [MsgPosEcefDepA]
$creadList :: ReadS [MsgPosEcefDepA]
readsPrec :: Int -> ReadS MsgPosEcefDepA
$creadsPrec :: Int -> ReadS MsgPosEcefDepA
Read, MsgPosEcefDepA -> MsgPosEcefDepA -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgPosEcefDepA -> MsgPosEcefDepA -> Bool
$c/= :: MsgPosEcefDepA -> MsgPosEcefDepA -> Bool
== :: MsgPosEcefDepA -> MsgPosEcefDepA -> Bool
$c== :: MsgPosEcefDepA -> MsgPosEcefDepA -> Bool
Eq )

instance Binary MsgPosEcefDepA where
  get :: Get MsgPosEcefDepA
get = do
    Word32
_msgPosEcefDepA_tow <- Get Word32
getWord32le
    Double
_msgPosEcefDepA_x <- Get Double
getFloat64le
    Double
_msgPosEcefDepA_y <- Get Double
getFloat64le
    Double
_msgPosEcefDepA_z <- Get Double
getFloat64le
    Word16
_msgPosEcefDepA_accuracy <- Get Word16
getWord16le
    Word8
_msgPosEcefDepA_n_sats <- Get Word8
getWord8
    Word8
_msgPosEcefDepA_flags <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgPosEcefDepA {Double
Word8
Word16
Word32
_msgPosEcefDepA_flags :: Word8
_msgPosEcefDepA_n_sats :: Word8
_msgPosEcefDepA_accuracy :: Word16
_msgPosEcefDepA_z :: Double
_msgPosEcefDepA_y :: Double
_msgPosEcefDepA_x :: Double
_msgPosEcefDepA_tow :: Word32
_msgPosEcefDepA_flags :: Word8
_msgPosEcefDepA_n_sats :: Word8
_msgPosEcefDepA_accuracy :: Word16
_msgPosEcefDepA_z :: Double
_msgPosEcefDepA_y :: Double
_msgPosEcefDepA_x :: Double
_msgPosEcefDepA_tow :: Word32
..}

  put :: MsgPosEcefDepA -> Put
put MsgPosEcefDepA {Double
Word8
Word16
Word32
_msgPosEcefDepA_flags :: Word8
_msgPosEcefDepA_n_sats :: Word8
_msgPosEcefDepA_accuracy :: Word16
_msgPosEcefDepA_z :: Double
_msgPosEcefDepA_y :: Double
_msgPosEcefDepA_x :: Double
_msgPosEcefDepA_tow :: Word32
_msgPosEcefDepA_flags :: MsgPosEcefDepA -> Word8
_msgPosEcefDepA_n_sats :: MsgPosEcefDepA -> Word8
_msgPosEcefDepA_accuracy :: MsgPosEcefDepA -> Word16
_msgPosEcefDepA_z :: MsgPosEcefDepA -> Double
_msgPosEcefDepA_y :: MsgPosEcefDepA -> Double
_msgPosEcefDepA_x :: MsgPosEcefDepA -> Double
_msgPosEcefDepA_tow :: MsgPosEcefDepA -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgPosEcefDepA_tow
    Double -> Put
putFloat64le Double
_msgPosEcefDepA_x
    Double -> Put
putFloat64le Double
_msgPosEcefDepA_y
    Double -> Put
putFloat64le Double
_msgPosEcefDepA_z
    Word16 -> Put
putWord16le Word16
_msgPosEcefDepA_accuracy
    Word8 -> Put
putWord8 Word8
_msgPosEcefDepA_n_sats
    Word8 -> Put
putWord8 Word8
_msgPosEcefDepA_flags

$(makeSBP 'msgPosEcefDepA ''MsgPosEcefDepA)
$(makeJSON "_msgPosEcefDepA_" ''MsgPosEcefDepA)
$(makeLenses ''MsgPosEcefDepA)

msgPosLlhDepA :: Word16
msgPosLlhDepA :: Word16
msgPosLlhDepA = Word16
0x0201

-- | SBP class for message MSG_POS_LLH_DEP_A (0x0201).
--
-- This position solution message reports the absolute geodetic coordinates
-- and the status (single point vs pseudo-absolute RTK) of the position
-- solution. If the rover receiver knows the surveyed position of the base
-- station and has an RTK solution, this reports a pseudo-absolute position
-- solution using the base station position and the rover's RTK baseline
-- vector. The full GPS time is given by the preceding MSG_GPS_TIME with the
-- matching time-of-week (tow).
data MsgPosLlhDepA = MsgPosLlhDepA
  { MsgPosLlhDepA -> Word32
_msgPosLlhDepA_tow      :: !Word32
    -- ^ GPS Time of Week
  , MsgPosLlhDepA -> Double
_msgPosLlhDepA_lat      :: !Double
    -- ^ Latitude
  , MsgPosLlhDepA -> Double
_msgPosLlhDepA_lon      :: !Double
    -- ^ Longitude
  , MsgPosLlhDepA -> Double
_msgPosLlhDepA_height   :: !Double
    -- ^ Height
  , MsgPosLlhDepA -> Word16
_msgPosLlhDepA_h_accuracy :: !Word16
    -- ^ Horizontal position accuracy estimate (not implemented). Defaults to 0.
  , MsgPosLlhDepA -> Word16
_msgPosLlhDepA_v_accuracy :: !Word16
    -- ^ Vertical position accuracy estimate (not implemented). Defaults to 0.
  , MsgPosLlhDepA -> Word8
_msgPosLlhDepA_n_sats   :: !Word8
    -- ^ Number of satellites used in solution.
  , MsgPosLlhDepA -> Word8
_msgPosLlhDepA_flags    :: !Word8
    -- ^ Status flags
  } deriving ( Int -> MsgPosLlhDepA -> ShowS
[MsgPosLlhDepA] -> ShowS
MsgPosLlhDepA -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgPosLlhDepA] -> ShowS
$cshowList :: [MsgPosLlhDepA] -> ShowS
show :: MsgPosLlhDepA -> String
$cshow :: MsgPosLlhDepA -> String
showsPrec :: Int -> MsgPosLlhDepA -> ShowS
$cshowsPrec :: Int -> MsgPosLlhDepA -> ShowS
Show, ReadPrec [MsgPosLlhDepA]
ReadPrec MsgPosLlhDepA
Int -> ReadS MsgPosLlhDepA
ReadS [MsgPosLlhDepA]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgPosLlhDepA]
$creadListPrec :: ReadPrec [MsgPosLlhDepA]
readPrec :: ReadPrec MsgPosLlhDepA
$creadPrec :: ReadPrec MsgPosLlhDepA
readList :: ReadS [MsgPosLlhDepA]
$creadList :: ReadS [MsgPosLlhDepA]
readsPrec :: Int -> ReadS MsgPosLlhDepA
$creadsPrec :: Int -> ReadS MsgPosLlhDepA
Read, MsgPosLlhDepA -> MsgPosLlhDepA -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgPosLlhDepA -> MsgPosLlhDepA -> Bool
$c/= :: MsgPosLlhDepA -> MsgPosLlhDepA -> Bool
== :: MsgPosLlhDepA -> MsgPosLlhDepA -> Bool
$c== :: MsgPosLlhDepA -> MsgPosLlhDepA -> Bool
Eq )

instance Binary MsgPosLlhDepA where
  get :: Get MsgPosLlhDepA
get = do
    Word32
_msgPosLlhDepA_tow <- Get Word32
getWord32le
    Double
_msgPosLlhDepA_lat <- Get Double
getFloat64le
    Double
_msgPosLlhDepA_lon <- Get Double
getFloat64le
    Double
_msgPosLlhDepA_height <- Get Double
getFloat64le
    Word16
_msgPosLlhDepA_h_accuracy <- Get Word16
getWord16le
    Word16
_msgPosLlhDepA_v_accuracy <- Get Word16
getWord16le
    Word8
_msgPosLlhDepA_n_sats <- Get Word8
getWord8
    Word8
_msgPosLlhDepA_flags <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgPosLlhDepA {Double
Word8
Word16
Word32
_msgPosLlhDepA_flags :: Word8
_msgPosLlhDepA_n_sats :: Word8
_msgPosLlhDepA_v_accuracy :: Word16
_msgPosLlhDepA_h_accuracy :: Word16
_msgPosLlhDepA_height :: Double
_msgPosLlhDepA_lon :: Double
_msgPosLlhDepA_lat :: Double
_msgPosLlhDepA_tow :: Word32
_msgPosLlhDepA_flags :: Word8
_msgPosLlhDepA_n_sats :: Word8
_msgPosLlhDepA_v_accuracy :: Word16
_msgPosLlhDepA_h_accuracy :: Word16
_msgPosLlhDepA_height :: Double
_msgPosLlhDepA_lon :: Double
_msgPosLlhDepA_lat :: Double
_msgPosLlhDepA_tow :: Word32
..}

  put :: MsgPosLlhDepA -> Put
put MsgPosLlhDepA {Double
Word8
Word16
Word32
_msgPosLlhDepA_flags :: Word8
_msgPosLlhDepA_n_sats :: Word8
_msgPosLlhDepA_v_accuracy :: Word16
_msgPosLlhDepA_h_accuracy :: Word16
_msgPosLlhDepA_height :: Double
_msgPosLlhDepA_lon :: Double
_msgPosLlhDepA_lat :: Double
_msgPosLlhDepA_tow :: Word32
_msgPosLlhDepA_flags :: MsgPosLlhDepA -> Word8
_msgPosLlhDepA_n_sats :: MsgPosLlhDepA -> Word8
_msgPosLlhDepA_v_accuracy :: MsgPosLlhDepA -> Word16
_msgPosLlhDepA_h_accuracy :: MsgPosLlhDepA -> Word16
_msgPosLlhDepA_height :: MsgPosLlhDepA -> Double
_msgPosLlhDepA_lon :: MsgPosLlhDepA -> Double
_msgPosLlhDepA_lat :: MsgPosLlhDepA -> Double
_msgPosLlhDepA_tow :: MsgPosLlhDepA -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgPosLlhDepA_tow
    Double -> Put
putFloat64le Double
_msgPosLlhDepA_lat
    Double -> Put
putFloat64le Double
_msgPosLlhDepA_lon
    Double -> Put
putFloat64le Double
_msgPosLlhDepA_height
    Word16 -> Put
putWord16le Word16
_msgPosLlhDepA_h_accuracy
    Word16 -> Put
putWord16le Word16
_msgPosLlhDepA_v_accuracy
    Word8 -> Put
putWord8 Word8
_msgPosLlhDepA_n_sats
    Word8 -> Put
putWord8 Word8
_msgPosLlhDepA_flags

$(makeSBP 'msgPosLlhDepA ''MsgPosLlhDepA)
$(makeJSON "_msgPosLlhDepA_" ''MsgPosLlhDepA)
$(makeLenses ''MsgPosLlhDepA)

msgBaselineEcefDepA :: Word16
msgBaselineEcefDepA :: Word16
msgBaselineEcefDepA = Word16
0x0202

-- | SBP class for message MSG_BASELINE_ECEF_DEP_A (0x0202).
--
-- This message reports the baseline solution in Earth Centered Earth Fixed
-- (ECEF) coordinates. This baseline is the relative vector distance from the
-- base station to the rover receiver. The full GPS time is given by the
-- preceding MSG_GPS_TIME with the matching time-of-week (tow).
data MsgBaselineEcefDepA = MsgBaselineEcefDepA
  { MsgBaselineEcefDepA -> Word32
_msgBaselineEcefDepA_tow    :: !Word32
    -- ^ GPS Time of Week
  , MsgBaselineEcefDepA -> Int32
_msgBaselineEcefDepA_x      :: !Int32
    -- ^ Baseline ECEF X coordinate
  , MsgBaselineEcefDepA -> Int32
_msgBaselineEcefDepA_y      :: !Int32
    -- ^ Baseline ECEF Y coordinate
  , MsgBaselineEcefDepA -> Int32
_msgBaselineEcefDepA_z      :: !Int32
    -- ^ Baseline ECEF Z coordinate
  , MsgBaselineEcefDepA -> Word16
_msgBaselineEcefDepA_accuracy :: !Word16
    -- ^ Position accuracy estimate
  , MsgBaselineEcefDepA -> Word8
_msgBaselineEcefDepA_n_sats :: !Word8
    -- ^ Number of satellites used in solution
  , MsgBaselineEcefDepA -> Word8
_msgBaselineEcefDepA_flags  :: !Word8
    -- ^ Status flags
  } deriving ( Int -> MsgBaselineEcefDepA -> ShowS
[MsgBaselineEcefDepA] -> ShowS
MsgBaselineEcefDepA -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgBaselineEcefDepA] -> ShowS
$cshowList :: [MsgBaselineEcefDepA] -> ShowS
show :: MsgBaselineEcefDepA -> String
$cshow :: MsgBaselineEcefDepA -> String
showsPrec :: Int -> MsgBaselineEcefDepA -> ShowS
$cshowsPrec :: Int -> MsgBaselineEcefDepA -> ShowS
Show, ReadPrec [MsgBaselineEcefDepA]
ReadPrec MsgBaselineEcefDepA
Int -> ReadS MsgBaselineEcefDepA
ReadS [MsgBaselineEcefDepA]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgBaselineEcefDepA]
$creadListPrec :: ReadPrec [MsgBaselineEcefDepA]
readPrec :: ReadPrec MsgBaselineEcefDepA
$creadPrec :: ReadPrec MsgBaselineEcefDepA
readList :: ReadS [MsgBaselineEcefDepA]
$creadList :: ReadS [MsgBaselineEcefDepA]
readsPrec :: Int -> ReadS MsgBaselineEcefDepA
$creadsPrec :: Int -> ReadS MsgBaselineEcefDepA
Read, MsgBaselineEcefDepA -> MsgBaselineEcefDepA -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgBaselineEcefDepA -> MsgBaselineEcefDepA -> Bool
$c/= :: MsgBaselineEcefDepA -> MsgBaselineEcefDepA -> Bool
== :: MsgBaselineEcefDepA -> MsgBaselineEcefDepA -> Bool
$c== :: MsgBaselineEcefDepA -> MsgBaselineEcefDepA -> Bool
Eq )

instance Binary MsgBaselineEcefDepA where
  get :: Get MsgBaselineEcefDepA
get = do
    Word32
_msgBaselineEcefDepA_tow <- Get Word32
getWord32le
    Int32
_msgBaselineEcefDepA_x <- (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
_msgBaselineEcefDepA_y <- (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
_msgBaselineEcefDepA_z <- (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)
    Word16
_msgBaselineEcefDepA_accuracy <- Get Word16
getWord16le
    Word8
_msgBaselineEcefDepA_n_sats <- Get Word8
getWord8
    Word8
_msgBaselineEcefDepA_flags <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgBaselineEcefDepA {Int32
Word8
Word16
Word32
_msgBaselineEcefDepA_flags :: Word8
_msgBaselineEcefDepA_n_sats :: Word8
_msgBaselineEcefDepA_accuracy :: Word16
_msgBaselineEcefDepA_z :: Int32
_msgBaselineEcefDepA_y :: Int32
_msgBaselineEcefDepA_x :: Int32
_msgBaselineEcefDepA_tow :: Word32
_msgBaselineEcefDepA_flags :: Word8
_msgBaselineEcefDepA_n_sats :: Word8
_msgBaselineEcefDepA_accuracy :: Word16
_msgBaselineEcefDepA_z :: Int32
_msgBaselineEcefDepA_y :: Int32
_msgBaselineEcefDepA_x :: Int32
_msgBaselineEcefDepA_tow :: Word32
..}

  put :: MsgBaselineEcefDepA -> Put
put MsgBaselineEcefDepA {Int32
Word8
Word16
Word32
_msgBaselineEcefDepA_flags :: Word8
_msgBaselineEcefDepA_n_sats :: Word8
_msgBaselineEcefDepA_accuracy :: Word16
_msgBaselineEcefDepA_z :: Int32
_msgBaselineEcefDepA_y :: Int32
_msgBaselineEcefDepA_x :: Int32
_msgBaselineEcefDepA_tow :: Word32
_msgBaselineEcefDepA_flags :: MsgBaselineEcefDepA -> Word8
_msgBaselineEcefDepA_n_sats :: MsgBaselineEcefDepA -> Word8
_msgBaselineEcefDepA_accuracy :: MsgBaselineEcefDepA -> Word16
_msgBaselineEcefDepA_z :: MsgBaselineEcefDepA -> Int32
_msgBaselineEcefDepA_y :: MsgBaselineEcefDepA -> Int32
_msgBaselineEcefDepA_x :: MsgBaselineEcefDepA -> Int32
_msgBaselineEcefDepA_tow :: MsgBaselineEcefDepA -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgBaselineEcefDepA_tow
    (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
_msgBaselineEcefDepA_x
    (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
_msgBaselineEcefDepA_y
    (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
_msgBaselineEcefDepA_z
    Word16 -> Put
putWord16le Word16
_msgBaselineEcefDepA_accuracy
    Word8 -> Put
putWord8 Word8
_msgBaselineEcefDepA_n_sats
    Word8 -> Put
putWord8 Word8
_msgBaselineEcefDepA_flags

$(makeSBP 'msgBaselineEcefDepA ''MsgBaselineEcefDepA)
$(makeJSON "_msgBaselineEcefDepA_" ''MsgBaselineEcefDepA)
$(makeLenses ''MsgBaselineEcefDepA)

msgBaselineNedDepA :: Word16
msgBaselineNedDepA :: Word16
msgBaselineNedDepA = Word16
0x0203

-- | SBP class for message MSG_BASELINE_NED_DEP_A (0x0203).
--
-- This message reports the baseline solution in North East Down (NED)
-- coordinates. This baseline is the relative vector distance from the base
-- station to the rover receiver, and NED coordinate system is defined at the
-- local WGS84 tangent plane centered at the base station position.  The full
-- GPS time is given by the preceding MSG_GPS_TIME with the matching time-of-
-- week (tow).
data MsgBaselineNedDepA = MsgBaselineNedDepA
  { MsgBaselineNedDepA -> Word32
_msgBaselineNedDepA_tow      :: !Word32
    -- ^ GPS Time of Week
  , MsgBaselineNedDepA -> Int32
_msgBaselineNedDepA_n        :: !Int32
    -- ^ Baseline North coordinate
  , MsgBaselineNedDepA -> Int32
_msgBaselineNedDepA_e        :: !Int32
    -- ^ Baseline East coordinate
  , MsgBaselineNedDepA -> Int32
_msgBaselineNedDepA_d        :: !Int32
    -- ^ Baseline Down coordinate
  , MsgBaselineNedDepA -> Word16
_msgBaselineNedDepA_h_accuracy :: !Word16
    -- ^ Horizontal position accuracy estimate (not implemented). Defaults to 0.
  , MsgBaselineNedDepA -> Word16
_msgBaselineNedDepA_v_accuracy :: !Word16
    -- ^ Vertical position accuracy estimate (not implemented). Defaults to 0.
  , MsgBaselineNedDepA -> Word8
_msgBaselineNedDepA_n_sats   :: !Word8
    -- ^ Number of satellites used in solution
  , MsgBaselineNedDepA -> Word8
_msgBaselineNedDepA_flags    :: !Word8
    -- ^ Status flags
  } deriving ( Int -> MsgBaselineNedDepA -> ShowS
[MsgBaselineNedDepA] -> ShowS
MsgBaselineNedDepA -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgBaselineNedDepA] -> ShowS
$cshowList :: [MsgBaselineNedDepA] -> ShowS
show :: MsgBaselineNedDepA -> String
$cshow :: MsgBaselineNedDepA -> String
showsPrec :: Int -> MsgBaselineNedDepA -> ShowS
$cshowsPrec :: Int -> MsgBaselineNedDepA -> ShowS
Show, ReadPrec [MsgBaselineNedDepA]
ReadPrec MsgBaselineNedDepA
Int -> ReadS MsgBaselineNedDepA
ReadS [MsgBaselineNedDepA]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgBaselineNedDepA]
$creadListPrec :: ReadPrec [MsgBaselineNedDepA]
readPrec :: ReadPrec MsgBaselineNedDepA
$creadPrec :: ReadPrec MsgBaselineNedDepA
readList :: ReadS [MsgBaselineNedDepA]
$creadList :: ReadS [MsgBaselineNedDepA]
readsPrec :: Int -> ReadS MsgBaselineNedDepA
$creadsPrec :: Int -> ReadS MsgBaselineNedDepA
Read, MsgBaselineNedDepA -> MsgBaselineNedDepA -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgBaselineNedDepA -> MsgBaselineNedDepA -> Bool
$c/= :: MsgBaselineNedDepA -> MsgBaselineNedDepA -> Bool
== :: MsgBaselineNedDepA -> MsgBaselineNedDepA -> Bool
$c== :: MsgBaselineNedDepA -> MsgBaselineNedDepA -> Bool
Eq )

instance Binary MsgBaselineNedDepA where
  get :: Get MsgBaselineNedDepA
get = do
    Word32
_msgBaselineNedDepA_tow <- Get Word32
getWord32le
    Int32
_msgBaselineNedDepA_n <- (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
_msgBaselineNedDepA_e <- (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
_msgBaselineNedDepA_d <- (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)
    Word16
_msgBaselineNedDepA_h_accuracy <- Get Word16
getWord16le
    Word16
_msgBaselineNedDepA_v_accuracy <- Get Word16
getWord16le
    Word8
_msgBaselineNedDepA_n_sats <- Get Word8
getWord8
    Word8
_msgBaselineNedDepA_flags <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgBaselineNedDepA {Int32
Word8
Word16
Word32
_msgBaselineNedDepA_flags :: Word8
_msgBaselineNedDepA_n_sats :: Word8
_msgBaselineNedDepA_v_accuracy :: Word16
_msgBaselineNedDepA_h_accuracy :: Word16
_msgBaselineNedDepA_d :: Int32
_msgBaselineNedDepA_e :: Int32
_msgBaselineNedDepA_n :: Int32
_msgBaselineNedDepA_tow :: Word32
_msgBaselineNedDepA_flags :: Word8
_msgBaselineNedDepA_n_sats :: Word8
_msgBaselineNedDepA_v_accuracy :: Word16
_msgBaselineNedDepA_h_accuracy :: Word16
_msgBaselineNedDepA_d :: Int32
_msgBaselineNedDepA_e :: Int32
_msgBaselineNedDepA_n :: Int32
_msgBaselineNedDepA_tow :: Word32
..}

  put :: MsgBaselineNedDepA -> Put
put MsgBaselineNedDepA {Int32
Word8
Word16
Word32
_msgBaselineNedDepA_flags :: Word8
_msgBaselineNedDepA_n_sats :: Word8
_msgBaselineNedDepA_v_accuracy :: Word16
_msgBaselineNedDepA_h_accuracy :: Word16
_msgBaselineNedDepA_d :: Int32
_msgBaselineNedDepA_e :: Int32
_msgBaselineNedDepA_n :: Int32
_msgBaselineNedDepA_tow :: Word32
_msgBaselineNedDepA_flags :: MsgBaselineNedDepA -> Word8
_msgBaselineNedDepA_n_sats :: MsgBaselineNedDepA -> Word8
_msgBaselineNedDepA_v_accuracy :: MsgBaselineNedDepA -> Word16
_msgBaselineNedDepA_h_accuracy :: MsgBaselineNedDepA -> Word16
_msgBaselineNedDepA_d :: MsgBaselineNedDepA -> Int32
_msgBaselineNedDepA_e :: MsgBaselineNedDepA -> Int32
_msgBaselineNedDepA_n :: MsgBaselineNedDepA -> Int32
_msgBaselineNedDepA_tow :: MsgBaselineNedDepA -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgBaselineNedDepA_tow
    (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
_msgBaselineNedDepA_n
    (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
_msgBaselineNedDepA_e
    (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
_msgBaselineNedDepA_d
    Word16 -> Put
putWord16le Word16
_msgBaselineNedDepA_h_accuracy
    Word16 -> Put
putWord16le Word16
_msgBaselineNedDepA_v_accuracy
    Word8 -> Put
putWord8 Word8
_msgBaselineNedDepA_n_sats
    Word8 -> Put
putWord8 Word8
_msgBaselineNedDepA_flags

$(makeSBP 'msgBaselineNedDepA ''MsgBaselineNedDepA)
$(makeJSON "_msgBaselineNedDepA_" ''MsgBaselineNedDepA)
$(makeLenses ''MsgBaselineNedDepA)

msgVelEcefDepA :: Word16
msgVelEcefDepA :: Word16
msgVelEcefDepA = Word16
0x0204

-- | SBP class for message MSG_VEL_ECEF_DEP_A (0x0204).
--
-- This message reports the velocity in Earth Centered Earth Fixed (ECEF)
-- coordinates. The full GPS time is given by the preceding MSG_GPS_TIME with
-- the matching time-of-week (tow).
data MsgVelEcefDepA = MsgVelEcefDepA
  { MsgVelEcefDepA -> Word32
_msgVelEcefDepA_tow    :: !Word32
    -- ^ GPS Time of Week
  , MsgVelEcefDepA -> Int32
_msgVelEcefDepA_x      :: !Int32
    -- ^ Velocity ECEF X coordinate
  , MsgVelEcefDepA -> Int32
_msgVelEcefDepA_y      :: !Int32
    -- ^ Velocity ECEF Y coordinate
  , MsgVelEcefDepA -> Int32
_msgVelEcefDepA_z      :: !Int32
    -- ^ Velocity ECEF Z coordinate
  , MsgVelEcefDepA -> Word16
_msgVelEcefDepA_accuracy :: !Word16
    -- ^ Velocity accuracy estimate (not implemented). Defaults to 0.
  , MsgVelEcefDepA -> Word8
_msgVelEcefDepA_n_sats :: !Word8
    -- ^ Number of satellites used in solution
  , MsgVelEcefDepA -> Word8
_msgVelEcefDepA_flags  :: !Word8
    -- ^ Status flags (reserved)
  } deriving ( Int -> MsgVelEcefDepA -> ShowS
[MsgVelEcefDepA] -> ShowS
MsgVelEcefDepA -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgVelEcefDepA] -> ShowS
$cshowList :: [MsgVelEcefDepA] -> ShowS
show :: MsgVelEcefDepA -> String
$cshow :: MsgVelEcefDepA -> String
showsPrec :: Int -> MsgVelEcefDepA -> ShowS
$cshowsPrec :: Int -> MsgVelEcefDepA -> ShowS
Show, ReadPrec [MsgVelEcefDepA]
ReadPrec MsgVelEcefDepA
Int -> ReadS MsgVelEcefDepA
ReadS [MsgVelEcefDepA]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgVelEcefDepA]
$creadListPrec :: ReadPrec [MsgVelEcefDepA]
readPrec :: ReadPrec MsgVelEcefDepA
$creadPrec :: ReadPrec MsgVelEcefDepA
readList :: ReadS [MsgVelEcefDepA]
$creadList :: ReadS [MsgVelEcefDepA]
readsPrec :: Int -> ReadS MsgVelEcefDepA
$creadsPrec :: Int -> ReadS MsgVelEcefDepA
Read, MsgVelEcefDepA -> MsgVelEcefDepA -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgVelEcefDepA -> MsgVelEcefDepA -> Bool
$c/= :: MsgVelEcefDepA -> MsgVelEcefDepA -> Bool
== :: MsgVelEcefDepA -> MsgVelEcefDepA -> Bool
$c== :: MsgVelEcefDepA -> MsgVelEcefDepA -> Bool
Eq )

instance Binary MsgVelEcefDepA where
  get :: Get MsgVelEcefDepA
get = do
    Word32
_msgVelEcefDepA_tow <- Get Word32
getWord32le
    Int32
_msgVelEcefDepA_x <- (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
_msgVelEcefDepA_y <- (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
_msgVelEcefDepA_z <- (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)
    Word16
_msgVelEcefDepA_accuracy <- Get Word16
getWord16le
    Word8
_msgVelEcefDepA_n_sats <- Get Word8
getWord8
    Word8
_msgVelEcefDepA_flags <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgVelEcefDepA {Int32
Word8
Word16
Word32
_msgVelEcefDepA_flags :: Word8
_msgVelEcefDepA_n_sats :: Word8
_msgVelEcefDepA_accuracy :: Word16
_msgVelEcefDepA_z :: Int32
_msgVelEcefDepA_y :: Int32
_msgVelEcefDepA_x :: Int32
_msgVelEcefDepA_tow :: Word32
_msgVelEcefDepA_flags :: Word8
_msgVelEcefDepA_n_sats :: Word8
_msgVelEcefDepA_accuracy :: Word16
_msgVelEcefDepA_z :: Int32
_msgVelEcefDepA_y :: Int32
_msgVelEcefDepA_x :: Int32
_msgVelEcefDepA_tow :: Word32
..}

  put :: MsgVelEcefDepA -> Put
put MsgVelEcefDepA {Int32
Word8
Word16
Word32
_msgVelEcefDepA_flags :: Word8
_msgVelEcefDepA_n_sats :: Word8
_msgVelEcefDepA_accuracy :: Word16
_msgVelEcefDepA_z :: Int32
_msgVelEcefDepA_y :: Int32
_msgVelEcefDepA_x :: Int32
_msgVelEcefDepA_tow :: Word32
_msgVelEcefDepA_flags :: MsgVelEcefDepA -> Word8
_msgVelEcefDepA_n_sats :: MsgVelEcefDepA -> Word8
_msgVelEcefDepA_accuracy :: MsgVelEcefDepA -> Word16
_msgVelEcefDepA_z :: MsgVelEcefDepA -> Int32
_msgVelEcefDepA_y :: MsgVelEcefDepA -> Int32
_msgVelEcefDepA_x :: MsgVelEcefDepA -> Int32
_msgVelEcefDepA_tow :: MsgVelEcefDepA -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgVelEcefDepA_tow
    (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
_msgVelEcefDepA_x
    (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
_msgVelEcefDepA_y
    (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
_msgVelEcefDepA_z
    Word16 -> Put
putWord16le Word16
_msgVelEcefDepA_accuracy
    Word8 -> Put
putWord8 Word8
_msgVelEcefDepA_n_sats
    Word8 -> Put
putWord8 Word8
_msgVelEcefDepA_flags

$(makeSBP 'msgVelEcefDepA ''MsgVelEcefDepA)
$(makeJSON "_msgVelEcefDepA_" ''MsgVelEcefDepA)
$(makeLenses ''MsgVelEcefDepA)

msgVelNedDepA :: Word16
msgVelNedDepA :: Word16
msgVelNedDepA = Word16
0x0205

-- | SBP class for message MSG_VEL_NED_DEP_A (0x0205).
--
-- This message reports the velocity in local North East Down (NED)
-- coordinates. The NED coordinate system is defined as the local WGS84
-- tangent plane centered at the current position. The full GPS time is given
-- by the preceding MSG_GPS_TIME with the matching time-of-week (tow).
data MsgVelNedDepA = MsgVelNedDepA
  { MsgVelNedDepA -> Word32
_msgVelNedDepA_tow      :: !Word32
    -- ^ GPS Time of Week
  , MsgVelNedDepA -> Int32
_msgVelNedDepA_n        :: !Int32
    -- ^ Velocity North coordinate
  , MsgVelNedDepA -> Int32
_msgVelNedDepA_e        :: !Int32
    -- ^ Velocity East coordinate
  , MsgVelNedDepA -> Int32
_msgVelNedDepA_d        :: !Int32
    -- ^ Velocity Down coordinate
  , MsgVelNedDepA -> Word16
_msgVelNedDepA_h_accuracy :: !Word16
    -- ^ Horizontal velocity accuracy estimate (not implemented). Defaults to 0.
  , MsgVelNedDepA -> Word16
_msgVelNedDepA_v_accuracy :: !Word16
    -- ^ Vertical velocity accuracy estimate (not implemented). Defaults to 0.
  , MsgVelNedDepA -> Word8
_msgVelNedDepA_n_sats   :: !Word8
    -- ^ Number of satellites used in solution
  , MsgVelNedDepA -> Word8
_msgVelNedDepA_flags    :: !Word8
    -- ^ Status flags (reserved)
  } deriving ( Int -> MsgVelNedDepA -> ShowS
[MsgVelNedDepA] -> ShowS
MsgVelNedDepA -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgVelNedDepA] -> ShowS
$cshowList :: [MsgVelNedDepA] -> ShowS
show :: MsgVelNedDepA -> String
$cshow :: MsgVelNedDepA -> String
showsPrec :: Int -> MsgVelNedDepA -> ShowS
$cshowsPrec :: Int -> MsgVelNedDepA -> ShowS
Show, ReadPrec [MsgVelNedDepA]
ReadPrec MsgVelNedDepA
Int -> ReadS MsgVelNedDepA
ReadS [MsgVelNedDepA]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgVelNedDepA]
$creadListPrec :: ReadPrec [MsgVelNedDepA]
readPrec :: ReadPrec MsgVelNedDepA
$creadPrec :: ReadPrec MsgVelNedDepA
readList :: ReadS [MsgVelNedDepA]
$creadList :: ReadS [MsgVelNedDepA]
readsPrec :: Int -> ReadS MsgVelNedDepA
$creadsPrec :: Int -> ReadS MsgVelNedDepA
Read, MsgVelNedDepA -> MsgVelNedDepA -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgVelNedDepA -> MsgVelNedDepA -> Bool
$c/= :: MsgVelNedDepA -> MsgVelNedDepA -> Bool
== :: MsgVelNedDepA -> MsgVelNedDepA -> Bool
$c== :: MsgVelNedDepA -> MsgVelNedDepA -> Bool
Eq )

instance Binary MsgVelNedDepA where
  get :: Get MsgVelNedDepA
get = do
    Word32
_msgVelNedDepA_tow <- Get Word32
getWord32le
    Int32
_msgVelNedDepA_n <- (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
_msgVelNedDepA_e <- (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
_msgVelNedDepA_d <- (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)
    Word16
_msgVelNedDepA_h_accuracy <- Get Word16
getWord16le
    Word16
_msgVelNedDepA_v_accuracy <- Get Word16
getWord16le
    Word8
_msgVelNedDepA_n_sats <- Get Word8
getWord8
    Word8
_msgVelNedDepA_flags <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgVelNedDepA {Int32
Word8
Word16
Word32
_msgVelNedDepA_flags :: Word8
_msgVelNedDepA_n_sats :: Word8
_msgVelNedDepA_v_accuracy :: Word16
_msgVelNedDepA_h_accuracy :: Word16
_msgVelNedDepA_d :: Int32
_msgVelNedDepA_e :: Int32
_msgVelNedDepA_n :: Int32
_msgVelNedDepA_tow :: Word32
_msgVelNedDepA_flags :: Word8
_msgVelNedDepA_n_sats :: Word8
_msgVelNedDepA_v_accuracy :: Word16
_msgVelNedDepA_h_accuracy :: Word16
_msgVelNedDepA_d :: Int32
_msgVelNedDepA_e :: Int32
_msgVelNedDepA_n :: Int32
_msgVelNedDepA_tow :: Word32
..}

  put :: MsgVelNedDepA -> Put
put MsgVelNedDepA {Int32
Word8
Word16
Word32
_msgVelNedDepA_flags :: Word8
_msgVelNedDepA_n_sats :: Word8
_msgVelNedDepA_v_accuracy :: Word16
_msgVelNedDepA_h_accuracy :: Word16
_msgVelNedDepA_d :: Int32
_msgVelNedDepA_e :: Int32
_msgVelNedDepA_n :: Int32
_msgVelNedDepA_tow :: Word32
_msgVelNedDepA_flags :: MsgVelNedDepA -> Word8
_msgVelNedDepA_n_sats :: MsgVelNedDepA -> Word8
_msgVelNedDepA_v_accuracy :: MsgVelNedDepA -> Word16
_msgVelNedDepA_h_accuracy :: MsgVelNedDepA -> Word16
_msgVelNedDepA_d :: MsgVelNedDepA -> Int32
_msgVelNedDepA_e :: MsgVelNedDepA -> Int32
_msgVelNedDepA_n :: MsgVelNedDepA -> Int32
_msgVelNedDepA_tow :: MsgVelNedDepA -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgVelNedDepA_tow
    (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
_msgVelNedDepA_n
    (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
_msgVelNedDepA_e
    (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
_msgVelNedDepA_d
    Word16 -> Put
putWord16le Word16
_msgVelNedDepA_h_accuracy
    Word16 -> Put
putWord16le Word16
_msgVelNedDepA_v_accuracy
    Word8 -> Put
putWord8 Word8
_msgVelNedDepA_n_sats
    Word8 -> Put
putWord8 Word8
_msgVelNedDepA_flags

$(makeSBP 'msgVelNedDepA ''MsgVelNedDepA)
$(makeJSON "_msgVelNedDepA_" ''MsgVelNedDepA)
$(makeLenses ''MsgVelNedDepA)

msgBaselineHeadingDepA :: Word16
msgBaselineHeadingDepA :: Word16
msgBaselineHeadingDepA = Word16
0x0207

-- | SBP class for message MSG_BASELINE_HEADING_DEP_A (0x0207).
--
-- This message reports the baseline heading pointing from the base station to
-- the rover relative to True North. The full GPS time is given by the
-- preceding MSG_GPS_TIME with the matching time-of-week (tow).
data MsgBaselineHeadingDepA = MsgBaselineHeadingDepA
  { MsgBaselineHeadingDepA -> Word32
_msgBaselineHeadingDepA_tow   :: !Word32
    -- ^ GPS Time of Week
  , MsgBaselineHeadingDepA -> Word32
_msgBaselineHeadingDepA_heading :: !Word32
    -- ^ Heading
  , MsgBaselineHeadingDepA -> Word8
_msgBaselineHeadingDepA_n_sats :: !Word8
    -- ^ Number of satellites used in solution
  , MsgBaselineHeadingDepA -> Word8
_msgBaselineHeadingDepA_flags :: !Word8
    -- ^ Status flags
  } deriving ( Int -> MsgBaselineHeadingDepA -> ShowS
[MsgBaselineHeadingDepA] -> ShowS
MsgBaselineHeadingDepA -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgBaselineHeadingDepA] -> ShowS
$cshowList :: [MsgBaselineHeadingDepA] -> ShowS
show :: MsgBaselineHeadingDepA -> String
$cshow :: MsgBaselineHeadingDepA -> String
showsPrec :: Int -> MsgBaselineHeadingDepA -> ShowS
$cshowsPrec :: Int -> MsgBaselineHeadingDepA -> ShowS
Show, ReadPrec [MsgBaselineHeadingDepA]
ReadPrec MsgBaselineHeadingDepA
Int -> ReadS MsgBaselineHeadingDepA
ReadS [MsgBaselineHeadingDepA]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgBaselineHeadingDepA]
$creadListPrec :: ReadPrec [MsgBaselineHeadingDepA]
readPrec :: ReadPrec MsgBaselineHeadingDepA
$creadPrec :: ReadPrec MsgBaselineHeadingDepA
readList :: ReadS [MsgBaselineHeadingDepA]
$creadList :: ReadS [MsgBaselineHeadingDepA]
readsPrec :: Int -> ReadS MsgBaselineHeadingDepA
$creadsPrec :: Int -> ReadS MsgBaselineHeadingDepA
Read, MsgBaselineHeadingDepA -> MsgBaselineHeadingDepA -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgBaselineHeadingDepA -> MsgBaselineHeadingDepA -> Bool
$c/= :: MsgBaselineHeadingDepA -> MsgBaselineHeadingDepA -> Bool
== :: MsgBaselineHeadingDepA -> MsgBaselineHeadingDepA -> Bool
$c== :: MsgBaselineHeadingDepA -> MsgBaselineHeadingDepA -> Bool
Eq )

instance Binary MsgBaselineHeadingDepA where
  get :: Get MsgBaselineHeadingDepA
get = do
    Word32
_msgBaselineHeadingDepA_tow <- Get Word32
getWord32le
    Word32
_msgBaselineHeadingDepA_heading <- Get Word32
getWord32le
    Word8
_msgBaselineHeadingDepA_n_sats <- Get Word8
getWord8
    Word8
_msgBaselineHeadingDepA_flags <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgBaselineHeadingDepA {Word8
Word32
_msgBaselineHeadingDepA_flags :: Word8
_msgBaselineHeadingDepA_n_sats :: Word8
_msgBaselineHeadingDepA_heading :: Word32
_msgBaselineHeadingDepA_tow :: Word32
_msgBaselineHeadingDepA_flags :: Word8
_msgBaselineHeadingDepA_n_sats :: Word8
_msgBaselineHeadingDepA_heading :: Word32
_msgBaselineHeadingDepA_tow :: Word32
..}

  put :: MsgBaselineHeadingDepA -> Put
put MsgBaselineHeadingDepA {Word8
Word32
_msgBaselineHeadingDepA_flags :: Word8
_msgBaselineHeadingDepA_n_sats :: Word8
_msgBaselineHeadingDepA_heading :: Word32
_msgBaselineHeadingDepA_tow :: Word32
_msgBaselineHeadingDepA_flags :: MsgBaselineHeadingDepA -> Word8
_msgBaselineHeadingDepA_n_sats :: MsgBaselineHeadingDepA -> Word8
_msgBaselineHeadingDepA_heading :: MsgBaselineHeadingDepA -> Word32
_msgBaselineHeadingDepA_tow :: MsgBaselineHeadingDepA -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgBaselineHeadingDepA_tow
    Word32 -> Put
putWord32le Word32
_msgBaselineHeadingDepA_heading
    Word8 -> Put
putWord8 Word8
_msgBaselineHeadingDepA_n_sats
    Word8 -> Put
putWord8 Word8
_msgBaselineHeadingDepA_flags

$(makeSBP 'msgBaselineHeadingDepA ''MsgBaselineHeadingDepA)
$(makeJSON "_msgBaselineHeadingDepA_" ''MsgBaselineHeadingDepA)
$(makeLenses ''MsgBaselineHeadingDepA)

msgProtectionLevelDepA :: Word16
msgProtectionLevelDepA :: Word16
msgProtectionLevelDepA = Word16
0x0216

-- | SBP class for message MSG_PROTECTION_LEVEL_DEP_A (0x0216).
--
-- This message reports the local vertical and horizontal protection levels
-- associated with a given LLH position solution. The full GPS time is given
-- by the preceding MSG_GPS_TIME with the matching time-of-week (tow).
data MsgProtectionLevelDepA = MsgProtectionLevelDepA
  { MsgProtectionLevelDepA -> Word32
_msgProtectionLevelDepA_tow  :: !Word32
    -- ^ GPS Time of Week
  , MsgProtectionLevelDepA -> Word16
_msgProtectionLevelDepA_vpl  :: !Word16
    -- ^ Vertical protection level
  , MsgProtectionLevelDepA -> Word16
_msgProtectionLevelDepA_hpl  :: !Word16
    -- ^ Horizontal protection level
  , MsgProtectionLevelDepA -> Double
_msgProtectionLevelDepA_lat  :: !Double
    -- ^ Latitude
  , MsgProtectionLevelDepA -> Double
_msgProtectionLevelDepA_lon  :: !Double
    -- ^ Longitude
  , MsgProtectionLevelDepA -> Double
_msgProtectionLevelDepA_height :: !Double
    -- ^ Height
  , MsgProtectionLevelDepA -> Word8
_msgProtectionLevelDepA_flags :: !Word8
    -- ^ Status flags
  } deriving ( Int -> MsgProtectionLevelDepA -> ShowS
[MsgProtectionLevelDepA] -> ShowS
MsgProtectionLevelDepA -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgProtectionLevelDepA] -> ShowS
$cshowList :: [MsgProtectionLevelDepA] -> ShowS
show :: MsgProtectionLevelDepA -> String
$cshow :: MsgProtectionLevelDepA -> String
showsPrec :: Int -> MsgProtectionLevelDepA -> ShowS
$cshowsPrec :: Int -> MsgProtectionLevelDepA -> ShowS
Show, ReadPrec [MsgProtectionLevelDepA]
ReadPrec MsgProtectionLevelDepA
Int -> ReadS MsgProtectionLevelDepA
ReadS [MsgProtectionLevelDepA]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgProtectionLevelDepA]
$creadListPrec :: ReadPrec [MsgProtectionLevelDepA]
readPrec :: ReadPrec MsgProtectionLevelDepA
$creadPrec :: ReadPrec MsgProtectionLevelDepA
readList :: ReadS [MsgProtectionLevelDepA]
$creadList :: ReadS [MsgProtectionLevelDepA]
readsPrec :: Int -> ReadS MsgProtectionLevelDepA
$creadsPrec :: Int -> ReadS MsgProtectionLevelDepA
Read, MsgProtectionLevelDepA -> MsgProtectionLevelDepA -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgProtectionLevelDepA -> MsgProtectionLevelDepA -> Bool
$c/= :: MsgProtectionLevelDepA -> MsgProtectionLevelDepA -> Bool
== :: MsgProtectionLevelDepA -> MsgProtectionLevelDepA -> Bool
$c== :: MsgProtectionLevelDepA -> MsgProtectionLevelDepA -> Bool
Eq )

instance Binary MsgProtectionLevelDepA where
  get :: Get MsgProtectionLevelDepA
get = do
    Word32
_msgProtectionLevelDepA_tow <- Get Word32
getWord32le
    Word16
_msgProtectionLevelDepA_vpl <- Get Word16
getWord16le
    Word16
_msgProtectionLevelDepA_hpl <- Get Word16
getWord16le
    Double
_msgProtectionLevelDepA_lat <- Get Double
getFloat64le
    Double
_msgProtectionLevelDepA_lon <- Get Double
getFloat64le
    Double
_msgProtectionLevelDepA_height <- Get Double
getFloat64le
    Word8
_msgProtectionLevelDepA_flags <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgProtectionLevelDepA {Double
Word8
Word16
Word32
_msgProtectionLevelDepA_flags :: Word8
_msgProtectionLevelDepA_height :: Double
_msgProtectionLevelDepA_lon :: Double
_msgProtectionLevelDepA_lat :: Double
_msgProtectionLevelDepA_hpl :: Word16
_msgProtectionLevelDepA_vpl :: Word16
_msgProtectionLevelDepA_tow :: Word32
_msgProtectionLevelDepA_flags :: Word8
_msgProtectionLevelDepA_height :: Double
_msgProtectionLevelDepA_lon :: Double
_msgProtectionLevelDepA_lat :: Double
_msgProtectionLevelDepA_hpl :: Word16
_msgProtectionLevelDepA_vpl :: Word16
_msgProtectionLevelDepA_tow :: Word32
..}

  put :: MsgProtectionLevelDepA -> Put
put MsgProtectionLevelDepA {Double
Word8
Word16
Word32
_msgProtectionLevelDepA_flags :: Word8
_msgProtectionLevelDepA_height :: Double
_msgProtectionLevelDepA_lon :: Double
_msgProtectionLevelDepA_lat :: Double
_msgProtectionLevelDepA_hpl :: Word16
_msgProtectionLevelDepA_vpl :: Word16
_msgProtectionLevelDepA_tow :: Word32
_msgProtectionLevelDepA_flags :: MsgProtectionLevelDepA -> Word8
_msgProtectionLevelDepA_height :: MsgProtectionLevelDepA -> Double
_msgProtectionLevelDepA_lon :: MsgProtectionLevelDepA -> Double
_msgProtectionLevelDepA_lat :: MsgProtectionLevelDepA -> Double
_msgProtectionLevelDepA_hpl :: MsgProtectionLevelDepA -> Word16
_msgProtectionLevelDepA_vpl :: MsgProtectionLevelDepA -> Word16
_msgProtectionLevelDepA_tow :: MsgProtectionLevelDepA -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgProtectionLevelDepA_tow
    Word16 -> Put
putWord16le Word16
_msgProtectionLevelDepA_vpl
    Word16 -> Put
putWord16le Word16
_msgProtectionLevelDepA_hpl
    Double -> Put
putFloat64le Double
_msgProtectionLevelDepA_lat
    Double -> Put
putFloat64le Double
_msgProtectionLevelDepA_lon
    Double -> Put
putFloat64le Double
_msgProtectionLevelDepA_height
    Word8 -> Put
putWord8 Word8
_msgProtectionLevelDepA_flags

$(makeSBP 'msgProtectionLevelDepA ''MsgProtectionLevelDepA)
$(makeJSON "_msgProtectionLevelDepA_" ''MsgProtectionLevelDepA)
$(makeLenses ''MsgProtectionLevelDepA)

msgProtectionLevel :: Word16
msgProtectionLevel :: Word16
msgProtectionLevel = Word16
0x0217

-- | SBP class for message MSG_PROTECTION_LEVEL (0x0217).
--
-- This message reports the protection levels associated to the given state
-- estimate. The full GPS time is given by the preceding MSG_GPS_TIME with the
-- matching time-of-week (tow).
data MsgProtectionLevel = MsgProtectionLevel
  { MsgProtectionLevel -> Word32
_msgProtectionLevel_tow   :: !Word32
    -- ^ GPS Time of Week
  , MsgProtectionLevel -> Int16
_msgProtectionLevel_wn    :: !Int16
    -- ^ GPS week number
  , MsgProtectionLevel -> Word16
_msgProtectionLevel_hpl   :: !Word16
    -- ^ Horizontal protection level
  , MsgProtectionLevel -> Word16
_msgProtectionLevel_vpl   :: !Word16
    -- ^ Vertical protection level
  , MsgProtectionLevel -> Word16
_msgProtectionLevel_atpl  :: !Word16
    -- ^ Along-track position error protection level
  , MsgProtectionLevel -> Word16
_msgProtectionLevel_ctpl  :: !Word16
    -- ^ Cross-track position error protection level
  , MsgProtectionLevel -> Word16
_msgProtectionLevel_hvpl  :: !Word16
    -- ^ Protection level for the error vector between estimated and true
    -- along/cross track velocity vector
  , MsgProtectionLevel -> Word16
_msgProtectionLevel_vvpl  :: !Word16
    -- ^ Protection level for the velocity in vehicle upright direction
    -- (different from vertical direction if on a slope)
  , MsgProtectionLevel -> Word16
_msgProtectionLevel_hopl  :: !Word16
    -- ^ Heading orientation protection level
  , MsgProtectionLevel -> Word16
_msgProtectionLevel_popl  :: !Word16
    -- ^ Pitch orientation protection level
  , MsgProtectionLevel -> Word16
_msgProtectionLevel_ropl  :: !Word16
    -- ^ Roll orientation protection level
  , MsgProtectionLevel -> Double
_msgProtectionLevel_lat   :: !Double
    -- ^ Latitude
  , MsgProtectionLevel -> Double
_msgProtectionLevel_lon   :: !Double
    -- ^ Longitude
  , MsgProtectionLevel -> Double
_msgProtectionLevel_height :: !Double
    -- ^ Height
  , MsgProtectionLevel -> Int32
_msgProtectionLevel_v_x   :: !Int32
    -- ^ Velocity in vehicle x direction
  , MsgProtectionLevel -> Int32
_msgProtectionLevel_v_y   :: !Int32
    -- ^ Velocity in vehicle y direction
  , MsgProtectionLevel -> Int32
_msgProtectionLevel_v_z   :: !Int32
    -- ^ Velocity in vehicle z direction
  , MsgProtectionLevel -> Int32
_msgProtectionLevel_roll  :: !Int32
    -- ^ Roll angle
  , MsgProtectionLevel -> Int32
_msgProtectionLevel_pitch :: !Int32
    -- ^ Pitch angle
  , MsgProtectionLevel -> Int32
_msgProtectionLevel_heading :: !Int32
    -- ^ Heading angle
  , MsgProtectionLevel -> Word32
_msgProtectionLevel_flags :: !Word32
    -- ^ Status flags
  } deriving ( Int -> MsgProtectionLevel -> ShowS
[MsgProtectionLevel] -> ShowS
MsgProtectionLevel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgProtectionLevel] -> ShowS
$cshowList :: [MsgProtectionLevel] -> ShowS
show :: MsgProtectionLevel -> String
$cshow :: MsgProtectionLevel -> String
showsPrec :: Int -> MsgProtectionLevel -> ShowS
$cshowsPrec :: Int -> MsgProtectionLevel -> ShowS
Show, ReadPrec [MsgProtectionLevel]
ReadPrec MsgProtectionLevel
Int -> ReadS MsgProtectionLevel
ReadS [MsgProtectionLevel]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgProtectionLevel]
$creadListPrec :: ReadPrec [MsgProtectionLevel]
readPrec :: ReadPrec MsgProtectionLevel
$creadPrec :: ReadPrec MsgProtectionLevel
readList :: ReadS [MsgProtectionLevel]
$creadList :: ReadS [MsgProtectionLevel]
readsPrec :: Int -> ReadS MsgProtectionLevel
$creadsPrec :: Int -> ReadS MsgProtectionLevel
Read, MsgProtectionLevel -> MsgProtectionLevel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgProtectionLevel -> MsgProtectionLevel -> Bool
$c/= :: MsgProtectionLevel -> MsgProtectionLevel -> Bool
== :: MsgProtectionLevel -> MsgProtectionLevel -> Bool
$c== :: MsgProtectionLevel -> MsgProtectionLevel -> Bool
Eq )

instance Binary MsgProtectionLevel where
  get :: Get MsgProtectionLevel
get = do
    Word32
_msgProtectionLevel_tow <- Get Word32
getWord32le
    Int16
_msgProtectionLevel_wn <- (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)
    Word16
_msgProtectionLevel_hpl <- Get Word16
getWord16le
    Word16
_msgProtectionLevel_vpl <- Get Word16
getWord16le
    Word16
_msgProtectionLevel_atpl <- Get Word16
getWord16le
    Word16
_msgProtectionLevel_ctpl <- Get Word16
getWord16le
    Word16
_msgProtectionLevel_hvpl <- Get Word16
getWord16le
    Word16
_msgProtectionLevel_vvpl <- Get Word16
getWord16le
    Word16
_msgProtectionLevel_hopl <- Get Word16
getWord16le
    Word16
_msgProtectionLevel_popl <- Get Word16
getWord16le
    Word16
_msgProtectionLevel_ropl <- Get Word16
getWord16le
    Double
_msgProtectionLevel_lat <- Get Double
getFloat64le
    Double
_msgProtectionLevel_lon <- Get Double
getFloat64le
    Double
_msgProtectionLevel_height <- Get Double
getFloat64le
    Int32
_msgProtectionLevel_v_x <- (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
_msgProtectionLevel_v_y <- (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
_msgProtectionLevel_v_z <- (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
_msgProtectionLevel_roll <- (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
_msgProtectionLevel_pitch <- (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
_msgProtectionLevel_heading <- (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)
    Word32
_msgProtectionLevel_flags <- Get Word32
getWord32le
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgProtectionLevel {Double
Int16
Int32
Word16
Word32
_msgProtectionLevel_flags :: Word32
_msgProtectionLevel_heading :: Int32
_msgProtectionLevel_pitch :: Int32
_msgProtectionLevel_roll :: Int32
_msgProtectionLevel_v_z :: Int32
_msgProtectionLevel_v_y :: Int32
_msgProtectionLevel_v_x :: Int32
_msgProtectionLevel_height :: Double
_msgProtectionLevel_lon :: Double
_msgProtectionLevel_lat :: Double
_msgProtectionLevel_ropl :: Word16
_msgProtectionLevel_popl :: Word16
_msgProtectionLevel_hopl :: Word16
_msgProtectionLevel_vvpl :: Word16
_msgProtectionLevel_hvpl :: Word16
_msgProtectionLevel_ctpl :: Word16
_msgProtectionLevel_atpl :: Word16
_msgProtectionLevel_vpl :: Word16
_msgProtectionLevel_hpl :: Word16
_msgProtectionLevel_wn :: Int16
_msgProtectionLevel_tow :: Word32
_msgProtectionLevel_flags :: Word32
_msgProtectionLevel_heading :: Int32
_msgProtectionLevel_pitch :: Int32
_msgProtectionLevel_roll :: Int32
_msgProtectionLevel_v_z :: Int32
_msgProtectionLevel_v_y :: Int32
_msgProtectionLevel_v_x :: Int32
_msgProtectionLevel_height :: Double
_msgProtectionLevel_lon :: Double
_msgProtectionLevel_lat :: Double
_msgProtectionLevel_ropl :: Word16
_msgProtectionLevel_popl :: Word16
_msgProtectionLevel_hopl :: Word16
_msgProtectionLevel_vvpl :: Word16
_msgProtectionLevel_hvpl :: Word16
_msgProtectionLevel_ctpl :: Word16
_msgProtectionLevel_atpl :: Word16
_msgProtectionLevel_vpl :: Word16
_msgProtectionLevel_hpl :: Word16
_msgProtectionLevel_wn :: Int16
_msgProtectionLevel_tow :: Word32
..}

  put :: MsgProtectionLevel -> Put
put MsgProtectionLevel {Double
Int16
Int32
Word16
Word32
_msgProtectionLevel_flags :: Word32
_msgProtectionLevel_heading :: Int32
_msgProtectionLevel_pitch :: Int32
_msgProtectionLevel_roll :: Int32
_msgProtectionLevel_v_z :: Int32
_msgProtectionLevel_v_y :: Int32
_msgProtectionLevel_v_x :: Int32
_msgProtectionLevel_height :: Double
_msgProtectionLevel_lon :: Double
_msgProtectionLevel_lat :: Double
_msgProtectionLevel_ropl :: Word16
_msgProtectionLevel_popl :: Word16
_msgProtectionLevel_hopl :: Word16
_msgProtectionLevel_vvpl :: Word16
_msgProtectionLevel_hvpl :: Word16
_msgProtectionLevel_ctpl :: Word16
_msgProtectionLevel_atpl :: Word16
_msgProtectionLevel_vpl :: Word16
_msgProtectionLevel_hpl :: Word16
_msgProtectionLevel_wn :: Int16
_msgProtectionLevel_tow :: Word32
_msgProtectionLevel_flags :: MsgProtectionLevel -> Word32
_msgProtectionLevel_heading :: MsgProtectionLevel -> Int32
_msgProtectionLevel_pitch :: MsgProtectionLevel -> Int32
_msgProtectionLevel_roll :: MsgProtectionLevel -> Int32
_msgProtectionLevel_v_z :: MsgProtectionLevel -> Int32
_msgProtectionLevel_v_y :: MsgProtectionLevel -> Int32
_msgProtectionLevel_v_x :: MsgProtectionLevel -> Int32
_msgProtectionLevel_height :: MsgProtectionLevel -> Double
_msgProtectionLevel_lon :: MsgProtectionLevel -> Double
_msgProtectionLevel_lat :: MsgProtectionLevel -> Double
_msgProtectionLevel_ropl :: MsgProtectionLevel -> Word16
_msgProtectionLevel_popl :: MsgProtectionLevel -> Word16
_msgProtectionLevel_hopl :: MsgProtectionLevel -> Word16
_msgProtectionLevel_vvpl :: MsgProtectionLevel -> Word16
_msgProtectionLevel_hvpl :: MsgProtectionLevel -> Word16
_msgProtectionLevel_ctpl :: MsgProtectionLevel -> Word16
_msgProtectionLevel_atpl :: MsgProtectionLevel -> Word16
_msgProtectionLevel_vpl :: MsgProtectionLevel -> Word16
_msgProtectionLevel_hpl :: MsgProtectionLevel -> Word16
_msgProtectionLevel_wn :: MsgProtectionLevel -> Int16
_msgProtectionLevel_tow :: MsgProtectionLevel -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgProtectionLevel_tow
    (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
_msgProtectionLevel_wn
    Word16 -> Put
putWord16le Word16
_msgProtectionLevel_hpl
    Word16 -> Put
putWord16le Word16
_msgProtectionLevel_vpl
    Word16 -> Put
putWord16le Word16
_msgProtectionLevel_atpl
    Word16 -> Put
putWord16le Word16
_msgProtectionLevel_ctpl
    Word16 -> Put
putWord16le Word16
_msgProtectionLevel_hvpl
    Word16 -> Put
putWord16le Word16
_msgProtectionLevel_vvpl
    Word16 -> Put
putWord16le Word16
_msgProtectionLevel_hopl
    Word16 -> Put
putWord16le Word16
_msgProtectionLevel_popl
    Word16 -> Put
putWord16le Word16
_msgProtectionLevel_ropl
    Double -> Put
putFloat64le Double
_msgProtectionLevel_lat
    Double -> Put
putFloat64le Double
_msgProtectionLevel_lon
    Double -> Put
putFloat64le Double
_msgProtectionLevel_height
    (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
_msgProtectionLevel_v_x
    (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
_msgProtectionLevel_v_y
    (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
_msgProtectionLevel_v_z
    (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
_msgProtectionLevel_roll
    (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
_msgProtectionLevel_pitch
    (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
_msgProtectionLevel_heading
    Word32 -> Put
putWord32le Word32
_msgProtectionLevel_flags

$(makeSBP 'msgProtectionLevel ''MsgProtectionLevel)
$(makeJSON "_msgProtectionLevel_" ''MsgProtectionLevel)
$(makeLenses ''MsgProtectionLevel)

msgUtcLeapSecond :: Word16
msgUtcLeapSecond :: Word16
msgUtcLeapSecond = Word16
0x023A

-- | SBP class for message MSG_UTC_LEAP_SECOND (0x023A).
--
-- UTC-GPST leap seconds before and after the most recent (past, or future,
-- for announced insertions) UTC leap second insertion.
data MsgUtcLeapSecond = MsgUtcLeapSecond
  { MsgUtcLeapSecond -> Int16
_msgUtcLeapSecond_reserved_0 :: !Int16
    -- ^ Reserved.
  , MsgUtcLeapSecond -> Int16
_msgUtcLeapSecond_reserved_1 :: !Int16
    -- ^ Reserved.
  , MsgUtcLeapSecond -> Int8
_msgUtcLeapSecond_reserved_2 :: !Int8
    -- ^ Reserved.
  , MsgUtcLeapSecond -> Int8
_msgUtcLeapSecond_count_before :: !Int8
    -- ^ Leap second count before insertion.
  , MsgUtcLeapSecond -> Word16
_msgUtcLeapSecond_reserved_3 :: !Word16
    -- ^ Reserved.
  , MsgUtcLeapSecond -> Word16
_msgUtcLeapSecond_reserved_4 :: !Word16
    -- ^ Reserved.
  , MsgUtcLeapSecond -> Word16
_msgUtcLeapSecond_ref_wn     :: !Word16
    -- ^ Leap second reference GPS week number.
  , MsgUtcLeapSecond -> Word8
_msgUtcLeapSecond_ref_dn     :: !Word8
    -- ^ Leap second reference day number.
  , MsgUtcLeapSecond -> Int8
_msgUtcLeapSecond_count_after :: !Int8
    -- ^ Leap second count after insertion.
  } deriving ( Int -> MsgUtcLeapSecond -> ShowS
[MsgUtcLeapSecond] -> ShowS
MsgUtcLeapSecond -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgUtcLeapSecond] -> ShowS
$cshowList :: [MsgUtcLeapSecond] -> ShowS
show :: MsgUtcLeapSecond -> String
$cshow :: MsgUtcLeapSecond -> String
showsPrec :: Int -> MsgUtcLeapSecond -> ShowS
$cshowsPrec :: Int -> MsgUtcLeapSecond -> ShowS
Show, ReadPrec [MsgUtcLeapSecond]
ReadPrec MsgUtcLeapSecond
Int -> ReadS MsgUtcLeapSecond
ReadS [MsgUtcLeapSecond]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgUtcLeapSecond]
$creadListPrec :: ReadPrec [MsgUtcLeapSecond]
readPrec :: ReadPrec MsgUtcLeapSecond
$creadPrec :: ReadPrec MsgUtcLeapSecond
readList :: ReadS [MsgUtcLeapSecond]
$creadList :: ReadS [MsgUtcLeapSecond]
readsPrec :: Int -> ReadS MsgUtcLeapSecond
$creadsPrec :: Int -> ReadS MsgUtcLeapSecond
Read, MsgUtcLeapSecond -> MsgUtcLeapSecond -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgUtcLeapSecond -> MsgUtcLeapSecond -> Bool
$c/= :: MsgUtcLeapSecond -> MsgUtcLeapSecond -> Bool
== :: MsgUtcLeapSecond -> MsgUtcLeapSecond -> Bool
$c== :: MsgUtcLeapSecond -> MsgUtcLeapSecond -> Bool
Eq )

instance Binary MsgUtcLeapSecond where
  get :: Get MsgUtcLeapSecond
get = do
    Int16
_msgUtcLeapSecond_reserved_0 <- (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
_msgUtcLeapSecond_reserved_1 <- (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)
    Int8
_msgUtcLeapSecond_reserved_2 <- (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
_msgUtcLeapSecond_count_before <- (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)
    Word16
_msgUtcLeapSecond_reserved_3 <- Get Word16
getWord16le
    Word16
_msgUtcLeapSecond_reserved_4 <- Get Word16
getWord16le
    Word16
_msgUtcLeapSecond_ref_wn <- Get Word16
getWord16le
    Word8
_msgUtcLeapSecond_ref_dn <- Get Word8
getWord8
    Int8
_msgUtcLeapSecond_count_after <- (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 MsgUtcLeapSecond {Int8
Int16
Word8
Word16
_msgUtcLeapSecond_count_after :: Int8
_msgUtcLeapSecond_ref_dn :: Word8
_msgUtcLeapSecond_ref_wn :: Word16
_msgUtcLeapSecond_reserved_4 :: Word16
_msgUtcLeapSecond_reserved_3 :: Word16
_msgUtcLeapSecond_count_before :: Int8
_msgUtcLeapSecond_reserved_2 :: Int8
_msgUtcLeapSecond_reserved_1 :: Int16
_msgUtcLeapSecond_reserved_0 :: Int16
_msgUtcLeapSecond_count_after :: Int8
_msgUtcLeapSecond_ref_dn :: Word8
_msgUtcLeapSecond_ref_wn :: Word16
_msgUtcLeapSecond_reserved_4 :: Word16
_msgUtcLeapSecond_reserved_3 :: Word16
_msgUtcLeapSecond_count_before :: Int8
_msgUtcLeapSecond_reserved_2 :: Int8
_msgUtcLeapSecond_reserved_1 :: Int16
_msgUtcLeapSecond_reserved_0 :: Int16
..}

  put :: MsgUtcLeapSecond -> Put
put MsgUtcLeapSecond {Int8
Int16
Word8
Word16
_msgUtcLeapSecond_count_after :: Int8
_msgUtcLeapSecond_ref_dn :: Word8
_msgUtcLeapSecond_ref_wn :: Word16
_msgUtcLeapSecond_reserved_4 :: Word16
_msgUtcLeapSecond_reserved_3 :: Word16
_msgUtcLeapSecond_count_before :: Int8
_msgUtcLeapSecond_reserved_2 :: Int8
_msgUtcLeapSecond_reserved_1 :: Int16
_msgUtcLeapSecond_reserved_0 :: Int16
_msgUtcLeapSecond_count_after :: MsgUtcLeapSecond -> Int8
_msgUtcLeapSecond_ref_dn :: MsgUtcLeapSecond -> Word8
_msgUtcLeapSecond_ref_wn :: MsgUtcLeapSecond -> Word16
_msgUtcLeapSecond_reserved_4 :: MsgUtcLeapSecond -> Word16
_msgUtcLeapSecond_reserved_3 :: MsgUtcLeapSecond -> Word16
_msgUtcLeapSecond_count_before :: MsgUtcLeapSecond -> Int8
_msgUtcLeapSecond_reserved_2 :: MsgUtcLeapSecond -> Int8
_msgUtcLeapSecond_reserved_1 :: MsgUtcLeapSecond -> Int16
_msgUtcLeapSecond_reserved_0 :: MsgUtcLeapSecond -> 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
_msgUtcLeapSecond_reserved_0
    (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
_msgUtcLeapSecond_reserved_1
    (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
_msgUtcLeapSecond_reserved_2
    (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
_msgUtcLeapSecond_count_before
    Word16 -> Put
putWord16le Word16
_msgUtcLeapSecond_reserved_3
    Word16 -> Put
putWord16le Word16
_msgUtcLeapSecond_reserved_4
    Word16 -> Put
putWord16le Word16
_msgUtcLeapSecond_ref_wn
    Word8 -> Put
putWord8 Word8
_msgUtcLeapSecond_ref_dn
    (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
_msgUtcLeapSecond_count_after

$(makeSBP 'msgUtcLeapSecond ''MsgUtcLeapSecond)
$(makeJSON "_msgUtcLeapSecond_" ''MsgUtcLeapSecond)
$(makeLenses ''MsgUtcLeapSecond)

msgReferenceFrameParam :: Word16
msgReferenceFrameParam :: Word16
msgReferenceFrameParam = Word16
0x0244

data MsgReferenceFrameParam = MsgReferenceFrameParam
  { MsgReferenceFrameParam -> Word8
_msgReferenceFrameParam_ssr_iod    :: !Word8
    -- ^ SSR IOD parameter.
  , MsgReferenceFrameParam -> Text
_msgReferenceFrameParam_sn         :: !Text
    -- ^ Name of source coordinate-system.
  , MsgReferenceFrameParam -> Text
_msgReferenceFrameParam_tn         :: !Text
    -- ^ Name of target coordinate-system.
  , MsgReferenceFrameParam -> Word8
_msgReferenceFrameParam_sin        :: !Word8
    -- ^ System Identification Number.
  , MsgReferenceFrameParam -> Word16
_msgReferenceFrameParam_utn        :: !Word16
    -- ^ Utilized Transformation Message.
  , MsgReferenceFrameParam -> Word16
_msgReferenceFrameParam_re_t0      :: !Word16
    -- ^ Reference Epoch t0 for transformation parameter set given as Modified
    -- Julian Day (MJD) Number minus 44244 days.
  , MsgReferenceFrameParam -> Int32
_msgReferenceFrameParam_delta_X0   :: !Int32
    -- ^ Translation in X for Reference Epoch t0.
  , MsgReferenceFrameParam -> Int32
_msgReferenceFrameParam_delta_Y0   :: !Int32
    -- ^ Translation in Y for Reference Epoch t0.
  , MsgReferenceFrameParam -> Int32
_msgReferenceFrameParam_delta_Z0   :: !Int32
    -- ^ Translation in Z for Reference Epoch t0.
  , MsgReferenceFrameParam -> Int32
_msgReferenceFrameParam_theta_01   :: !Int32
    -- ^ Rotation around the X-axis for Reference Epoch t0.
  , MsgReferenceFrameParam -> Int32
_msgReferenceFrameParam_theta_02   :: !Int32
    -- ^ Rotation around the Y-axis for Reference Epoch t0.
  , MsgReferenceFrameParam -> Int32
_msgReferenceFrameParam_theta_03   :: !Int32
    -- ^ Rotation around the Z-axis for Reference Epoch t0.
  , MsgReferenceFrameParam -> Int32
_msgReferenceFrameParam_scale      :: !Int32
    -- ^ Scale correction for Reference Epoch t0.
  , MsgReferenceFrameParam -> Int32
_msgReferenceFrameParam_dot_delta_X0 :: !Int32
    -- ^ Rate of change of translation in X.
  , MsgReferenceFrameParam -> Int32
_msgReferenceFrameParam_dot_delta_Y0 :: !Int32
    -- ^ Rate of change of translation in Y.
  , MsgReferenceFrameParam -> Int32
_msgReferenceFrameParam_dot_delta_Z0 :: !Int32
    -- ^ Rate of change of translation in Z.
  , MsgReferenceFrameParam -> Int32
_msgReferenceFrameParam_dot_theta_01 :: !Int32
    -- ^ Rate of change of rotation around the X-axis.
  , MsgReferenceFrameParam -> Int32
_msgReferenceFrameParam_dot_theta_02 :: !Int32
    -- ^ Rate of change of rotation around the Y-axis.
  , MsgReferenceFrameParam -> Int32
_msgReferenceFrameParam_dot_theta_03 :: !Int32
    -- ^ Rate of change of rotation around the Z-axis.
  , MsgReferenceFrameParam -> Int16
_msgReferenceFrameParam_dot_scale  :: !Int16
    -- ^ Rate of change of scale correction.
  } deriving ( Int -> MsgReferenceFrameParam -> ShowS
[MsgReferenceFrameParam] -> ShowS
MsgReferenceFrameParam -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgReferenceFrameParam] -> ShowS
$cshowList :: [MsgReferenceFrameParam] -> ShowS
show :: MsgReferenceFrameParam -> String
$cshow :: MsgReferenceFrameParam -> String
showsPrec :: Int -> MsgReferenceFrameParam -> ShowS
$cshowsPrec :: Int -> MsgReferenceFrameParam -> ShowS
Show, ReadPrec [MsgReferenceFrameParam]
ReadPrec MsgReferenceFrameParam
Int -> ReadS MsgReferenceFrameParam
ReadS [MsgReferenceFrameParam]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgReferenceFrameParam]
$creadListPrec :: ReadPrec [MsgReferenceFrameParam]
readPrec :: ReadPrec MsgReferenceFrameParam
$creadPrec :: ReadPrec MsgReferenceFrameParam
readList :: ReadS [MsgReferenceFrameParam]
$creadList :: ReadS [MsgReferenceFrameParam]
readsPrec :: Int -> ReadS MsgReferenceFrameParam
$creadsPrec :: Int -> ReadS MsgReferenceFrameParam
Read, MsgReferenceFrameParam -> MsgReferenceFrameParam -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgReferenceFrameParam -> MsgReferenceFrameParam -> Bool
$c/= :: MsgReferenceFrameParam -> MsgReferenceFrameParam -> Bool
== :: MsgReferenceFrameParam -> MsgReferenceFrameParam -> Bool
$c== :: MsgReferenceFrameParam -> MsgReferenceFrameParam -> Bool
Eq )

instance Binary MsgReferenceFrameParam where
  get :: Get MsgReferenceFrameParam
get = do
    Word8
_msgReferenceFrameParam_ssr_iod <- Get Word8
getWord8
    Text
_msgReferenceFrameParam_sn <- ByteString -> Text
decodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
32
    Text
_msgReferenceFrameParam_tn <- ByteString -> Text
decodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
32
    Word8
_msgReferenceFrameParam_sin <- Get Word8
getWord8
    Word16
_msgReferenceFrameParam_utn <- Get Word16
getWord16le
    Word16
_msgReferenceFrameParam_re_t0 <- Get Word16
getWord16le
    Int32
_msgReferenceFrameParam_delta_X0 <- (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
_msgReferenceFrameParam_delta_Y0 <- (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
_msgReferenceFrameParam_delta_Z0 <- (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
_msgReferenceFrameParam_theta_01 <- (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
_msgReferenceFrameParam_theta_02 <- (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
_msgReferenceFrameParam_theta_03 <- (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
_msgReferenceFrameParam_scale <- (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
_msgReferenceFrameParam_dot_delta_X0 <- (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
_msgReferenceFrameParam_dot_delta_Y0 <- (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
_msgReferenceFrameParam_dot_delta_Z0 <- (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
_msgReferenceFrameParam_dot_theta_01 <- (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
_msgReferenceFrameParam_dot_theta_02 <- (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
_msgReferenceFrameParam_dot_theta_03 <- (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
_msgReferenceFrameParam_dot_scale <- (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 MsgReferenceFrameParam {Int16
Int32
Word8
Word16
Text
_msgReferenceFrameParam_dot_scale :: Int16
_msgReferenceFrameParam_dot_theta_03 :: Int32
_msgReferenceFrameParam_dot_theta_02 :: Int32
_msgReferenceFrameParam_dot_theta_01 :: Int32
_msgReferenceFrameParam_dot_delta_Z0 :: Int32
_msgReferenceFrameParam_dot_delta_Y0 :: Int32
_msgReferenceFrameParam_dot_delta_X0 :: Int32
_msgReferenceFrameParam_scale :: Int32
_msgReferenceFrameParam_theta_03 :: Int32
_msgReferenceFrameParam_theta_02 :: Int32
_msgReferenceFrameParam_theta_01 :: Int32
_msgReferenceFrameParam_delta_Z0 :: Int32
_msgReferenceFrameParam_delta_Y0 :: Int32
_msgReferenceFrameParam_delta_X0 :: Int32
_msgReferenceFrameParam_re_t0 :: Word16
_msgReferenceFrameParam_utn :: Word16
_msgReferenceFrameParam_sin :: Word8
_msgReferenceFrameParam_tn :: Text
_msgReferenceFrameParam_sn :: Text
_msgReferenceFrameParam_ssr_iod :: Word8
_msgReferenceFrameParam_dot_scale :: Int16
_msgReferenceFrameParam_dot_theta_03 :: Int32
_msgReferenceFrameParam_dot_theta_02 :: Int32
_msgReferenceFrameParam_dot_theta_01 :: Int32
_msgReferenceFrameParam_dot_delta_Z0 :: Int32
_msgReferenceFrameParam_dot_delta_Y0 :: Int32
_msgReferenceFrameParam_dot_delta_X0 :: Int32
_msgReferenceFrameParam_scale :: Int32
_msgReferenceFrameParam_theta_03 :: Int32
_msgReferenceFrameParam_theta_02 :: Int32
_msgReferenceFrameParam_theta_01 :: Int32
_msgReferenceFrameParam_delta_Z0 :: Int32
_msgReferenceFrameParam_delta_Y0 :: Int32
_msgReferenceFrameParam_delta_X0 :: Int32
_msgReferenceFrameParam_re_t0 :: Word16
_msgReferenceFrameParam_utn :: Word16
_msgReferenceFrameParam_sin :: Word8
_msgReferenceFrameParam_tn :: Text
_msgReferenceFrameParam_sn :: Text
_msgReferenceFrameParam_ssr_iod :: Word8
..}

  put :: MsgReferenceFrameParam -> Put
put MsgReferenceFrameParam {Int16
Int32
Word8
Word16
Text
_msgReferenceFrameParam_dot_scale :: Int16
_msgReferenceFrameParam_dot_theta_03 :: Int32
_msgReferenceFrameParam_dot_theta_02 :: Int32
_msgReferenceFrameParam_dot_theta_01 :: Int32
_msgReferenceFrameParam_dot_delta_Z0 :: Int32
_msgReferenceFrameParam_dot_delta_Y0 :: Int32
_msgReferenceFrameParam_dot_delta_X0 :: Int32
_msgReferenceFrameParam_scale :: Int32
_msgReferenceFrameParam_theta_03 :: Int32
_msgReferenceFrameParam_theta_02 :: Int32
_msgReferenceFrameParam_theta_01 :: Int32
_msgReferenceFrameParam_delta_Z0 :: Int32
_msgReferenceFrameParam_delta_Y0 :: Int32
_msgReferenceFrameParam_delta_X0 :: Int32
_msgReferenceFrameParam_re_t0 :: Word16
_msgReferenceFrameParam_utn :: Word16
_msgReferenceFrameParam_sin :: Word8
_msgReferenceFrameParam_tn :: Text
_msgReferenceFrameParam_sn :: Text
_msgReferenceFrameParam_ssr_iod :: Word8
_msgReferenceFrameParam_dot_scale :: MsgReferenceFrameParam -> Int16
_msgReferenceFrameParam_dot_theta_03 :: MsgReferenceFrameParam -> Int32
_msgReferenceFrameParam_dot_theta_02 :: MsgReferenceFrameParam -> Int32
_msgReferenceFrameParam_dot_theta_01 :: MsgReferenceFrameParam -> Int32
_msgReferenceFrameParam_dot_delta_Z0 :: MsgReferenceFrameParam -> Int32
_msgReferenceFrameParam_dot_delta_Y0 :: MsgReferenceFrameParam -> Int32
_msgReferenceFrameParam_dot_delta_X0 :: MsgReferenceFrameParam -> Int32
_msgReferenceFrameParam_scale :: MsgReferenceFrameParam -> Int32
_msgReferenceFrameParam_theta_03 :: MsgReferenceFrameParam -> Int32
_msgReferenceFrameParam_theta_02 :: MsgReferenceFrameParam -> Int32
_msgReferenceFrameParam_theta_01 :: MsgReferenceFrameParam -> Int32
_msgReferenceFrameParam_delta_Z0 :: MsgReferenceFrameParam -> Int32
_msgReferenceFrameParam_delta_Y0 :: MsgReferenceFrameParam -> Int32
_msgReferenceFrameParam_delta_X0 :: MsgReferenceFrameParam -> Int32
_msgReferenceFrameParam_re_t0 :: MsgReferenceFrameParam -> Word16
_msgReferenceFrameParam_utn :: MsgReferenceFrameParam -> Word16
_msgReferenceFrameParam_sin :: MsgReferenceFrameParam -> Word8
_msgReferenceFrameParam_tn :: MsgReferenceFrameParam -> Text
_msgReferenceFrameParam_sn :: MsgReferenceFrameParam -> Text
_msgReferenceFrameParam_ssr_iod :: MsgReferenceFrameParam -> Word8
..} = do
    Word8 -> Put
putWord8 Word8
_msgReferenceFrameParam_ssr_iod
    ByteString -> Put
putByteString forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
_msgReferenceFrameParam_sn
    ByteString -> Put
putByteString forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
_msgReferenceFrameParam_tn
    Word8 -> Put
putWord8 Word8
_msgReferenceFrameParam_sin
    Word16 -> Put
putWord16le Word16
_msgReferenceFrameParam_utn
    Word16 -> Put
putWord16le Word16
_msgReferenceFrameParam_re_t0
    (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
_msgReferenceFrameParam_delta_X0
    (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
_msgReferenceFrameParam_delta_Y0
    (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
_msgReferenceFrameParam_delta_Z0
    (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
_msgReferenceFrameParam_theta_01
    (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
_msgReferenceFrameParam_theta_02
    (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
_msgReferenceFrameParam_theta_03
    (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
_msgReferenceFrameParam_scale
    (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
_msgReferenceFrameParam_dot_delta_X0
    (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
_msgReferenceFrameParam_dot_delta_Y0
    (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
_msgReferenceFrameParam_dot_delta_Z0
    (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
_msgReferenceFrameParam_dot_theta_01
    (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
_msgReferenceFrameParam_dot_theta_02
    (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
_msgReferenceFrameParam_dot_theta_03
    (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
_msgReferenceFrameParam_dot_scale

$(makeSBP 'msgReferenceFrameParam ''MsgReferenceFrameParam)
$(makeJSON "_msgReferenceFrameParam_" ''MsgReferenceFrameParam)
$(makeLenses ''MsgReferenceFrameParam)