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

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

module SwiftNav.SBP.Integrity
  ( module SwiftNav.SBP.Integrity
  ) where

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

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


data IntegritySSRHeader = IntegritySSRHeader
  { IntegritySSRHeader -> GpsTimeSec
_integritySSRHeader_obs_time  :: !GpsTimeSec
    -- ^ GNSS reference time of the observation used to generate the flag.
  , IntegritySSRHeader -> Word8
_integritySSRHeader_num_msgs  :: !Word8
    -- ^ Number of messages in the dataset
  , IntegritySSRHeader -> Word8
_integritySSRHeader_seq_num   :: !Word8
    -- ^ Position of this message in the dataset
  , IntegritySSRHeader -> Word8
_integritySSRHeader_ssr_sol_id :: !Word8
    -- ^ SSR Solution ID.
  , IntegritySSRHeader -> Word16
_integritySSRHeader_tile_set_id :: !Word16
    -- ^ Unique identifier of the set this tile belongs to.
  , IntegritySSRHeader -> Word16
_integritySSRHeader_tile_id   :: !Word16
    -- ^ Unique identifier of this tile in the tile set.
  , IntegritySSRHeader -> Word8
_integritySSRHeader_chain_id  :: !Word8
    -- ^ Chain and type of flag.
  } deriving ( Int -> IntegritySSRHeader -> ShowS
[IntegritySSRHeader] -> ShowS
IntegritySSRHeader -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IntegritySSRHeader] -> ShowS
$cshowList :: [IntegritySSRHeader] -> ShowS
show :: IntegritySSRHeader -> String
$cshow :: IntegritySSRHeader -> String
showsPrec :: Int -> IntegritySSRHeader -> ShowS
$cshowsPrec :: Int -> IntegritySSRHeader -> ShowS
Show, ReadPrec [IntegritySSRHeader]
ReadPrec IntegritySSRHeader
Int -> ReadS IntegritySSRHeader
ReadS [IntegritySSRHeader]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IntegritySSRHeader]
$creadListPrec :: ReadPrec [IntegritySSRHeader]
readPrec :: ReadPrec IntegritySSRHeader
$creadPrec :: ReadPrec IntegritySSRHeader
readList :: ReadS [IntegritySSRHeader]
$creadList :: ReadS [IntegritySSRHeader]
readsPrec :: Int -> ReadS IntegritySSRHeader
$creadsPrec :: Int -> ReadS IntegritySSRHeader
Read, IntegritySSRHeader -> IntegritySSRHeader -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IntegritySSRHeader -> IntegritySSRHeader -> Bool
$c/= :: IntegritySSRHeader -> IntegritySSRHeader -> Bool
== :: IntegritySSRHeader -> IntegritySSRHeader -> Bool
$c== :: IntegritySSRHeader -> IntegritySSRHeader -> Bool
Eq )

instance Binary IntegritySSRHeader where
  get :: Get IntegritySSRHeader
get = do
    GpsTimeSec
_integritySSRHeader_obs_time <- forall t. Binary t => Get t
get
    Word8
_integritySSRHeader_num_msgs <- Get Word8
getWord8
    Word8
_integritySSRHeader_seq_num <- Get Word8
getWord8
    Word8
_integritySSRHeader_ssr_sol_id <- Get Word8
getWord8
    Word16
_integritySSRHeader_tile_set_id <- Get Word16
getWord16le
    Word16
_integritySSRHeader_tile_id <- Get Word16
getWord16le
    Word8
_integritySSRHeader_chain_id <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure IntegritySSRHeader {Word8
Word16
GpsTimeSec
_integritySSRHeader_chain_id :: Word8
_integritySSRHeader_tile_id :: Word16
_integritySSRHeader_tile_set_id :: Word16
_integritySSRHeader_ssr_sol_id :: Word8
_integritySSRHeader_seq_num :: Word8
_integritySSRHeader_num_msgs :: Word8
_integritySSRHeader_obs_time :: GpsTimeSec
_integritySSRHeader_chain_id :: Word8
_integritySSRHeader_tile_id :: Word16
_integritySSRHeader_tile_set_id :: Word16
_integritySSRHeader_ssr_sol_id :: Word8
_integritySSRHeader_seq_num :: Word8
_integritySSRHeader_num_msgs :: Word8
_integritySSRHeader_obs_time :: GpsTimeSec
..}

  put :: IntegritySSRHeader -> Put
put IntegritySSRHeader {Word8
Word16
GpsTimeSec
_integritySSRHeader_chain_id :: Word8
_integritySSRHeader_tile_id :: Word16
_integritySSRHeader_tile_set_id :: Word16
_integritySSRHeader_ssr_sol_id :: Word8
_integritySSRHeader_seq_num :: Word8
_integritySSRHeader_num_msgs :: Word8
_integritySSRHeader_obs_time :: GpsTimeSec
_integritySSRHeader_chain_id :: IntegritySSRHeader -> Word8
_integritySSRHeader_tile_id :: IntegritySSRHeader -> Word16
_integritySSRHeader_tile_set_id :: IntegritySSRHeader -> Word16
_integritySSRHeader_ssr_sol_id :: IntegritySSRHeader -> Word8
_integritySSRHeader_seq_num :: IntegritySSRHeader -> Word8
_integritySSRHeader_num_msgs :: IntegritySSRHeader -> Word8
_integritySSRHeader_obs_time :: IntegritySSRHeader -> GpsTimeSec
..} = do
    forall t. Binary t => t -> Put
put GpsTimeSec
_integritySSRHeader_obs_time
    Word8 -> Put
putWord8 Word8
_integritySSRHeader_num_msgs
    Word8 -> Put
putWord8 Word8
_integritySSRHeader_seq_num
    Word8 -> Put
putWord8 Word8
_integritySSRHeader_ssr_sol_id
    Word16 -> Put
putWord16le Word16
_integritySSRHeader_tile_set_id
    Word16 -> Put
putWord16le Word16
_integritySSRHeader_tile_id
    Word8 -> Put
putWord8 Word8
_integritySSRHeader_chain_id

$(makeJSON "_integritySSRHeader_" ''IntegritySSRHeader)
$(makeLenses ''IntegritySSRHeader)

msgSsrFlagHighLevel :: Word16
msgSsrFlagHighLevel :: Word16
msgSsrFlagHighLevel = Word16
0x0BB9

