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

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

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


-- | SolutionInputType.
--
-- Metadata describing which sensors were involved in the solution. The
-- structure is fixed no matter what the actual sensor type is. The
-- sensor_type field tells you which sensor we are talking about. It also
-- tells you whether the sensor data was actually used or not. The flags
-- field, always a u8, contains the sensor-specific data. The content of
-- flags, for each sensor type, is described in the relevant structures in
-- this section.
data SolutionInputType = SolutionInputType
  { SolutionInputType -> Word8
_solutionInputType_sensor_type :: !Word8
    -- ^ The type of sensor
  , SolutionInputType -> Word8
_solutionInputType_flags     :: !Word8
    -- ^ Refer to each InputType description
  } deriving ( Int -> SolutionInputType -> ShowS
[SolutionInputType] -> ShowS
SolutionInputType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SolutionInputType] -> ShowS
$cshowList :: [SolutionInputType] -> ShowS
show :: SolutionInputType -> String
$cshow :: SolutionInputType -> String
showsPrec :: Int -> SolutionInputType -> ShowS
$cshowsPrec :: Int -> SolutionInputType -> ShowS
Show, ReadPrec [SolutionInputType]
ReadPrec SolutionInputType
Int -> ReadS SolutionInputType
ReadS [SolutionInputType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SolutionInputType]
$creadListPrec :: ReadPrec [SolutionInputType]
readPrec :: ReadPrec SolutionInputType
$creadPrec :: ReadPrec SolutionInputType
readList :: ReadS [SolutionInputType]
$creadList :: ReadS [SolutionInputType]
readsPrec :: Int -> ReadS SolutionInputType
$creadsPrec :: Int -> ReadS SolutionInputType
Read, SolutionInputType -> SolutionInputType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SolutionInputType -> SolutionInputType -> Bool
$c/= :: SolutionInputType -> SolutionInputType -> Bool
== :: SolutionInputType -> SolutionInputType -> Bool
$c== :: SolutionInputType -> SolutionInputType -> Bool
Eq )

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

  put :: SolutionInputType -> Put
put SolutionInputType {Word8
_solutionInputType_flags :: Word8
_solutionInputType_sensor_type :: Word8
_solutionInputType_flags :: SolutionInputType -> Word8
_solutionInputType_sensor_type :: SolutionInputType -> Word8
..} = do
    Word8 -> Put
putWord8 Word8
_solutionInputType_sensor_type
    Word8 -> Put
putWord8 Word8
_solutionInputType_flags

$(makeJSON "_solutionInputType_" ''SolutionInputType)
$(makeLenses ''SolutionInputType)

msgSolnMetaDepA :: Word16
msgSolnMetaDepA :: Word16
msgSolnMetaDepA = Word16
0xFF0F

