{-# 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) #-}


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

data MsgSsrFlagHighLevel = MsgSsrFlagHighLevel
  { MsgSsrFlagHighLevel -> [Word8]
_msgSsrFlagHighLevel_stub :: ![Word8]
  } deriving ( Int -> MsgSsrFlagHighLevel -> ShowS
[MsgSsrFlagHighLevel] -> ShowS
MsgSsrFlagHighLevel -> String
(Int -> MsgSsrFlagHighLevel -> ShowS)
-> (MsgSsrFlagHighLevel -> String)
-> ([MsgSsrFlagHighLevel] -> ShowS)
-> Show MsgSsrFlagHighLevel
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]
(Int -> ReadS MsgSsrFlagHighLevel)
-> ReadS [MsgSsrFlagHighLevel]
-> ReadPrec MsgSsrFlagHighLevel
-> ReadPrec [MsgSsrFlagHighLevel]
-> Read 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
(MsgSsrFlagHighLevel -> MsgSsrFlagHighLevel -> Bool)
-> (MsgSsrFlagHighLevel -> MsgSsrFlagHighLevel -> Bool)
-> Eq MsgSsrFlagHighLevel
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
    [Word8]
_msgSsrFlagHighLevel_stub <- Get Bool -> Get Word8 -> Get [Word8]
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m [a]
whileM (Bool -> Bool
not (Bool -> Bool) -> Get Bool -> Get Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool
isEmpty) Get Word8
getWord8
    MsgSsrFlagHighLevel -> Get MsgSsrFlagHighLevel
forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgSsrFlagHighLevel :: [Word8] -> MsgSsrFlagHighLevel
MsgSsrFlagHighLevel {[Word8]
_msgSsrFlagHighLevel_stub :: [Word8]
_msgSsrFlagHighLevel_stub :: [Word8]
..}

  put :: MsgSsrFlagHighLevel -> Put
put MsgSsrFlagHighLevel {[Word8]
_msgSsrFlagHighLevel_stub :: [Word8]
_msgSsrFlagHighLevel_stub :: MsgSsrFlagHighLevel -> [Word8]
..} = do
    (Word8 -> Put) -> [Word8] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
_msgSsrFlagHighLevel_stub

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

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

data MsgSsrFlagSatellites = MsgSsrFlagSatellites
  { MsgSsrFlagSatellites -> [Word8]
_msgSsrFlagSatellites_stub :: ![Word8]
  } deriving ( Int -> MsgSsrFlagSatellites -> ShowS
[MsgSsrFlagSatellites] -> ShowS
MsgSsrFlagSatellites -> String
(Int -> MsgSsrFlagSatellites -> ShowS)
-> (MsgSsrFlagSatellites -> String)
-> ([MsgSsrFlagSatellites] -> ShowS)
-> Show MsgSsrFlagSatellites
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]
(Int -> ReadS MsgSsrFlagSatellites)
-> ReadS [MsgSsrFlagSatellites]
-> ReadPrec MsgSsrFlagSatellites
-> ReadPrec [MsgSsrFlagSatellites]
-> Read 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
(MsgSsrFlagSatellites -> MsgSsrFlagSatellites -> Bool)
-> (MsgSsrFlagSatellites -> MsgSsrFlagSatellites -> Bool)
-> Eq MsgSsrFlagSatellites
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
    [Word8]
_msgSsrFlagSatellites_stub <- Get Bool -> Get Word8 -> Get [Word8]
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m [a]
whileM (Bool -> Bool
not (Bool -> Bool) -> Get Bool -> Get Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool
isEmpty) Get Word8
getWord8
    MsgSsrFlagSatellites -> Get MsgSsrFlagSatellites
forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgSsrFlagSatellites :: [Word8] -> MsgSsrFlagSatellites
MsgSsrFlagSatellites {[Word8]
_msgSsrFlagSatellites_stub :: [Word8]
_msgSsrFlagSatellites_stub :: [Word8]
..}

  put :: MsgSsrFlagSatellites -> Put
put MsgSsrFlagSatellites {[Word8]
_msgSsrFlagSatellites_stub :: [Word8]
_msgSsrFlagSatellites_stub :: MsgSsrFlagSatellites -> [Word8]
..} = do
    (Word8 -> Put) -> [Word8] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
_msgSsrFlagSatellites_stub

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

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

data MsgSsrFlagTropoGridPoints = MsgSsrFlagTropoGridPoints
  { MsgSsrFlagTropoGridPoints -> [Word8]
_msgSsrFlagTropoGridPoints_stub :: ![Word8]
  } deriving ( Int -> MsgSsrFlagTropoGridPoints -> ShowS
[MsgSsrFlagTropoGridPoints] -> ShowS
MsgSsrFlagTropoGridPoints -> String
(Int -> MsgSsrFlagTropoGridPoints -> ShowS)
-> (MsgSsrFlagTropoGridPoints -> String)
-> ([MsgSsrFlagTropoGridPoints] -> ShowS)
-> Show MsgSsrFlagTropoGridPoints
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]
(Int -> ReadS MsgSsrFlagTropoGridPoints)
-> ReadS [MsgSsrFlagTropoGridPoints]
-> ReadPrec MsgSsrFlagTropoGridPoints
-> ReadPrec [MsgSsrFlagTropoGridPoints]
-> Read 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
(MsgSsrFlagTropoGridPoints -> MsgSsrFlagTropoGridPoints -> Bool)
-> (MsgSsrFlagTropoGridPoints -> MsgSsrFlagTropoGridPoints -> Bool)
-> Eq MsgSsrFlagTropoGridPoints
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
    [Word8]
_msgSsrFlagTropoGridPoints_stub <- Get Bool -> Get Word8 -> Get [Word8]
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m [a]
whileM (Bool -> Bool
not (Bool -> Bool) -> Get Bool -> Get Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool
isEmpty) Get Word8
getWord8
    MsgSsrFlagTropoGridPoints -> Get MsgSsrFlagTropoGridPoints
forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgSsrFlagTropoGridPoints :: [Word8] -> MsgSsrFlagTropoGridPoints
MsgSsrFlagTropoGridPoints {[Word8]
_msgSsrFlagTropoGridPoints_stub :: [Word8]
_msgSsrFlagTropoGridPoints_stub :: [Word8]
..}

  put :: MsgSsrFlagTropoGridPoints -> Put
put MsgSsrFlagTropoGridPoints {[Word8]
_msgSsrFlagTropoGridPoints_stub :: [Word8]
_msgSsrFlagTropoGridPoints_stub :: MsgSsrFlagTropoGridPoints -> [Word8]
..} = do
    (Word8 -> Put) -> [Word8] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
_msgSsrFlagTropoGridPoints_stub

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

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

data MsgSsrFlagIonoGridPoints = MsgSsrFlagIonoGridPoints
  { MsgSsrFlagIonoGridPoints -> [Word8]
_msgSsrFlagIonoGridPoints_stub :: ![Word8]
  } deriving ( Int -> MsgSsrFlagIonoGridPoints -> ShowS
[MsgSsrFlagIonoGridPoints] -> ShowS
MsgSsrFlagIonoGridPoints -> String
(Int -> MsgSsrFlagIonoGridPoints -> ShowS)
-> (MsgSsrFlagIonoGridPoints -> String)
-> ([MsgSsrFlagIonoGridPoints] -> ShowS)
-> Show MsgSsrFlagIonoGridPoints
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]
(Int -> ReadS MsgSsrFlagIonoGridPoints)
-> ReadS [MsgSsrFlagIonoGridPoints]
-> ReadPrec MsgSsrFlagIonoGridPoints
-> ReadPrec [MsgSsrFlagIonoGridPoints]
-> Read 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
(MsgSsrFlagIonoGridPoints -> MsgSsrFlagIonoGridPoints -> Bool)
-> (MsgSsrFlagIonoGridPoints -> MsgSsrFlagIonoGridPoints -> Bool)
-> Eq MsgSsrFlagIonoGridPoints
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
    [Word8]
_msgSsrFlagIonoGridPoints_stub <- Get Bool -> Get Word8 -> Get [Word8]
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m [a]
whileM (Bool -> Bool
not (Bool -> Bool) -> Get Bool -> Get Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool
isEmpty) Get Word8
getWord8
    MsgSsrFlagIonoGridPoints -> Get MsgSsrFlagIonoGridPoints
forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgSsrFlagIonoGridPoints :: [Word8] -> MsgSsrFlagIonoGridPoints
MsgSsrFlagIonoGridPoints {[Word8]
_msgSsrFlagIonoGridPoints_stub :: [Word8]
_msgSsrFlagIonoGridPoints_stub :: [Word8]
..}

  put :: MsgSsrFlagIonoGridPoints -> Put
put MsgSsrFlagIonoGridPoints {[Word8]
_msgSsrFlagIonoGridPoints_stub :: [Word8]
_msgSsrFlagIonoGridPoints_stub :: MsgSsrFlagIonoGridPoints -> [Word8]
..} = do
    (Word8 -> Put) -> [Word8] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
_msgSsrFlagIonoGridPoints_stub

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

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

data MsgSsrFlagIonoTileSatLos = MsgSsrFlagIonoTileSatLos
  { MsgSsrFlagIonoTileSatLos -> [Word8]
_msgSsrFlagIonoTileSatLos_stub :: ![Word8]
  } deriving ( Int -> MsgSsrFlagIonoTileSatLos -> ShowS
[MsgSsrFlagIonoTileSatLos] -> ShowS
MsgSsrFlagIonoTileSatLos -> String
(Int -> MsgSsrFlagIonoTileSatLos -> ShowS)
-> (MsgSsrFlagIonoTileSatLos -> String)
-> ([MsgSsrFlagIonoTileSatLos] -> ShowS)
-> Show MsgSsrFlagIonoTileSatLos
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]
(Int -> ReadS MsgSsrFlagIonoTileSatLos)
-> ReadS [MsgSsrFlagIonoTileSatLos]
-> ReadPrec MsgSsrFlagIonoTileSatLos
-> ReadPrec [MsgSsrFlagIonoTileSatLos]
-> Read 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
(MsgSsrFlagIonoTileSatLos -> MsgSsrFlagIonoTileSatLos -> Bool)
-> (MsgSsrFlagIonoTileSatLos -> MsgSsrFlagIonoTileSatLos -> Bool)
-> Eq MsgSsrFlagIonoTileSatLos
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
    [Word8]
_msgSsrFlagIonoTileSatLos_stub <- Get Bool -> Get Word8 -> Get [Word8]
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m [a]
whileM (Bool -> Bool
not (Bool -> Bool) -> Get Bool -> Get Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool
isEmpty) Get Word8
getWord8
    MsgSsrFlagIonoTileSatLos -> Get MsgSsrFlagIonoTileSatLos
forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgSsrFlagIonoTileSatLos :: [Word8] -> MsgSsrFlagIonoTileSatLos
MsgSsrFlagIonoTileSatLos {[Word8]
_msgSsrFlagIonoTileSatLos_stub :: [Word8]
_msgSsrFlagIonoTileSatLos_stub :: [Word8]
..}

  put :: MsgSsrFlagIonoTileSatLos -> Put
put MsgSsrFlagIonoTileSatLos {[Word8]
_msgSsrFlagIonoTileSatLos_stub :: [Word8]
_msgSsrFlagIonoTileSatLos_stub :: MsgSsrFlagIonoTileSatLos -> [Word8]
..} = do
    (Word8 -> Put) -> [Word8] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
_msgSsrFlagIonoTileSatLos_stub

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

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

data MsgSsrFlagIonoGridPointSatLos = MsgSsrFlagIonoGridPointSatLos
  { MsgSsrFlagIonoGridPointSatLos -> [Word8]
_msgSsrFlagIonoGridPointSatLos_stub :: ![Word8]
  } deriving ( Int -> MsgSsrFlagIonoGridPointSatLos -> ShowS
[MsgSsrFlagIonoGridPointSatLos] -> ShowS
MsgSsrFlagIonoGridPointSatLos -> String
(Int -> MsgSsrFlagIonoGridPointSatLos -> ShowS)
-> (MsgSsrFlagIonoGridPointSatLos -> String)
-> ([MsgSsrFlagIonoGridPointSatLos] -> ShowS)
-> Show MsgSsrFlagIonoGridPointSatLos
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]
(Int -> ReadS MsgSsrFlagIonoGridPointSatLos)
-> ReadS [MsgSsrFlagIonoGridPointSatLos]
-> ReadPrec MsgSsrFlagIonoGridPointSatLos
-> ReadPrec [MsgSsrFlagIonoGridPointSatLos]
-> Read 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
(MsgSsrFlagIonoGridPointSatLos
 -> MsgSsrFlagIonoGridPointSatLos -> Bool)
-> (MsgSsrFlagIonoGridPointSatLos
    -> MsgSsrFlagIonoGridPointSatLos -> Bool)
-> Eq MsgSsrFlagIonoGridPointSatLos
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
    [Word8]
_msgSsrFlagIonoGridPointSatLos_stub <- Get Bool -> Get Word8 -> Get [Word8]
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m [a]
whileM (Bool -> Bool
not (Bool -> Bool) -> Get Bool -> Get Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool
isEmpty) Get Word8
getWord8
    MsgSsrFlagIonoGridPointSatLos -> Get MsgSsrFlagIonoGridPointSatLos
forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgSsrFlagIonoGridPointSatLos :: [Word8] -> MsgSsrFlagIonoGridPointSatLos
MsgSsrFlagIonoGridPointSatLos {[Word8]
_msgSsrFlagIonoGridPointSatLos_stub :: [Word8]
_msgSsrFlagIonoGridPointSatLos_stub :: [Word8]
..}

  put :: MsgSsrFlagIonoGridPointSatLos -> Put
put MsgSsrFlagIonoGridPointSatLos {[Word8]
_msgSsrFlagIonoGridPointSatLos_stub :: [Word8]
_msgSsrFlagIonoGridPointSatLos_stub :: MsgSsrFlagIonoGridPointSatLos -> [Word8]
..} = do
    (Word8 -> Put) -> [Word8] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
_msgSsrFlagIonoGridPointSatLos_stub

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