-- | SBP class for message MSG_SSR_FLAG_HIGH_LEVEL (0x0BB9).
--
-- Integrity monitoring flags for multiple aggregated elements. An element
-- could be a satellite, SSR grid point, or SSR tile. A group of aggregated
-- elements being monitored for integrity could refer to:
--
-- - Satellites in a particular {GPS, GAL, BDS} constellation.
--
-- - Satellites in the line-of-sight of a particular SSR tile.
--
-- - Satellites in the line-of-sight of a particular SSR grid point.
--
-- The integrity usage for a group of aggregated elements varies according to
-- the integrity flag of the satellites comprising that group.
--
-- SSR_INTEGRITY_USAGE_NOMINAL: All satellites received passed the integrity
-- check and have flag INTEGRITY_FLAG_OK.
--
-- SSR_INTEGRITY_USAGE_WARNING: A limited number of elements in the group
-- failed the integrity check. Refer to more granular integrity messages for
-- details on the specific failing elements.
--
-- SSR_INTEGRITY_USAGE_ALERT: Most elements in the group failed the integrity
-- check, do not use for positioning.
--
-- SSR_INTEGRITY_USAGE_NOT_MONITORED: Unable to verify the integrity flag of
-- elements in the group.
data MsgSsrFlagHighLevel = MsgSsrFlagHighLevel
  { MsgSsrFlagHighLevel -> GpsTimeSec
_msgSsrFlagHighLevel_obs_time                  :: !GpsTimeSec
    -- ^ GNSS reference time of the observation used to generate the flag.
  , MsgSsrFlagHighLevel -> GpsTimeSec
_msgSsrFlagHighLevel_corr_time                 :: !GpsTimeSec
    -- ^ GNSS reference time of the correction associated to the flag.
  , MsgSsrFlagHighLevel -> Word8
_msgSsrFlagHighLevel_ssr_sol_id                :: !Word8
    -- ^ SSR Solution ID.
  , MsgSsrFlagHighLevel -> Word16
_msgSsrFlagHighLevel_tile_set_id               :: !Word16
    -- ^ Unique identifier of the set this tile belongs to.
  , MsgSsrFlagHighLevel -> Word16
_msgSsrFlagHighLevel_tile_id                   :: !Word16
    -- ^ Unique identifier of this tile in the tile set.
  , MsgSsrFlagHighLevel -> Word8
_msgSsrFlagHighLevel_chain_id                  :: !Word8
    -- ^ Chain and type of flag.
  , MsgSsrFlagHighLevel -> Word8
_msgSsrFlagHighLevel_use_gps_sat               :: !Word8
    -- ^ Use GPS satellites.
  , MsgSsrFlagHighLevel -> Word8
_msgSsrFlagHighLevel_use_gal_sat               :: !Word8
    -- ^ Use GAL satellites.
  , MsgSsrFlagHighLevel -> Word8
_msgSsrFlagHighLevel_use_bds_sat               :: !Word8
    -- ^ Use BDS satellites.
  , MsgSsrFlagHighLevel -> [Word8]
_msgSsrFlagHighLevel_reserved                  :: ![Word8]
    -- ^ Reserved
  , MsgSsrFlagHighLevel -> Word8
_msgSsrFlagHighLevel_use_tropo_grid_points     :: !Word8
    -- ^ Use tropo grid points.
  , MsgSsrFlagHighLevel -> Word8
_msgSsrFlagHighLevel_use_iono_grid_points      :: !Word8
    -- ^ Use iono grid points.
  , MsgSsrFlagHighLevel -> Word8
_msgSsrFlagHighLevel_use_iono_tile_sat_los     :: !Word8
    -- ^ Use iono tile satellite LoS.
  , MsgSsrFlagHighLevel -> Word8
_msgSsrFlagHighLevel_use_iono_grid_point_sat_los :: !Word8
    -- ^ Use iono grid point satellite LoS.
  } deriving ( Int -> MsgSsrFlagHighLevel -> ShowS
[MsgSsrFlagHighLevel] -> ShowS
MsgSsrFlagHighLevel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgSsrFlagHighLevel] -> ShowS
$cshowList :: [MsgSsrFlagHighLevel] -> ShowS
show :: MsgSsrFlagHighLevel -> String
$cshow :: MsgSsrFlagHighLevel -> String
showsPrec :: Int -> MsgSsrFlagHighLevel -> ShowS
$cshowsPrec :: Int -> MsgSsrFlagHighLevel -> ShowS
Show, ReadPrec [MsgSsrFlagHighLevel]
ReadPrec MsgSsrFlagHighLevel
Int -> ReadS MsgSsrFlagHighLevel
ReadS [MsgSsrFlagHighLevel]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgSsrFlagHighLevel]
$creadListPrec :: ReadPrec [MsgSsrFlagHighLevel]
readPrec :: ReadPrec MsgSsrFlagHighLevel
$creadPrec :: ReadPrec MsgSsrFlagHighLevel
readList :: ReadS [MsgSsrFlagHighLevel]
$creadList :: ReadS [MsgSsrFlagHighLevel]
readsPrec :: Int -> ReadS MsgSsrFlagHighLevel
$creadsPrec :: Int -> ReadS MsgSsrFlagHighLevel
Read, MsgSsrFlagHighLevel -> MsgSsrFlagHighLevel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgSsrFlagHighLevel -> MsgSsrFlagHighLevel -> Bool
$c/= :: MsgSsrFlagHighLevel -> MsgSsrFlagHighLevel -> Bool
== :: MsgSsrFlagHighLevel -> MsgSsrFlagHighLevel -> Bool
$c== :: MsgSsrFlagHighLevel -> MsgSsrFlagHighLevel -> Bool
Eq )

instance Binary MsgSsrFlagHighLevel where
  get :: Get MsgSsrFlagHighLevel
get = do
    GpsTimeSec
_msgSsrFlagHighLevel_obs_time <- forall t. Binary t => Get t
get
    GpsTimeSec
_msgSsrFlagHighLevel_corr_time <- forall t. Binary t => Get t
get
    Word8
_msgSsrFlagHighLevel_ssr_sol_id <- Get Word8
getWord8
    Word16
_msgSsrFlagHighLevel_tile_set_id <- Get Word16
getWord16le
    Word16
_msgSsrFlagHighLevel_tile_id <- Get Word16
getWord16le
    Word8
_msgSsrFlagHighLevel_chain_id <- Get Word8
getWord8
    Word8
_msgSsrFlagHighLevel_use_gps_sat <- Get Word8
getWord8
    Word8