-- | SBP class for message MSG_SOLN_META_DEP_A (0xFF0F).
--
-- Deprecated.
--
-- This message contains all metadata about the sensors received and/or used
-- in computing the Fuzed Solution. It focuses primarily, but not only, on
-- GNSS metadata.
data MsgSolnMetaDepA = MsgSolnMetaDepA
  { MsgSolnMetaDepA -> Word16
_msgSolnMetaDepA_pdop                 :: !Word16
    -- ^ Position Dilution of Precision as per last available DOPS from PVT
    -- engine (0xFFFF indicates invalid)
  , MsgSolnMetaDepA -> Word16
_msgSolnMetaDepA_hdop                 :: !Word16
    -- ^ Horizontal Dilution of Precision as per last available DOPS from PVT
    -- engine (0xFFFF indicates invalid)
  , MsgSolnMetaDepA -> Word16
_msgSolnMetaDepA_vdop                 :: !Word16
    -- ^ Vertical Dilution of Precision as per last available DOPS from PVT
    -- engine (0xFFFF indicates invalid)
  , MsgSolnMetaDepA -> Word8
_msgSolnMetaDepA_n_sats               :: !Word8
    -- ^ Number of satellites as per last available solution from PVT engine
  , MsgSolnMetaDepA -> Word16
_msgSolnMetaDepA_age_corrections      :: !Word16
    -- ^ Age of corrections as per last available AGE_CORRECTIONS from PVT
    -- engine (0xFFFF indicates invalid)
  , MsgSolnMetaDepA -> Word8
_msgSolnMetaDepA_alignment_status     :: !Word8
    -- ^ State of alignment and the status and receipt of the alignment inputs
  , MsgSolnMetaDepA -> Word32
_msgSolnMetaDepA_last_used_gnss_pos_tow :: !Word32
    -- ^ Tow of last-used GNSS position measurement
  , MsgSolnMetaDepA -> Word32
_msgSolnMetaDepA_last_used_gnss_vel_tow :: !Word32
    -- ^ Tow of last-used GNSS velocity measurement
  , MsgSolnMetaDepA -> [SolutionInputType]
_msgSolnMetaDepA_sol_in               :: ![SolutionInputType]
    -- ^ Array of Metadata describing the sensors potentially involved in the
    -- solution. Each element in the array represents a single sensor type and
    -- consists of flags containing (meta)data pertaining to that specific
    -- single sensor. Refer to each (XX)InputType descriptor in the present
    -- doc.
  } deriving ( Int -> MsgSolnMetaDepA -> ShowS
[MsgSolnMetaDepA] -> ShowS
MsgSolnMetaDepA -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgSolnMetaDepA] -> ShowS
$cshowList :: [MsgSolnMetaDepA] -> ShowS
show :: MsgSolnMetaDepA -> String
$cshow :: MsgSolnMetaDepA -> String
showsPrec :: Int -> MsgSolnMetaDepA -> ShowS
$cshowsPrec :: Int -> MsgSolnMetaDepA -> ShowS
Show, ReadPrec [MsgSolnMetaDepA]
ReadPrec MsgSolnMetaDepA
Int -> ReadS MsgSolnMetaDepA
ReadS [MsgSolnMetaDepA]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgSolnMetaDepA]
$creadListPrec :: ReadPrec [MsgSolnMetaDepA]
readPrec :: ReadPrec MsgSolnMetaDepA
$creadPrec :: ReadPrec MsgSolnMetaDepA
readList :: ReadS [MsgSolnMetaDepA]
$creadList :: ReadS [MsgSolnMetaDepA]
readsPrec :: Int -> ReadS MsgSolnMetaDepA
$creadsPrec :: Int -> ReadS MsgSolnMetaDepA
Read, MsgSolnMetaDepA -> MsgSolnMetaDepA -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgSolnMetaDepA -> MsgSolnMetaDepA -> Bool
$c/= :: MsgSolnMetaDepA -> MsgSolnMetaDepA -> Bool
== :: MsgSolnMetaDepA -> MsgSolnMetaDepA -> Bool
$c== :: MsgSolnMetaDepA -> MsgSolnMetaDepA -> Bool
Eq )

instance Binary MsgSolnMetaDepA where
  get :: Get MsgSolnMetaDepA
get = do
    Word16
_msgSolnMetaDepA_pdop <- Get Word16
getWord16le
    Word16
_msgSolnMetaDepA_hdop <- Get Word16
getWord16le
    Word16
_msgSolnMetaDepA_vdop <- Get Word16
getWord16le
    Word8
_msgSolnMetaDepA_n_sats <- Get Word8
getWord8
    Word16
_msgSolnMetaDepA_age_corrections <- Get Word16
getWord16le
    Word8
_msgSolnMetaDepA_alignment_status <- Get Word8
getWord8
    Word32
_msgSolnMetaDepA_last_used_gnss_pos_tow <- Get Word32
getWord32le
    Word32
_msgSolnMetaDepA_last_used_gnss_vel_tow <- Get Word32
getWord32le
    [SolutionInputType]
_msgSolnMetaDepA_sol_in <- forall (m :: * -> *) a. Monad m => m Bool -> m a -> m [a]
whileM (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool
isEmpty) forall t. Binary t => Get t
get
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgSolnMetaDepA {[SolutionInputType]
Word8
Word16
Word32
_msgSolnMetaDepA_sol_in :: [SolutionInputType]
_msgSolnMetaDepA_last_used_gnss_vel_tow :: Word32
_msgSolnMetaDepA_last_used_gnss_pos_tow :: Word32
_msgSolnMetaDepA_alignment_status :: Word8
_msgSolnMetaDepA_age_corrections :: Word16
_msgSolnMetaDepA_n_sats :: Word8
_msgSolnMetaDepA_vdop :: Word16
_msgSolnMetaDepA_hdop :: Word16
_msgSolnMetaDepA_pdop :: Word16
_msgSolnMetaDepA_sol_in :: [SolutionInputType]
_msgSolnMetaDepA_last_used_gnss_vel_tow :: Word32
_msgSolnMetaDepA_last_used_gnss_pos_tow :: Word32
_msgSolnMetaDepA_alignment_status :: Word8
_msgSolnMetaDepA_age_corrections :: Word16
_msgSolnMetaDepA_n_sats :: Word8
_msgSolnMetaDepA_vdop :: Word16
_msgSolnMetaDepA_hdop :: Word16
_msgSolnMetaDepA_pdop :: Word16
..}

  put :: MsgSolnMetaDepA -> Put
put MsgSolnMetaDepA {[SolutionInputType]
Word8
Word16
Word32
_msgSolnMetaDepA_sol_in :: [SolutionInputType]
_msgSolnMetaDepA_last_used_gnss_vel_tow :: Word32
_msgSolnMetaDepA_last_used_gnss_pos_tow :: Word32
_msgSolnMetaDepA_alignment_status :: Word8
_msgSolnMetaDepA_age_corrections :: Word16
_msgSolnMetaDepA_n_sats :: Word8
_msgSolnMetaDepA_vdop :: Word16
_msgSolnMetaDepA_hdop :: Word16
_msgSolnMetaDepA_pdop :: Word16
_msgSolnMetaDepA_sol_in :: MsgSolnMetaDepA -> [SolutionInputType]
_msgSolnMetaDepA_last_used_gnss_vel_tow :: MsgSolnMetaDepA -> Word32
_msgSolnMetaDepA_last_used_gnss_pos_tow :: MsgSolnMetaDepA -> Word32
_msgSolnMetaDepA_alignment_status :: MsgSolnMetaDepA -> Word8
_msgSolnMetaDepA_age_corrections :: MsgSolnMetaDepA -> Word16
_msgSolnMetaDepA_n_sats :: MsgSolnMetaDepA -> Word8
_msgSolnMetaDepA_vdop :: MsgSolnMetaDepA -> Word16
_msgSolnMetaDepA_hdop :: MsgSolnMetaDepA -> Word16
_msgSolnMetaDepA_pdop :: MsgSolnMetaDepA -> Word16
..} = do
    Word16 -> Put
putWord16le Word16
_msgSolnMetaDepA_pdop
    Word16 -> Put
putWord16le Word16
_msgSolnMetaDepA_hdop
    Word16 -> Put
putWord16le Word16
_msgSolnMetaDepA_vdop
    Word8 -> Put
putWord8 Word8
_msgSolnMetaDepA_n_sats
    Word16 -> Put
putWord16le Word16
_msgSolnMetaDepA_age_corrections
    Word8 -> Put
putWord8 Word8
_msgSolnMetaDepA_alignment_status
    Word32 -> Put
putWord32le Word32
_msgSolnMetaDepA_last_used_gnss_pos_tow
    Word32 -> Put
putWord32le Word32
_msgSolnMetaDepA_last_used_gnss_vel_tow
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall t. Binary t => t -> Put
put [SolutionInputType]
_msgSolnMetaDepA_sol_in