_msgSsrFlagHighLevel_use_gal_sat <- Get Word8
getWord8
    Word8
_msgSsrFlagHighLevel_use_bds_sat <- Get Word8
getWord8
    [Word8]
_msgSsrFlagHighLevel_reserved <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
6 Get Word8
getWord8
    Word8
_msgSsrFlagHighLevel_use_tropo_grid_points <- Get Word8
getWord8
    Word8
_msgSsrFlagHighLevel_use_iono_grid_points <- Get Word8
getWord8
    Word8
_msgSsrFlagHighLevel_use_iono_tile_sat_los <- Get Word8
getWord8
    Word8
_msgSsrFlagHighLevel_use_iono_grid_point_sat_los <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgSsrFlagHighLevel {[Word8]
Word8
Word16
GpsTimeSec
_msgSsrFlagHighLevel_use_iono_grid_point_sat_los :: Word8
_msgSsrFlagHighLevel_use_iono_tile_sat_los :: Word8
_msgSsrFlagHighLevel_use_iono_grid_points :: Word8
_msgSsrFlagHighLevel_use_tropo_grid_points :: Word8
_msgSsrFlagHighLevel_reserved :: [Word8]
_msgSsrFlagHighLevel_use_bds_sat :: Word8
_msgSsrFlagHighLevel_use_gal_sat :: Word8
_msgSsrFlagHighLevel_use_gps_sat :: Word8
_msgSsrFlagHighLevel_chain_id :: Word8
_msgSsrFlagHighLevel_tile_id :: Word16
_msgSsrFlagHighLevel_tile_set_id :: Word16
_msgSsrFlagHighLevel_ssr_sol_id :: Word8
_msgSsrFlagHighLevel_corr_time :: GpsTimeSec
_msgSsrFlagHighLevel_obs_time :: GpsTimeSec
_msgSsrFlagHighLevel_use_iono_grid_point_sat_los :: Word8
_msgSsrFlagHighLevel_use_iono_tile_sat_los :: Word8
_msgSsrFlagHighLevel_use_iono_grid_points :: Word8
_msgSsrFlagHighLevel_use_tropo_grid_points :: Word8
_msgSsrFlagHighLevel_reserved :: [Word8]
_msgSsrFlagHighLevel_use_bds_sat :: Word8
_msgSsrFlagHighLevel_use_gal_sat :: Word8
_msgSsrFlagHighLevel_use_gps_sat :: Word8
_msgSsrFlagHighLevel_chain_id :: Word8
_msgSsrFlagHighLevel_tile_id :: Word16
_msgSsrFlagHighLevel_tile_set_id :: Word16
_msgSsrFlagHighLevel_ssr_sol_id :: Word8
_msgSsrFlagHighLevel_corr_time :: GpsTimeSec
_msgSsrFlagHighLevel_obs_time :: GpsTimeSec
..}

  put :: MsgSsrFlagHighLevel -> Put
put MsgSsrFlagHighLevel {[Word8]
Word8
Word16
GpsTimeSec
_msgSsrFlagHighLevel_use_iono_grid_point_sat_los :: Word8
_msgSsrFlagHighLevel_use_iono_tile_sat_los :: Word8
_msgSsrFlagHighLevel_use_iono_grid_points :: Word8
_msgSsrFlagHighLevel_use_tropo_grid_points :: Word8
_msgSsrFlagHighLevel_reserved :: [Word8]
_msgSsrFlagHighLevel_use_bds_sat :: Word8
_msgSsrFlagHighLevel_use_gal_sat :: Word8
_msgSsrFlagHighLevel_use_gps_sat :: Word8
_msgSsrFlagHighLevel_chain_id :: Word8
_msgSsrFlagHighLevel_tile_id :: Word16
_msgSsrFlagHighLevel_tile_set_id :: Word16
_msgSsrFlagHighLevel_ssr_sol_id :: Word8
_msgSsrFlagHighLevel_corr_time :: GpsTimeSec
_msgSsrFlagHighLevel_obs_time :: GpsTimeSec
_msgSsrFlagHighLevel_use_iono_grid_point_sat_los :: MsgSsrFlagHighLevel -> Word8
_msgSsrFlagHighLevel_use_iono_tile_sat_los :: MsgSsrFlagHighLevel -> Word8
_msgSsrFlagHighLevel_use_iono_grid_points :: MsgSsrFlagHighLevel -> Word8
_msgSsrFlagHighLevel_use_tropo_grid_points :: MsgSsrFlagHighLevel -> Word8
_msgSsrFlagHighLevel_reserved :: MsgSsrFlagHighLevel -> [Word8]
_msgSsrFlagHighLevel_use_bds_sat :: MsgSsrFlagHighLevel -> Word8
_msgSsrFlagHighLevel_use_gal_sat :: MsgSsrFlagHighLevel -> Word8
_msgSsrFlagHighLevel_use_gps_sat :: MsgSsrFlagHighLevel -> Word8
_msgSsrFlagHighLevel_chain_id :: MsgSsrFlagHighLevel -> Word8
_msgSsrFlagHighLevel_tile_id :: MsgSsrFlagHighLevel -> Word16
_msgSsrFlagHighLevel_tile_set_id :: MsgSsrFlagHighLevel -> Word16
_msgSsrFlagHighLevel_ssr_sol_id :: MsgSsrFlagHighLevel -> Word8
_msgSsrFlagHighLevel_corr_time :: MsgSsrFlagHighLevel -> GpsTimeSec
_msgSsrFlagHighLevel_obs_time :: MsgSsrFlagHighLevel -> GpsTimeSec
..} = do
    forall t. Binary t => t -> Put
put GpsTimeSec
_msgSsrFlagHighLevel_obs_time
    forall t. Binary t => t -> Put
put GpsTimeSec
_msgSsrFlagHighLevel_corr_time
    Word8 -> Put
putWord8 Word8
_msgSsrFlagHighLevel_ssr_sol_id
    Word16 -> Put
putWord16le Word16
_msgSsrFlagHighLevel_tile_set_id
    Word16 -> Put
putWord16le Word16
_msgSsrFlagHighLevel_tile_id
    Word8 -> Put
putWord8 Word8
_msgSsrFlagHighLevel_chain_id
    Word8 -> Put
putWord8 Word8
_msgSsrFlagHighLevel_use_gps_sat
    Word8 -> Put
putWord8 Word8
_msgSsrFlagHighLevel_use_gal_sat
    Word8 -> Put