$(makeSBP 'msgSolnMetaDepA ''MsgSolnMetaDepA)
$(makeJSON "_msgSolnMetaDepA_" ''MsgSolnMetaDepA)
$(makeLenses ''MsgSolnMetaDepA)

msgSolnMeta :: Word16
msgSolnMeta :: Word16
msgSolnMeta = Word16
0xFF0E

-- | SBP class for message MSG_SOLN_META (0xFF0E).
--
-- This message contains all metadata about the sensors received and/or used
-- in computing the sensorfusion solution. It focuses primarily, but not only,
-- on GNSS metadata. Regarding the age of the last received valid GNSS
-- solution, the highest two bits are time status, indicating whether age gnss
-- can or can not be used to retrieve time of measurement (noted TOM, also
-- known as time of validity) If it can, subtract 'age gnss' from 'tow' in
-- navigation messages to get TOM. Can be used before alignment is complete in
-- the Fusion Engine, when output solution is the last received valid GNSS
-- solution and its tow is not a TOM.
data MsgSolnMeta = MsgSolnMeta
  { MsgSolnMeta -> Word32
_msgSolnMeta_tow           :: !Word32
    -- ^ GPS time of week rounded to the nearest millisecond
  , MsgSolnMeta -> Word16
_msgSolnMeta_pdop          :: !Word16
    -- ^ Position Dilution of Precision as per last available DOPS from PVT
    -- engine (0xFFFF indicates invalid)
  , MsgSolnMeta -> Word16
_msgSolnMeta_hdop          :: !Word16
    -- ^ Horizontal Dilution of Precision as per last available DOPS from PVT
    -- engine (0xFFFF indicates invalid)
  , MsgSolnMeta -> Word16
_msgSolnMeta_vdop          :: !Word16
    -- ^ Vertical Dilution of Precision as per last available DOPS from PVT
    -- engine (0xFFFF indicates invalid)
  , MsgSolnMeta -> Word16
_msgSolnMeta_age_corrections :: !Word16
    -- ^ Age of corrections as per last available AGE_CORRECTIONS from PVT
    -- engine (0xFFFF indicates invalid)
  , MsgSolnMeta -> Word32
_msgSolnMeta_age_gnss      :: !Word32
    -- ^ Age and Time Status of the last received valid GNSS solution.
  , MsgSolnMeta -> [SolutionInputType]
_msgSolnMeta_sol_in        :: ![SolutionInputType]
    -- ^ Array of Metadata describing the sensors potentially involved in the
    -- solution. Each element in the array represents a single sensor type and
    -- consists of flags containing (meta)data pertaining to that specific
    -- single sensor. Refer to each (XX)InputType descriptor in the present
    -- doc.
  } deriving ( Int -> MsgSolnMeta -> ShowS
[MsgSolnMeta] -> ShowS
MsgSolnMeta -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgSolnMeta] -> ShowS
$cshowList :: [MsgSolnMeta] -> ShowS
show :: MsgSolnMeta -> String
$cshow :: MsgSolnMeta -> String
showsPrec :: Int -> MsgSolnMeta -> ShowS
$cshowsPrec :: Int -> MsgSolnMeta -> ShowS
Show, ReadPrec [MsgSolnMeta]
ReadPrec MsgSolnMeta
Int -> ReadS MsgSolnMeta
ReadS [MsgSolnMeta]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgSolnMeta]
$creadListPrec :: ReadPrec [MsgSolnMeta]
readPrec :: ReadPrec MsgSolnMeta
$creadPrec :: ReadPrec MsgSolnMeta
readList :: ReadS [MsgSolnMeta]
$creadList :: ReadS [MsgSolnMeta]
readsPrec :: Int -> ReadS MsgSolnMeta
$creadsPrec :: Int -> ReadS MsgSolnMeta
Read, MsgSolnMeta -> MsgSolnMeta -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgSolnMeta -> MsgSolnMeta -> Bool
$c/= :: MsgSolnMeta -> MsgSolnMeta -> Bool
== :: MsgSolnMeta -> MsgSolnMeta -> Bool
$c== :: MsgSolnMeta -> MsgSolnMeta -> Bool
Eq )

instance Binary MsgSolnMeta where
  get :: Get MsgSolnMeta
get = do
    Word32
_msgSolnMeta_tow <- Get Word32
getWord32le
    Word16
_msgSolnMeta_pdop <- Get Word16
getWord16le
    Word16
_msgSolnMeta_hdop <- Get Word16
getWord16le
    Word16
_msgSolnMeta_vdop <- Get Word16
getWord16le
    Word16
_msgSolnMeta_age_corrections <- Get Word16
getWord16le
    Word32
_msgSolnMeta_age_gnss <- Get Word32
getWord32le
    [SolutionInputType]
_msgSolnMeta_sol_in <- forall (m :: * -> *) a. Monad m => m Bool -> m a -> m [a]
whileM (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool
isEmpty) forall t. Binary t => Get t
get
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgSolnMeta {[SolutionInputType]
Word16
Word32
_msgSolnMeta_sol_in :: [SolutionInputType]
_msgSolnMeta_age_gnss :: Word32
_msgSolnMeta_age_corrections :: Word16
_msgSolnMeta_vdop :: Word16
_msgSolnMeta_hdop :: Word16
_msgSolnMeta_pdop :: Word16
_msgSolnMeta_tow :: Word32
_msgSolnMeta_sol_in :: [SolutionInputType]
_msgSolnMeta_age_gnss :: Word32
_msgSolnMeta_age_corrections :: Word16
_msgSolnMeta_vdop :: Word16
_msgSolnMeta_hdop :: Word16
_msgSolnMeta_pdop :: Word16
_msgSolnMeta_tow :: Word32
..}

  put :: MsgSolnMeta -> Put
put MsgSolnMeta {[SolutionInputType]
Word16
Word32
_msgSolnMeta_sol_in :: [SolutionInputType]
_msgSolnMeta_age_gnss :: Word32
_msgSolnMeta_age_corrections :: Word16
_msgSolnMeta_vdop :: Word16
_msgSolnMeta_hdop :: Word16
_msgSolnMeta_pdop :: Word16
_msgSolnMeta_tow :: Word32
_msgSolnMeta_sol_in :: MsgSolnMeta -> [SolutionInputType]
_msgSolnMeta_age_gnss :: MsgSolnMeta -> Word32
_msgSolnMeta_age_corrections :: MsgSolnMeta -> Word16
_msgSolnMeta_vdop :: MsgSolnMeta -> Word16
_msgSolnMeta_hdop :: MsgSolnMeta -> Word16
_msgSolnMeta_pdop :: MsgSolnMeta -> Word16
_msgSolnMeta_tow :: MsgSolnMeta -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgSolnMeta_tow
    Word16 -> Put
putWord16le Word16
_msgSolnMeta_pdop
    Word16 -> Put
putWord16le Word16
_msgSolnMeta_hdop
    Word16 -> Put
putWord16le Word16
_msgSolnMeta_vdop
    Word16 -> Put
putWord16le Word16
_msgSolnMeta_age_corrections
    Word32 -> Put
putWord32le Word32
_msgSolnMeta_age_gnss
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall t. Binary t => t -> Put
put [SolutionInputType]
_msgSolnMeta_sol_in

$(makeSBP 'msgSolnMeta ''MsgSolnMeta)
$(makeJSON "_msgSolnMeta_" ''MsgSolnMeta)
$(makeLenses ''MsgSolnMeta)

-- | GNSSInputType.
--
-- Metadata around the GNSS sensors involved in the fuzed solution. Accessible
-- through sol_in[N].flags in a MSG_SOLN_META.
data GNSSInputType = GNSSInputType
  { GNSSInputType -> Word8
_gNSSInputType_flags :: !Word8
    -- ^ flags that store all relevant info specific to this sensor type.
  } deriving ( Int -> GNSSInputType -> ShowS
[GNSSInputType] -> ShowS
GNSSInputType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GNSSInputType] -> ShowS
$cshowList :: [GNSSInputType] -> ShowS
show :: GNSSInputType -> String
$cshow :: GNSSInputType -> String
showsPrec :: Int -> GNSSInputType -> ShowS
$cshowsPrec :: Int -> GNSSInputType -> ShowS
Show, ReadPrec [GNSSInputType]
ReadPrec GNSSInputType
Int -> ReadS GNSSInputType
ReadS [GNSSInputType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GNSSInputType]
$creadListPrec :: ReadPrec [GNSSInputType]
readPrec :: ReadPrec GNSSInputType
$creadPrec :: ReadPrec GNSSInputType
readList :: ReadS [GNSSInputType]
$creadList :: ReadS [GNSSInputType]
readsPrec :: Int -> ReadS GNSSInputType
$creadsPrec :: Int -> ReadS GNSSInputType
Read, GNSSInputType -> GNSSInputType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GNSSInputType -> GNSSInputType -> Bool
$c/= :: GNSSInputType -> GNSSInputType -> Bool
== :: GNSSInputType -> GNSSInputType -> Bool
$c== :: GNSSInputType -> GNSSInputType -> Bool
Eq )

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

  put :: GNSSInputType -> Put
put GNSSInputType {Word8
_gNSSInputType_flags :: Word8
_gNSSInputType_flags :: GNSSInputType -> Word8
..} = do
    Word8 -> Put
putWord8 Word8
_gNSSInputType_flags

$(makeJSON "_gNSSInputType_" ''GNSSInputType)
$(makeLenses ''GNSSInputType)

-- | IMUInputType.
--
-- Metadata around the IMU sensors involved in the fuzed solution. Accessible
-- through sol_in[N].flags in a MSG_SOLN_META.
data IMUInputType = IMUInputType
  { IMUInputType -> Word8
_iMUInputType_flags :: !Word8
    -- ^ Instrument time, grade, and architecture for a sensor.
  } deriving ( Int -> IMUInputType -> ShowS
[IMUInputType] -> ShowS
IMUInputType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IMUInputType] -> ShowS
$cshowList :: [IMUInputType] -> ShowS
show :: IMUInputType -> String
$cshow :: IMUInputType -> String
showsPrec :: Int -> IMUInputType -> ShowS
$cshowsPrec :: Int -> IMUInputType -> ShowS
Show, ReadPrec [IMUInputType]
ReadPrec IMUInputType
Int -> ReadS IMUInputType
ReadS [IMUInputType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IMUInputType]
$creadListPrec :: ReadPrec [IMUInputType]
readPrec :: ReadPrec IMUInputType
$creadPrec :: ReadPrec IMUInputType
readList :: ReadS [IMUInputType]
$creadList :: ReadS [IMUInputType]
readsPrec :: Int -> ReadS IMUInputType
$creadsPrec :: Int -> ReadS IMUInputType
Read, IMUInputType -> IMUInputType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IMUInputType -> IMUInputType -> Bool
$c/= :: IMUInputType -> IMUInputType -> Bool
== :: IMUInputType -> IMUInputType -> Bool
$c== :: IMUInputType -> IMUInputType -> Bool
Eq )

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

  put :: IMUInputType -> Put