putWord8 Word8
_msgSsrFlagHighLevel_use_bds_sat
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
_msgSsrFlagHighLevel_reserved
    Word8 -> Put
putWord8 Word8
_msgSsrFlagHighLevel_use_tropo_grid_points
    Word8 -> Put
putWord8 Word8
_msgSsrFlagHighLevel_use_iono_grid_points
    Word8 -> Put
putWord8 Word8
_msgSsrFlagHighLevel_use_iono_tile_sat_los
    Word8 -> Put
putWord8 Word8
_msgSsrFlagHighLevel_use_iono_grid_point_sat_los

$(makeSBP 'msgSsrFlagHighLevel ''MsgSsrFlagHighLevel)
$(makeJSON "_msgSsrFlagHighLevel_" ''MsgSsrFlagHighLevel)
$(makeLenses ''MsgSsrFlagHighLevel)

msgSsrFlagSatellites :: Word16
msgSsrFlagSatellites :: Word16
msgSsrFlagSatellites = Word16
0x0BBD

data MsgSsrFlagSatellites = MsgSsrFlagSatellites
  { MsgSsrFlagSatellites -> GpsTimeSec
_msgSsrFlagSatellites_obs_time    :: !GpsTimeSec
    -- ^ GNSS reference time of the observation used to generate the flag.
  , MsgSsrFlagSatellites -> Word8
_msgSsrFlagSatellites_num_msgs    :: !Word8
    -- ^ Number of messages in the dataset
  , MsgSsrFlagSatellites -> Word8
_msgSsrFlagSatellites_seq_num     :: !Word8
    -- ^ Position of this message in the dataset
  , MsgSsrFlagSatellites -> Word8
_msgSsrFlagSatellites_ssr_sol_id  :: !Word8
    -- ^ SSR Solution ID.
  , MsgSsrFlagSatellites -> Word8
_msgSsrFlagSatellites_chain_id    :: !Word8
    -- ^ Chain and type of flag.
  , MsgSsrFlagSatellites -> Word8
_msgSsrFlagSatellites_const_id    :: !Word8
    -- ^ Constellation ID.
  , MsgSsrFlagSatellites -> Word8
_msgSsrFlagSatellites_n_faulty_sats :: !Word8
    -- ^ Number of faulty satellites.
  , MsgSsrFlagSatellites -> [Word8]
_msgSsrFlagSatellites_faulty_sats :: ![Word8]
    -- ^ List of faulty satellites.
  } deriving ( Int -> MsgSsrFlagSatellites -> ShowS
[MsgSsrFlagSatellites] -> ShowS
MsgSsrFlagSatellites -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgSsrFlagSatellites] -> ShowS
$cshowList :: [MsgSsrFlagSatellites] -> ShowS
show :: MsgSsrFlagSatellites -> String
$cshow :: MsgSsrFlagSatellites -> String
showsPrec :: Int -> MsgSsrFlagSatellites -> ShowS
$cshowsPrec :: Int -> MsgSsrFlagSatellites -> ShowS
Show, ReadPrec [MsgSsrFlagSatellites]
ReadPrec MsgSsrFlagSatellites
Int -> ReadS MsgSsrFlagSatellites
ReadS [MsgSsrFlagSatellites]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgSsrFlagSatellites]
$creadListPrec :: ReadPrec [MsgSsrFlagSatellites]
readPrec :: ReadPrec MsgSsrFlagSatellites
$creadPrec :: ReadPrec MsgSsrFlagSatellites
readList :: ReadS [MsgSsrFlagSatellites]
$creadList :: ReadS [MsgSsrFlagSatellites]
readsPrec :: Int -> ReadS MsgSsrFlagSatellites
$creadsPrec :: Int -> ReadS MsgSsrFlagSatellites
Read, MsgSsrFlagSatellites -> MsgSsrFlagSatellites -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgSsrFlagSatellites -> MsgSsrFlagSatellites -> Bool
$c/= :: MsgSsrFlagSatellites -> MsgSsrFlagSatellites -> Bool
== :: MsgSsrFlagSatellites -> MsgSsrFlagSatellites -> Bool
$c== :: MsgSsrFlagSatellites -> MsgSsrFlagSatellites -> Bool
Eq )

instance Binary MsgSsrFlagSatellites where
  get :: Get MsgSsrFlagSatellites
get = do
    GpsTimeSec
_msgSsrFlagSatellites_obs_time <- forall t. Binary t => Get t
get
    Word8
_msgSsrFlagSatellites_num_msgs <- Get Word8
getWord8
    Word8
_msgSsrFlagSatellites_seq_num <- Get Word8
getWord8
    Word8
_msgSsrFlagSatellites_ssr_sol_id <- Get Word8
getWord8
    Word8
_msgSsrFlagSatellites_chain_id <- Get Word8
getWord8
    Word8
_msgSsrFlagSatellites_const_id <- Get Word8
getWord8
    Word8
_msgSsrFlagSatellites_n_faulty_sats <- Get Word8
getWord8
    [Word8]
_msgSsrFlagSatellites_faulty_sats <- forall (m :: * -> *) a. Monad m => m Bool -> m a -> m [a]
whileM (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool
isEmpty) Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgSsrFlagSatellites {[Word8]
Word8
GpsTimeSec
_msgSsrFlagSatellites_faulty_sats :: [Word8]
_msgSsrFlagSatellites_n_faulty_sats :: Word8
_msgSsrFlagSatellites_const_id :: Word8
_msgSsrFlagSatellites_chain_id :: Word8
_msgSsrFlagSatellites_ssr_sol_id :: Word8
_msgSsrFlagSatellites_seq_num :: Word8
_msgSsrFlagSatellites_num_msgs :: Word8
_msgSsrFlagSatellites_obs_time :: GpsTimeSec
_msgSsrFlagSatellites_faulty_sats :: [Word8]
_msgSsrFlagSatellites_n_faulty_sats :: Word8
_msgSsrFlagSatellites_const_id :: Word8
_msgSsrFlagSatellites_chain_id :: Word8
_msgSsrFlagSatellites_ssr_sol_id :: Word8
_msgSsrFlagSatellites_seq_num :: Word8
_msgSsrFlagSatellites_num_msgs :: Word8
_msgSsrFlagSatellites_obs_time :: GpsTimeSec
..}

  put :: MsgSsrFlagSatellites -> Put
put MsgSsrFlagSatellites {[Word8]
Word8
GpsTimeSec
_msgSsrFlagSatellites_faulty_sats :: [Word8]
_msgSsrFlagSatellites_n_faulty_sats :: Word8
_msgSsrFlagSatellites_const_id :: Word8
_msgSsrFlagSatellites_chain_id :: Word8
_msgSsrFlagSatellites_ssr_sol_id :: Word8
_msgSsrFlagSatellites_seq_num :: Word8
_msgSsrFlagSatellites_num_msgs :: Word8
_msgSsrFlagSatellites_obs_time :: GpsTimeSec
_msgSsrFlagSatellites_faulty_sats :: MsgSsrFlagSatellites -> [Word8]
_msgSsrFlagSatellites_n_faulty_sats :: MsgSsrFlagSatellites -> Word8
_msgSsrFlagSatellites_const_id :: MsgSsrFlagSatellites -> Word8
_msgSsrFlagSatellites_chain_id :: MsgSsrFlagSatellites -> Word8
_msgSsrFlagSatellites_ssr_sol_id :: MsgSsrFlagSatellites -> Word8
_msgSsrFlagSatellites_seq_num :: MsgSsrFlagSatellites -> Word8
_msgSsrFlagSatellites_num_msgs :: MsgSsrFlagSatellites -> Word8
_msgSsrFlagSatellites_obs_time :: MsgSsrFlagSatellites -> GpsTimeSec
..} = do
    forall t. Binary t => t -> Put
put GpsTimeSec
_msgSsrFlagSatellites_obs_time
    Word8 -> Put
putWord8 Word8
_msgSsrFlagSatellites_num_msgs
    Word8 -> Put
putWord8 Word8
_msgSsrFlagSatellites_seq_num
    Word8 -> Put
putWord8 Word8
_msgSsrFlagSatellites_ssr_sol_id
    Word8 -> Put
putWord8 Word8
_msgSsrFlagSatellites_chain_id
    Word8 -> Put
putWord8 Word8
_msgSsrFlagSatellites_const_id
    Word8 -> Put
putWord8 Word8
_msgSsrFlagSatellites_n_faulty_sats
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
_msgSsrFlagSatellites_faulty_sats

$(makeSBP 'msgSsrFlagSatellites ''MsgSsrFlagSatellites)
$(makeJSON "_msgSsrFlagSatellites_" ''MsgSsrFlagSatellites)
$(makeLenses ''MsgSsrFlagSatellites)

msgSsrFlagTropoGridPoints :: Word16
msgSsrFlagTropoGridPoints :: Word16
msgSsrFlagTropoGridPoints = Word16
0x0BC3

data MsgSsrFlagTropoGridPoints = MsgSsrFlagTropoGridPoints
  { MsgSsrFlagTropoGridPoints -> IntegritySSRHeader
_msgSsrFlagTropoGridPoints_header        :: !IntegritySSRHeader
    -- ^ Header of an integrity message.
  , MsgSsrFlagTropoGridPoints -> Word8
_msgSsrFlagTropoGridPoints_n_faulty_points :: !Word8
    -- ^ Number of faulty grid points.
  , MsgSsrFlagTropoGridPoints -> [Word16]
_msgSsrFlagTropoGridPoints_faulty_points :: ![Word16]
    -- ^ List of faulty grid points.
  } deriving ( Int -> MsgSsrFlagTropoGridPoints -> ShowS
[MsgSsrFlagTropoGridPoints] -> ShowS
MsgSsrFlagTropoGridPoints -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgSsrFlagTropoGridPoints] -> ShowS
$cshowList :: [MsgSsrFlagTropoGridPoints] -> ShowS
show :: MsgSsrFlagTropoGridPoints -> String
$cshow :: MsgSsrFlagTropoGridPoints -> String
showsPrec :: Int -> MsgSsrFlagTropoGridPoints -> ShowS
$cshowsPrec :: Int -> MsgSsrFlagTropoGridPoints -> ShowS
Show, ReadPrec [MsgSsrFlagTropoGridPoints]
ReadPrec MsgSsrFlagTropoGridPoints
Int -> ReadS MsgSsrFlagTropoGridPoints
ReadS [MsgSsrFlagTropoGridPoints]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgSsrFlagTropoGridPoints]
$creadListPrec :: ReadPrec [MsgSsrFlagTropoGridPoints]
readPrec :: ReadPrec MsgSsrFlagTropoGridPoints
$creadPrec :: ReadPrec MsgSsrFlagTropoGridPoints
readList :: ReadS [MsgSsrFlagTropoGridPoints]
$creadList :: ReadS [MsgSsrFlagTropoGridPoints]
readsPrec :: Int -> ReadS MsgSsrFlagTropoGridPoints
$creadsPrec :: Int -> ReadS MsgSsrFlagTropoGridPoints
Read, MsgSsrFlagTropoGridPoints -> MsgSsrFlagTropoGridPoints -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgSsrFlagTropoGridPoints -> MsgSsrFlagTropoGridPoints -> Bool
$c/= :: MsgSsrFlagTropoGridPoints -> MsgSsrFlagTropoGridPoints -> Bool
== :: MsgSsrFlagTropoGridPoints -> MsgSsrFlagTropoGridPoints -> Bool
$c== :: MsgSsrFlagTropoGridPoints -> MsgSsrFlagTropoGridPoints -> Bool
Eq )

instance Binary MsgSsrFlagTropoGridPoints where
  get :: Get MsgSsrFlagTropoGridPoints
get = do
    IntegritySSRHeader
_msgSsrFlagTropoGridPoints_header <- forall t. Binary t => Get t
get
    Word8
_msgSsrFlagTropoGridPoints_n_faulty_points <- Get Word8
getWord8
    [Word16]
_msgSsrFlagTropoGridPoints_faulty_points <- forall (m :: * -> *) a. Monad m => m Bool -> m a -> m [a]
whileM (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool
isEmpty) Get Word16
getWord16le
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgSsrFlagTropoGridPoints {[Word16]
Word8
IntegritySSRHeader
_msgSsrFlagTropoGridPoints_faulty_points :: [Word16]
_msgSsrFlagTropoGridPoints_n_faulty_points :: Word8
_msgSsrFlagTropoGridPoints_header :: IntegritySSRHeader
_msgSsrFlagTropoGridPoints_faulty_points :: [Word16]
_msgSsrFlagTropoGridPoints_n_faulty_points :: Word8
_msgSsrFlagTropoGridPoints_header :: IntegritySSRHeader
..}

  put :: MsgSsrFlagTropoGridPoints -> Put