put IMUInputType {Word8
_iMUInputType_flags :: Word8
_iMUInputType_flags :: IMUInputType -> Word8
..} = do
    Word8 -> Put
putWord8 Word8
_iMUInputType_flags

$(makeJSON "_iMUInputType_" ''IMUInputType)
$(makeLenses ''IMUInputType)

-- | OdoInputType.
--
-- Metadata around the Odometry sensors involved in the fuzed solution.
-- Accessible through sol_in[N].flags in a MSG_SOLN_META.
data OdoInputType = OdoInputType
  { OdoInputType -> Word8
_odoInputType_flags :: !Word8
    -- ^ Instrument ODO rate, grade, and quality.
  } deriving ( Int -> OdoInputType -> ShowS
[OdoInputType] -> ShowS
OdoInputType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OdoInputType] -> ShowS
$cshowList :: [OdoInputType] -> ShowS
show :: OdoInputType -> String
$cshow :: OdoInputType -> String
showsPrec :: Int -> OdoInputType -> ShowS
$cshowsPrec :: Int -> OdoInputType -> ShowS
Show, ReadPrec [OdoInputType]
ReadPrec OdoInputType
Int -> ReadS OdoInputType
ReadS [OdoInputType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OdoInputType]
$creadListPrec :: ReadPrec [OdoInputType]
readPrec :: ReadPrec OdoInputType
$creadPrec :: ReadPrec OdoInputType
readList :: ReadS [OdoInputType]
$creadList :: ReadS [OdoInputType]
readsPrec :: Int -> ReadS OdoInputType
$creadsPrec :: Int -> ReadS OdoInputType
Read, OdoInputType -> OdoInputType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OdoInputType -> OdoInputType -> Bool
$c/= :: OdoInputType -> OdoInputType -> Bool
== :: OdoInputType -> OdoInputType -> Bool
$c== :: OdoInputType -> OdoInputType -> Bool
Eq )

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

  put :: OdoInputType -> Put
put OdoInputType {Word8
_odoInputType_flags :: Word8
_odoInputType_flags :: OdoInputType -> Word8
..} = do
    Word8 -> Put
putWord8 Word8
_odoInputType_flags

$(makeJSON "_odoInputType_" ''OdoInputType)
$(makeLenses ''OdoInputType)