put MsgSsrFlagTropoGridPoints {[Word16]
Word8
IntegritySSRHeader
_msgSsrFlagTropoGridPoints_faulty_points :: [Word16]
_msgSsrFlagTropoGridPoints_n_faulty_points :: Word8
_msgSsrFlagTropoGridPoints_header :: IntegritySSRHeader
_msgSsrFlagTropoGridPoints_faulty_points :: MsgSsrFlagTropoGridPoints -> [Word16]
_msgSsrFlagTropoGridPoints_n_faulty_points :: MsgSsrFlagTropoGridPoints -> Word8
_msgSsrFlagTropoGridPoints_header :: MsgSsrFlagTropoGridPoints -> IntegritySSRHeader
..} = do
    forall t. Binary t => t -> Put
put IntegritySSRHeader
_msgSsrFlagTropoGridPoints_header
    Word8 -> Put
putWord8 Word8
_msgSsrFlagTropoGridPoints_n_faulty_points
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word16 -> Put
putWord16le [Word16]
_msgSsrFlagTropoGridPoints_faulty_points

$(makeSBP 'msgSsrFlagTropoGridPoints ''MsgSsrFlagTropoGridPoints)
$(makeJSON "_msgSsrFlagTropoGridPoints_" ''MsgSsrFlagTropoGridPoints)
$(makeLenses ''MsgSsrFlagTropoGridPoints)

msgSsrFlagIonoGridPoints :: Word16
msgSsrFlagIonoGridPoints :: Word16
msgSsrFlagIonoGridPoints = Word16
0x0BC7

data MsgSsrFlagIonoGridPoints = MsgSsrFlagIonoGridPoints
  { MsgSsrFlagIonoGridPoints -> IntegritySSRHeader
_msgSsrFlagIonoGridPoints_header        :: !IntegritySSRHeader
    -- ^ Header of an integrity message.
  , MsgSsrFlagIonoGridPoints -> Word8
_msgSsrFlagIonoGridPoints_n_faulty_points :: !Word8
    -- ^ Number of faulty grid points.
  , MsgSsrFlagIonoGridPoints -> [Word16]
_msgSsrFlagIonoGridPoints_faulty_points :: ![Word16]
    -- ^ List of faulty grid points.
  } deriving ( Int -> MsgSsrFlagIonoGridPoints -> ShowS
[MsgSsrFlagIonoGridPoints] -> ShowS
MsgSsrFlagIonoGridPoints -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgSsrFlagIonoGridPoints] -> ShowS
$cshowList :: [MsgSsrFlagIonoGridPoints] -> ShowS
show :: MsgSsrFlagIonoGridPoints -> String
$cshow :: MsgSsrFlagIonoGridPoints -> String
showsPrec :: Int -> MsgSsrFlagIonoGridPoints -> ShowS
$cshowsPrec :: Int -> MsgSsrFlagIonoGridPoints -> ShowS
Show, ReadPrec [MsgSsrFlagIonoGridPoints]
ReadPrec MsgSsrFlagIonoGridPoints
Int -> ReadS MsgSsrFlagIonoGridPoints
ReadS [MsgSsrFlagIonoGridPoints]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgSsrFlagIonoGridPoints]
$creadListPrec :: ReadPrec [MsgSsrFlagIonoGridPoints]
readPrec :: ReadPrec MsgSsrFlagIonoGridPoints
$creadPrec :: ReadPrec MsgSsrFlagIonoGridPoints
readList :: ReadS [MsgSsrFlagIonoGridPoints]
$creadList :: ReadS [MsgSsrFlagIonoGridPoints]
readsPrec :: Int -> ReadS MsgSsrFlagIonoGridPoints
$creadsPrec :: Int -> ReadS MsgSsrFlagIonoGridPoints
Read, MsgSsrFlagIonoGridPoints -> MsgSsrFlagIonoGridPoints -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgSsrFlagIonoGridPoints -> MsgSsrFlagIonoGridPoints -> Bool
$c/= :: MsgSsrFlagIonoGridPoints -> MsgSsrFlagIonoGridPoints -> Bool
== :: MsgSsrFlagIonoGridPoints -> MsgSsrFlagIonoGridPoints -> Bool
$c== :: MsgSsrFlagIonoGridPoints -> MsgSsrFlagIonoGridPoints -> Bool
Eq )

instance Binary MsgSsrFlagIonoGridPoints where
  get :: Get MsgSsrFlagIonoGridPoints
get = do
    IntegritySSRHeader
_msgSsrFlagIonoGridPoints_header <- forall t. Binary t => Get t
get
    Word8
_msgSsrFlagIonoGridPoints_n_faulty_points <- Get Word8
getWord8
    [Word16]
_msgSsrFlagIonoGridPoints_faulty_points <- forall (m :: * -> *) a. Monad m => m Bool -> m a -> m [a]
whileM (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool
isEmpty) Get Word16
getWord16le
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgSsrFlagIonoGridPoints {[Word16]
Word8
IntegritySSRHeader
_msgSsrFlagIonoGridPoints_faulty_points :: [Word16]
_msgSsrFlagIonoGridPoints_n_faulty_points :: Word8
_msgSsrFlagIonoGridPoints_header :: IntegritySSRHeader
_msgSsrFlagIonoGridPoints_faulty_points :: [Word16]
_msgSsrFlagIonoGridPoints_n_faulty_points :: Word8
_msgSsrFlagIonoGridPoints_header :: IntegritySSRHeader
..}

  put :: MsgSsrFlagIonoGridPoints -> Put
put MsgSsrFlagIonoGridPoints {[Word16]
Word8
IntegritySSRHeader
_msgSsrFlagIonoGridPoints_faulty_points :: [Word16]
_msgSsrFlagIonoGridPoints_n_faulty_points :: Word8
_msgSsrFlagIonoGridPoints_header :: IntegritySSRHeader
_msgSsrFlagIonoGridPoints_faulty_points :: MsgSsrFlagIonoGridPoints -> [Word16]
_msgSsrFlagIonoGridPoints_n_faulty_points :: MsgSsrFlagIonoGridPoints -> Word8
_msgSsrFlagIonoGridPoints_header :: MsgSsrFlagIonoGridPoints -> IntegritySSRHeader
..} = do
    forall t. Binary t => t -> Put
put IntegritySSRHeader
_msgSsrFlagIonoGridPoints_header
    Word8 -> Put
putWord8 Word8
_msgSsrFlagIonoGridPoints_n_faulty_points
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word16 -> Put
putWord16le [Word16]
_msgSsrFlagIonoGridPoints_faulty_points

$(makeSBP 'msgSsrFlagIonoGridPoints ''MsgSsrFlagIonoGridPoints)
$(makeJSON "_msgSsrFlagIonoGridPoints_" ''MsgSsrFlagIonoGridPoints)
$(makeLenses ''MsgSsrFlagIonoGridPoints)

msgSsrFlagIonoTileSatLos :: Word16
msgSsrFlagIonoTileSatLos :: Word16
msgSsrFlagIonoTileSatLos = Word16
0x0BCD

data MsgSsrFlagIonoTileSatLos = MsgSsrFlagIonoTileSatLos
  { MsgSsrFlagIonoTileSatLos -> IntegritySSRHeader
_msgSsrFlagIonoTileSatLos_header     :: !IntegritySSRHeader
    -- ^ Header of an integrity message.
  , MsgSsrFlagIonoTileSatLos -> Word8
_msgSsrFlagIonoTileSatLos_n_faulty_los :: !Word8
    -- ^ Number of faulty LOS.
  , MsgSsrFlagIonoTileSatLos -> [SvId]
_msgSsrFlagIonoTileSatLos_faulty_los :: ![SvId]
    -- ^ List of faulty LOS
  } deriving ( Int -> MsgSsrFlagIonoTileSatLos -> ShowS
[MsgSsrFlagIonoTileSatLos] -> ShowS
MsgSsrFlagIonoTileSatLos -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgSsrFlagIonoTileSatLos] -> ShowS
$cshowList :: [MsgSsrFlagIonoTileSatLos] -> ShowS
show :: MsgSsrFlagIonoTileSatLos -> String
$cshow :: MsgSsrFlagIonoTileSatLos -> String
showsPrec :: Int -> MsgSsrFlagIonoTileSatLos -> ShowS
$cshowsPrec :: Int -> MsgSsrFlagIonoTileSatLos -> ShowS
Show, ReadPrec [MsgSsrFlagIonoTileSatLos]
ReadPrec MsgSsrFlagIonoTileSatLos
Int -> ReadS MsgSsrFlagIonoTileSatLos
ReadS [MsgSsrFlagIonoTileSatLos]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgSsrFlagIonoTileSatLos]
$creadListPrec :: ReadPrec [MsgSsrFlagIonoTileSatLos]
readPrec :: ReadPrec MsgSsrFlagIonoTileSatLos
$creadPrec :: ReadPrec MsgSsrFlagIonoTileSatLos
readList :: ReadS [MsgSsrFlagIonoTileSatLos]
$creadList :: ReadS [MsgSsrFlagIonoTileSatLos]
readsPrec :: Int -> ReadS MsgSsrFlagIonoTileSatLos
$creadsPrec :: Int -> ReadS MsgSsrFlagIonoTileSatLos
Read, MsgSsrFlagIonoTileSatLos -> MsgSsrFlagIonoTileSatLos -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgSsrFlagIonoTileSatLos -> MsgSsrFlagIonoTileSatLos -> Bool
$c/= :: MsgSsrFlagIonoTileSatLos -> MsgSsrFlagIonoTileSatLos -> Bool
== :: MsgSsrFlagIonoTileSatLos -> MsgSsrFlagIonoTileSatLos -> Bool
$c== :: MsgSsrFlagIonoTileSatLos -> MsgSsrFlagIonoTileSatLos -> Bool
Eq )

instance Binary MsgSsrFlagIonoTileSatLos where
  get :: Get MsgSsrFlagIonoTileSatLos
get = do
    IntegritySSRHeader
_msgSsrFlagIonoTileSatLos_header <- forall t. Binary t => Get t
get
    Word8
_msgSsrFlagIonoTileSatLos_n_faulty_los <- Get Word8
getWord8
    [SvId]
_msgSsrFlagIonoTileSatLos_faulty_los <- 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 MsgSsrFlagIonoTileSatLos {[SvId]
Word8
IntegritySSRHeader
_msgSsrFlagIonoTileSatLos_faulty_los :: [SvId]
_msgSsrFlagIonoTileSatLos_n_faulty_los :: Word8
_msgSsrFlagIonoTileSatLos_header :: IntegritySSRHeader
_msgSsrFlagIonoTileSatLos_faulty_los :: [SvId]
_msgSsrFlagIonoTileSatLos_n_faulty_los :: Word8
_msgSsrFlagIonoTileSatLos_header :: IntegritySSRHeader
..}

  put :: MsgSsrFlagIonoTileSatLos -> Put
put MsgSsrFlagIonoTileSatLos {[SvId]
Word8
IntegritySSRHeader
_msgSsrFlagIonoTileSatLos_faulty_los :: [SvId]
_msgSsrFlagIonoTileSatLos_n_faulty_los :: Word8
_msgSsrFlagIonoTileSatLos_header :: IntegritySSRHeader
_msgSsrFlagIonoTileSatLos_faulty_los :: MsgSsrFlagIonoTileSatLos -> [SvId]
_msgSsrFlagIonoTileSatLos_n_faulty_los :: MsgSsrFlagIonoTileSatLos -> Word8
_msgSsrFlagIonoTileSatLos_header :: MsgSsrFlagIonoTileSatLos -> IntegritySSRHeader
..} = do
    forall t. Binary t => t -> Put
put IntegritySSRHeader
_msgSsrFlagIonoTileSatLos_header
    Word8 -> Put
putWord8 Word8
_msgSsrFlagIonoTileSatLos_n_faulty_los
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall t. Binary t => t -> Put
put [SvId]
_msgSsrFlagIonoTileSatLos_faulty_los

$(makeSBP 'msgSsrFlagIonoTileSatLos ''MsgSsrFlagIonoTileSatLos)
$(makeJSON "_msgSsrFlagIonoTileSatLos_" ''MsgSsrFlagIonoTileSatLos)
$(makeLenses ''MsgSsrFlagIonoTileSatLos)

msgSsrFlagIonoGridPointSatLos :: Word16
msgSsrFlagIonoGridPointSatLos :: Word16
msgSsrFlagIonoGridPointSatLos = Word16
0x0BD1

data MsgSsrFlagIonoGridPointSatLos = MsgSsrFlagIonoGridPointSatLos
  { MsgSsrFlagIonoGridPointSatLos -> IntegritySSRHeader
_msgSsrFlagIonoGridPointSatLos_header      :: !IntegritySSRHeader
    -- ^ Header of an integrity message.
  , MsgSsrFlagIonoGridPointSatLos -> Word16
_msgSsrFlagIonoGridPointSatLos_grid_point_id :: !Word16
    -- ^ Index of the grid point.
  , MsgSsrFlagIonoGridPointSatLos -> Word8
_msgSsrFlagIonoGridPointSatLos_n_faulty_los :: !Word8
    -- ^ Number of faulty LOS.
  , MsgSsrFlagIonoGridPointSatLos -> [SvId]
_msgSsrFlagIonoGridPointSatLos_faulty_los  :: ![SvId]
    -- ^ List of faulty LOS
  } deriving ( Int -> MsgSsrFlagIonoGridPointSatLos -> ShowS
[MsgSsrFlagIonoGridPointSatLos] -> ShowS
MsgSsrFlagIonoGridPointSatLos -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgSsrFlagIonoGridPointSatLos] -> ShowS
$cshowList :: [MsgSsrFlagIonoGridPointSatLos] -> ShowS
show :: MsgSsrFlagIonoGridPointSatLos -> String
$cshow :: MsgSsrFlagIonoGridPointSatLos -> String
showsPrec :: Int -> MsgSsrFlagIonoGridPointSatLos -> ShowS
$cshowsPrec :: Int -> MsgSsrFlagIonoGridPointSatLos -> ShowS
Show, ReadPrec [MsgSsrFlagIonoGridPointSatLos]
ReadPrec MsgSsrFlagIonoGridPointSatLos
Int -> ReadS MsgSsrFlagIonoGridPointSatLos
ReadS [MsgSsrFlagIonoGridPointSatLos]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgSsrFlagIonoGridPointSatLos]
$creadListPrec :: ReadPrec [MsgSsrFlagIonoGridPointSatLos]
readPrec :: ReadPrec MsgSsrFlagIonoGridPointSatLos
$creadPrec :: ReadPrec MsgSsrFlagIonoGridPointSatLos
readList :: ReadS [MsgSsrFlagIonoGridPointSatLos]
$creadList :: ReadS [MsgSsrFlagIonoGridPointSatLos]
readsPrec :: Int -> ReadS MsgSsrFlagIonoGridPointSatLos
$creadsPrec :: Int -> ReadS MsgSsrFlagIonoGridPointSatLos
Read, MsgSsrFlagIonoGridPointSatLos
-> MsgSsrFlagIonoGridPointSatLos -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgSsrFlagIonoGridPointSatLos
-> MsgSsrFlagIonoGridPointSatLos -> Bool
$c/= :: MsgSsrFlagIonoGridPointSatLos
-> MsgSsrFlagIonoGridPointSatLos -> Bool
== :: MsgSsrFlagIonoGridPointSatLos
-> MsgSsrFlagIonoGridPointSatLos -> Bool
$c== :: MsgSsrFlagIonoGridPointSatLos
-> MsgSsrFlagIonoGridPointSatLos -> Bool
Eq )

instance Binary MsgSsrFlagIonoGridPointSatLos where
  get :: Get MsgSsrFlagIonoGridPointSatLos
get = do
    IntegritySSRHeader
_msgSsrFlagIonoGridPointSatLos_header <- forall t. Binary t => Get t
get
    Word16
_msgSsrFlagIonoGridPointSatLos_grid_point_id <- Get Word16
getWord16le
    Word8
_msgSsrFlagIonoGridPointSatLos_n_faulty_los <- Get Word8
getWord8
    [SvId]
_msgSsrFlagIonoGridPointSatLos_faulty_los <- 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 MsgSsrFlagIonoGridPointSatLos {[SvId]
Word8
Word16
IntegritySSRHeader
_msgSsrFlagIonoGridPointSatLos_faulty_los :: [SvId]
_msgSsrFlagIonoGridPointSatLos_n_faulty_los :: Word8
_msgSsrFlagIonoGridPointSatLos_grid_point_id :: Word16
_msgSsrFlagIonoGridPointSatLos_header :: IntegritySSRHeader
_msgSsrFlagIonoGridPointSatLos_faulty_los :: [SvId]
_msgSsrFlagIonoGridPointSatLos_n_faulty_los :: Word8
_msgSsrFlagIonoGridPointSatLos_grid_point_id :: Word16
_msgSsrFlagIonoGridPointSatLos_header :: IntegritySSRHeader
..}

  put :: MsgSsrFlagIonoGridPointSatLos -> Put
put MsgSsrFlagIonoGridPointSatLos {[SvId]
Word8
Word16
IntegritySSRHeader
_msgSsrFlagIonoGridPointSatLos_faulty_los :: [SvId]
_msgSsrFlagIonoGridPointSatLos_n_faulty_los :: Word8
_msgSsrFlagIonoGridPointSatLos_grid_point_id :: Word16
_msgSsrFlagIonoGridPointSatLos_header :: IntegritySSRHeader
_msgSsrFlagIonoGridPointSatLos_faulty_los :: MsgSsrFlagIonoGridPointSatLos -> [SvId]
_msgSsrFlagIonoGridPointSatLos_n_faulty_los :: MsgSsrFlagIonoGridPointSatLos -> Word8
_msgSsrFlagIonoGridPointSatLos_grid_point_id :: MsgSsrFlagIonoGridPointSatLos -> Word16
_msgSsrFlagIonoGridPointSatLos_header :: MsgSsrFlagIonoGridPointSatLos -> IntegritySSRHeader
..} = do
    forall t. Binary t => t -> Put
put IntegritySSRHeader
_msgSsrFlagIonoGridPointSatLos_header
    Word16 -> Put
putWord16le Word16
_msgSsrFlagIonoGridPointSatLos_grid_point_id
    Word8 -> Put
putWord8 Word8
_msgSsrFlagIonoGridPointSatLos_n_faulty_los
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall t. Binary t => t -> Put
put [SvId]
_msgSsrFlagIonoGridPointSatLos_faulty_los

$(makeSBP 'msgSsrFlagIonoGridPointSatLos ''MsgSsrFlagIonoGridPointSatLos)
$(makeJSON "_msgSsrFlagIonoGridPointSatLos_" ''MsgSsrFlagIonoGridPointSatLos)
$(makeLenses ''MsgSsrFlagIonoGridPointSatLos)