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

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

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


msgAcqResult :: Word16
msgAcqResult :: Word16
msgAcqResult = Word16
0x002F

-- | SBP class for message MSG_ACQ_RESULT (0x002F).
--
-- This message describes the results from an attempted GPS signal acquisition
-- search for a satellite PRN over a code phase/carrier frequency range. It
-- contains the parameters of the point in the acquisition search space with
-- the best carrier-to-noise (CN/0) ratio.
data MsgAcqResult = MsgAcqResult
  { MsgAcqResult -> Float
_msgAcqResult_cn0 :: !Float
    -- ^ CN/0 of best point
  , MsgAcqResult -> Float
_msgAcqResult_cp :: !Float
    -- ^ Code phase of best point
  , MsgAcqResult -> Float
_msgAcqResult_cf :: !Float
    -- ^ Carrier frequency of best point
  , MsgAcqResult -> GnssSignal
_msgAcqResult_sid :: !GnssSignal
    -- ^ GNSS signal for which acquisition was attempted
  } deriving ( Int -> MsgAcqResult -> ShowS
[MsgAcqResult] -> ShowS
MsgAcqResult -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgAcqResult] -> ShowS
$cshowList :: [MsgAcqResult] -> ShowS
show :: MsgAcqResult -> String
$cshow :: MsgAcqResult -> String
showsPrec :: Int -> MsgAcqResult -> ShowS
$cshowsPrec :: Int -> MsgAcqResult -> ShowS
Show, ReadPrec [MsgAcqResult]
ReadPrec MsgAcqResult
Int -> ReadS MsgAcqResult
ReadS [MsgAcqResult]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgAcqResult]
$creadListPrec :: ReadPrec [MsgAcqResult]
readPrec :: ReadPrec MsgAcqResult
$creadPrec :: ReadPrec MsgAcqResult
readList :: ReadS [MsgAcqResult]
$creadList :: ReadS [MsgAcqResult]
readsPrec :: Int -> ReadS MsgAcqResult
$creadsPrec :: Int -> ReadS MsgAcqResult
Read, MsgAcqResult -> MsgAcqResult -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgAcqResult -> MsgAcqResult -> Bool
$c/= :: MsgAcqResult -> MsgAcqResult -> Bool
== :: MsgAcqResult -> MsgAcqResult -> Bool
$c== :: MsgAcqResult -> MsgAcqResult -> Bool
Eq )

instance Binary MsgAcqResult where
  get :: Get MsgAcqResult
get = do
    Float
_msgAcqResult_cn0 <- Get Float
getFloat32le
    Float
_msgAcqResult_cp <- Get Float
getFloat32le
    Float
_msgAcqResult_cf <- Get Float
getFloat32le
    GnssSignal
_msgAcqResult_sid <- forall t. Binary t => Get t
get
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgAcqResult {Float
GnssSignal
_msgAcqResult_sid :: GnssSignal
_msgAcqResult_cf :: Float
_msgAcqResult_cp :: Float
_msgAcqResult_cn0 :: Float
_msgAcqResult_sid :: GnssSignal
_msgAcqResult_cf :: Float
_msgAcqResult_cp :: Float
_msgAcqResult_cn0 :: Float
..}

  put :: MsgAcqResult -> Put
put MsgAcqResult {Float
GnssSignal
_msgAcqResult_sid :: GnssSignal
_msgAcqResult_cf :: Float
_msgAcqResult_cp :: Float
_msgAcqResult_cn0 :: Float
_msgAcqResult_sid :: MsgAcqResult -> GnssSignal
_msgAcqResult_cf :: MsgAcqResult -> Float
_msgAcqResult_cp :: MsgAcqResult -> Float
_msgAcqResult_cn0 :: MsgAcqResult -> Float
..} = do
    Float -> Put
putFloat32le Float
_msgAcqResult_cn0
    Float -> Put
putFloat32le Float
_msgAcqResult_cp
    Float -> Put
putFloat32le Float
_msgAcqResult_cf
    forall t. Binary t => t -> Put
put GnssSignal
_msgAcqResult_sid

$(makeSBP 'msgAcqResult ''MsgAcqResult)
$(makeJSON "_msgAcqResult_" ''MsgAcqResult)
$(makeLenses ''MsgAcqResult)

msgAcqResultDepC :: Word16
msgAcqResultDepC :: Word16
msgAcqResultDepC = Word16
0x001F

-- | SBP class for message MSG_ACQ_RESULT_DEP_C (0x001F).
--
-- Deprecated.
data MsgAcqResultDepC = MsgAcqResultDepC
  { MsgAcqResultDepC -> Float
_msgAcqResultDepC_cn0 :: !Float
    -- ^ CN/0 of best point
  , MsgAcqResultDepC -> Float
_msgAcqResultDepC_cp :: !Float
    -- ^ Code phase of best point
  , MsgAcqResultDepC -> Float
_msgAcqResultDepC_cf :: !Float
    -- ^ Carrier frequency of best point
  , MsgAcqResultDepC -> GnssSignalDep
_msgAcqResultDepC_sid :: !GnssSignalDep
    -- ^ GNSS signal for which acquisition was attempted
  } deriving ( Int -> MsgAcqResultDepC -> ShowS
[MsgAcqResultDepC] -> ShowS
MsgAcqResultDepC -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgAcqResultDepC] -> ShowS
$cshowList :: [MsgAcqResultDepC] -> ShowS
show :: MsgAcqResultDepC -> String
$cshow :: MsgAcqResultDepC -> String
showsPrec :: Int -> MsgAcqResultDepC -> ShowS
$cshowsPrec :: Int -> MsgAcqResultDepC -> ShowS
Show, ReadPrec [MsgAcqResultDepC]
ReadPrec MsgAcqResultDepC
Int -> ReadS MsgAcqResultDepC
ReadS [MsgAcqResultDepC]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgAcqResultDepC]
$creadListPrec :: ReadPrec [MsgAcqResultDepC]
readPrec :: ReadPrec MsgAcqResultDepC
$creadPrec :: ReadPrec MsgAcqResultDepC
readList :: ReadS [MsgAcqResultDepC]
$creadList :: ReadS [MsgAcqResultDepC]
readsPrec :: Int -> ReadS MsgAcqResultDepC
$creadsPrec :: Int -> ReadS MsgAcqResultDepC
Read, MsgAcqResultDepC -> MsgAcqResultDepC -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgAcqResultDepC -> MsgAcqResultDepC -> Bool
$c/= :: MsgAcqResultDepC -> MsgAcqResultDepC -> Bool
== :: MsgAcqResultDepC -> MsgAcqResultDepC -> Bool
$c== :: MsgAcqResultDepC -> MsgAcqResultDepC -> Bool
Eq )

instance Binary MsgAcqResultDepC where
  get :: Get MsgAcqResultDepC
get = do
    Float
_msgAcqResultDepC_cn0 <- Get Float
getFloat32le
    Float
_msgAcqResultDepC_cp <- Get Float
getFloat32le
    Float
_msgAcqResultDepC_cf <- Get Float
getFloat32le
    GnssSignalDep
_msgAcqResultDepC_sid <- forall t. Binary t => Get t
get
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgAcqResultDepC {Float
GnssSignalDep
_msgAcqResultDepC_sid :: GnssSignalDep
_msgAcqResultDepC_cf :: Float
_msgAcqResultDepC_cp :: Float
_msgAcqResultDepC_cn0 :: Float
_msgAcqResultDepC_sid :: GnssSignalDep
_msgAcqResultDepC_cf :: Float
_msgAcqResultDepC_cp :: Float
_msgAcqResultDepC_cn0 :: Float
..}

  put :: MsgAcqResultDepC -> Put
put MsgAcqResultDepC {Float
GnssSignalDep
_msgAcqResultDepC_sid :: GnssSignalDep
_msgAcqResultDepC_cf :: Float
_msgAcqResultDepC_cp :: Float
_msgAcqResultDepC_cn0 :: Float
_msgAcqResultDepC_sid :: MsgAcqResultDepC -> GnssSignalDep
_msgAcqResultDepC_cf :: MsgAcqResultDepC -> Float
_msgAcqResultDepC_cp :: MsgAcqResultDepC -> Float
_msgAcqResultDepC_cn0 :: MsgAcqResultDepC -> Float
..} = do
    Float -> Put
putFloat32le Float
_msgAcqResultDepC_cn0
    Float -> Put
putFloat32le Float
_msgAcqResultDepC_cp
    Float -> Put
putFloat32le Float
_msgAcqResultDepC_cf
    forall t. Binary t => t -> Put
put GnssSignalDep
_msgAcqResultDepC_sid

$(makeSBP 'msgAcqResultDepC ''MsgAcqResultDepC)
$(makeJSON "_msgAcqResultDepC_" ''MsgAcqResultDepC)
$(makeLenses ''MsgAcqResultDepC)

msgAcqResultDepB :: Word16
msgAcqResultDepB :: Word16
msgAcqResultDepB = Word16
0x0014

-- | SBP class for message MSG_ACQ_RESULT_DEP_B (0x0014).
--
-- Deprecated.
data MsgAcqResultDepB = MsgAcqResultDepB
  { MsgAcqResultDepB -> Float
_msgAcqResultDepB_snr :: !Float
    -- ^ SNR of best point. Currently in arbitrary SNR points, but will be in
    -- units of dB Hz in a later revision of this message.
  , MsgAcqResultDepB -> Float
_msgAcqResultDepB_cp :: !Float
    -- ^ Code phase of best point
  , MsgAcqResultDepB -> Float
_msgAcqResultDepB_cf :: !Float
    -- ^ Carrier frequency of best point
  , MsgAcqResultDepB -> GnssSignalDep
_msgAcqResultDepB_sid :: !GnssSignalDep
    -- ^ GNSS signal for which acquisition was attempted
  } deriving ( Int -> MsgAcqResultDepB -> ShowS
[MsgAcqResultDepB] -> ShowS
MsgAcqResultDepB -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgAcqResultDepB] -> ShowS
$cshowList :: [MsgAcqResultDepB] -> ShowS
show :: MsgAcqResultDepB -> String
$cshow :: MsgAcqResultDepB -> String
showsPrec :: Int -> MsgAcqResultDepB -> ShowS
$cshowsPrec :: Int -> MsgAcqResultDepB -> ShowS
Show, ReadPrec [MsgAcqResultDepB]
ReadPrec MsgAcqResultDepB
Int -> ReadS MsgAcqResultDepB
ReadS [MsgAcqResultDepB]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgAcqResultDepB]
$creadListPrec :: ReadPrec [MsgAcqResultDepB]
readPrec :: ReadPrec MsgAcqResultDepB
$creadPrec :: ReadPrec MsgAcqResultDepB
readList :: ReadS [MsgAcqResultDepB]
$creadList :: ReadS [MsgAcqResultDepB]
readsPrec :: Int -> ReadS MsgAcqResultDepB
$creadsPrec :: Int -> ReadS MsgAcqResultDepB
Read, MsgAcqResultDepB -> MsgAcqResultDepB -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgAcqResultDepB -> MsgAcqResultDepB -> Bool
$c/= :: MsgAcqResultDepB -> MsgAcqResultDepB -> Bool
== :: MsgAcqResultDepB -> MsgAcqResultDepB -> Bool
$c== :: MsgAcqResultDepB -> MsgAcqResultDepB -> Bool
Eq )

instance Binary MsgAcqResultDepB where
  get :: Get MsgAcqResultDepB
get = do
    Float
_msgAcqResultDepB_snr <- Get Float
getFloat32le
    Float
_msgAcqResultDepB_cp <- Get Float
getFloat32le
    Float
_msgAcqResultDepB_cf <- Get Float
getFloat32le
    GnssSignalDep
_msgAcqResultDepB_sid <- forall t. Binary t => Get t
get
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgAcqResultDepB {Float
GnssSignalDep
_msgAcqResultDepB_sid :: GnssSignalDep
_msgAcqResultDepB_cf :: Float
_msgAcqResultDepB_cp :: Float
_msgAcqResultDepB_snr :: Float
_msgAcqResultDepB_sid :: GnssSignalDep
_msgAcqResultDepB_cf :: Float
_msgAcqResultDepB_cp :: Float
_msgAcqResultDepB_snr :: Float
..}

  put :: MsgAcqResultDepB -> Put
put MsgAcqResultDepB {Float
GnssSignalDep
_msgAcqResultDepB_sid :: GnssSignalDep
_msgAcqResultDepB_cf :: Float
_msgAcqResultDepB_cp :: Float
_msgAcqResultDepB_snr :: Float
_msgAcqResultDepB_sid :: MsgAcqResultDepB -> GnssSignalDep
_msgAcqResultDepB_cf :: MsgAcqResultDepB -> Float
_msgAcqResultDepB_cp :: MsgAcqResultDepB -> Float
_msgAcqResultDepB_snr :: MsgAcqResultDepB -> Float
..} = do
    Float -> Put
putFloat32le Float
_msgAcqResultDepB_snr
    Float -> Put
putFloat32le Float
_msgAcqResultDepB_cp
    Float -> Put
putFloat32le Float
_msgAcqResultDepB_cf
    forall t. Binary t => t -> Put
put GnssSignalDep
_msgAcqResultDepB_sid

$(makeSBP 'msgAcqResultDepB ''MsgAcqResultDepB)
$(makeJSON "_msgAcqResultDepB_" ''MsgAcqResultDepB)
$(makeLenses ''MsgAcqResultDepB)

msgAcqResultDepA :: Word16
msgAcqResultDepA :: Word16
msgAcqResultDepA = Word16
0x0015

-- | SBP class for message MSG_ACQ_RESULT_DEP_A (0x0015).
--
-- Deprecated.
data MsgAcqResultDepA = MsgAcqResultDepA
  { MsgAcqResultDepA -> Float
_msgAcqResultDepA_snr :: !Float
    -- ^ SNR of best point. Currently dimensionless, but will have units of dB
    -- Hz in the revision of this message.
  , MsgAcqResultDepA -> Float
_msgAcqResultDepA_cp :: !Float
    -- ^ Code phase of best point
  , MsgAcqResultDepA -> Float
_msgAcqResultDepA_cf :: !Float
    -- ^ Carrier frequency of best point
  , MsgAcqResultDepA -> Word8
_msgAcqResultDepA_prn :: !Word8
    -- ^ PRN-1 identifier of the satellite signal for which acquisition was
    -- attempted
  } deriving ( Int -> MsgAcqResultDepA -> ShowS
[MsgAcqResultDepA] -> ShowS
MsgAcqResultDepA -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgAcqResultDepA] -> ShowS
$cshowList :: [MsgAcqResultDepA] -> ShowS
show :: MsgAcqResultDepA -> String
$cshow :: MsgAcqResultDepA -> String
showsPrec :: Int -> MsgAcqResultDepA -> ShowS
$cshowsPrec :: Int -> MsgAcqResultDepA -> ShowS
Show, ReadPrec [MsgAcqResultDepA]
ReadPrec MsgAcqResultDepA
Int -> ReadS MsgAcqResultDepA
ReadS [MsgAcqResultDepA]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgAcqResultDepA]
$creadListPrec :: ReadPrec [MsgAcqResultDepA]
readPrec :: ReadPrec MsgAcqResultDepA
$creadPrec :: ReadPrec MsgAcqResultDepA
readList :: ReadS [MsgAcqResultDepA]
$creadList :: ReadS [MsgAcqResultDepA]
readsPrec :: Int -> ReadS MsgAcqResultDepA
$creadsPrec :: Int -> ReadS MsgAcqResultDepA
Read, MsgAcqResultDepA -> MsgAcqResultDepA -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgAcqResultDepA -> MsgAcqResultDepA -> Bool
$c/= :: MsgAcqResultDepA -> MsgAcqResultDepA -> Bool
== :: MsgAcqResultDepA -> MsgAcqResultDepA -> Bool
$c== :: MsgAcqResultDepA -> MsgAcqResultDepA -> Bool
Eq )

instance Binary MsgAcqResultDepA where
  get :: Get MsgAcqResultDepA
get = do
    Float
_msgAcqResultDepA_snr <- Get Float
getFloat32le
    Float
_msgAcqResultDepA_cp <- Get Float
getFloat32le
    Float
_msgAcqResultDepA_cf <- Get Float
getFloat32le
    Word8
_msgAcqResultDepA_prn <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgAcqResultDepA {Float
Word8
_msgAcqResultDepA_prn :: Word8
_msgAcqResultDepA_cf :: Float
_msgAcqResultDepA_cp :: Float
_msgAcqResultDepA_snr :: Float
_msgAcqResultDepA_prn :: Word8
_msgAcqResultDepA_cf :: Float
_msgAcqResultDepA_cp :: Float
_msgAcqResultDepA_snr :: Float
..}

  put :: MsgAcqResultDepA -> Put
put MsgAcqResultDepA {Float
Word8
_msgAcqResultDepA_prn :: Word8
_msgAcqResultDepA_cf :: Float
_msgAcqResultDepA_cp :: Float
_msgAcqResultDepA_snr :: Float
_msgAcqResultDepA_prn :: MsgAcqResultDepA -> Word8
_msgAcqResultDepA_cf :: MsgAcqResultDepA -> Float
_msgAcqResultDepA_cp :: MsgAcqResultDepA -> Float
_msgAcqResultDepA_snr :: MsgAcqResultDepA -> Float
..} = do
    Float -> Put
putFloat32le Float
_msgAcqResultDepA_snr
    Float -> Put
putFloat32le Float
_msgAcqResultDepA_cp
    Float -> Put
putFloat32le Float
_msgAcqResultDepA_cf
    Word8 -> Put
putWord8 Word8
_msgAcqResultDepA_prn

$(makeSBP 'msgAcqResultDepA ''MsgAcqResultDepA)
$(makeJSON "_msgAcqResultDepA_" ''MsgAcqResultDepA)
$(makeLenses ''MsgAcqResultDepA)

-- | AcqSvProfile.
--
-- Profile for a specific SV for debugging purposes. The message describes SV
-- profile during acquisition time. The message is used to debug and measure
-- the performance.
data AcqSvProfile = AcqSvProfile
  { AcqSvProfile -> Word8
_acqSvProfile_job_type :: !Word8
    -- ^ SV search job type (deep, fallback, etc)
  , AcqSvProfile -> Word8
_acqSvProfile_status   :: !Word8
    -- ^ Acquisition status 1 is Success, 0 is Failure
  , AcqSvProfile -> Word16
_acqSvProfile_cn0      :: !Word16
    -- ^ CN0 value. Only valid if status is '1'
  , AcqSvProfile -> Word8
_acqSvProfile_int_time :: !Word8
    -- ^ Acquisition integration time
  , AcqSvProfile -> GnssSignal
_acqSvProfile_sid      :: !GnssSignal
    -- ^ GNSS signal for which acquisition was attempted
  , AcqSvProfile -> Word16
_acqSvProfile_bin_width :: !Word16
    -- ^ Acq frequency bin width
  , AcqSvProfile -> Word32
_acqSvProfile_timestamp :: !Word32
    -- ^ Timestamp of the job complete event
  , AcqSvProfile -> Word32
_acqSvProfile_time_spent :: !Word32
    -- ^ Time spent to search for sid.code
  , AcqSvProfile -> Int32
_acqSvProfile_cf_min   :: !Int32
    -- ^ Doppler range lowest frequency
  , AcqSvProfile -> Int32
_acqSvProfile_cf_max   :: !Int32
    -- ^ Doppler range highest frequency
  , AcqSvProfile -> Int32
_acqSvProfile_cf       :: !Int32
    -- ^ Doppler value of detected peak. Only valid if status is '1'
  , AcqSvProfile -> Word32
_acqSvProfile_cp       :: !Word32
    -- ^ Codephase of detected peak. Only valid if status is '1'
  } deriving ( Int -> AcqSvProfile -> ShowS
[AcqSvProfile] -> ShowS
AcqSvProfile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AcqSvProfile] -> ShowS
$cshowList :: [AcqSvProfile] -> ShowS
show :: AcqSvProfile -> String
$cshow :: AcqSvProfile -> String
showsPrec :: Int -> AcqSvProfile -> ShowS
$cshowsPrec :: Int -> AcqSvProfile -> ShowS
Show, ReadPrec [AcqSvProfile]
ReadPrec AcqSvProfile
Int -> ReadS AcqSvProfile
ReadS [AcqSvProfile]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AcqSvProfile]
$creadListPrec :: ReadPrec [AcqSvProfile]
readPrec :: ReadPrec AcqSvProfile
$creadPrec :: ReadPrec AcqSvProfile
readList :: ReadS [AcqSvProfile]
$creadList :: ReadS [AcqSvProfile]
readsPrec :: Int -> ReadS AcqSvProfile
$creadsPrec :: Int -> ReadS AcqSvProfile
Read, AcqSvProfile -> AcqSvProfile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AcqSvProfile -> AcqSvProfile -> Bool
$c/= :: AcqSvProfile -> AcqSvProfile -> Bool
== :: AcqSvProfile -> AcqSvProfile -> Bool
$c== :: AcqSvProfile -> AcqSvProfile -> Bool
Eq )

instance Binary AcqSvProfile where
  get :: Get AcqSvProfile
get = do
    Word8
_acqSvProfile_job_type <- Get Word8
getWord8
    Word8
_acqSvProfile_status <- Get Word8
getWord8
    Word16
_acqSvProfile_cn0 <- Get Word16
getWord16le
    Word8
_acqSvProfile_int_time <- Get Word8
getWord8
    GnssSignal
_acqSvProfile_sid <- forall t. Binary t => Get t
get
    Word16
_acqSvProfile_bin_width <- Get Word16
getWord16le
    Word32
_acqSvProfile_timestamp <- Get Word32
getWord32le
    Word32
_acqSvProfile_time_spent <- Get Word32
getWord32le
    Int32
_acqSvProfile_cf_min <- (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
_acqSvProfile_cf_max <- (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
_acqSvProfile_cf <- (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
_acqSvProfile_cp <- Get Word32
getWord32le
    forall (f :: * -> *) a. Applicative f => a -> f a
pure AcqSvProfile {Int32
Word8
Word16
Word32
GnssSignal
_acqSvProfile_cp :: Word32
_acqSvProfile_cf :: Int32
_acqSvProfile_cf_max :: Int32
_acqSvProfile_cf_min :: Int32
_acqSvProfile_time_spent :: Word32
_acqSvProfile_timestamp :: Word32
_acqSvProfile_bin_width :: Word16
_acqSvProfile_sid :: GnssSignal
_acqSvProfile_int_time :: Word8
_acqSvProfile_cn0 :: Word16
_acqSvProfile_status :: Word8
_acqSvProfile_job_type :: Word8
_acqSvProfile_cp :: Word32
_acqSvProfile_cf :: Int32
_acqSvProfile_cf_max :: Int32
_acqSvProfile_cf_min :: Int32
_acqSvProfile_time_spent :: Word32
_acqSvProfile_timestamp :: Word32
_acqSvProfile_bin_width :: Word16
_acqSvProfile_sid :: GnssSignal
_acqSvProfile_int_time :: Word8
_acqSvProfile_cn0 :: Word16
_acqSvProfile_status :: Word8
_acqSvProfile_job_type :: Word8
..}

  put :: AcqSvProfile -> Put
put AcqSvProfile {Int32
Word8
Word16
Word32
GnssSignal
_acqSvProfile_cp :: Word32
_acqSvProfile_cf :: Int32
_acqSvProfile_cf_max :: Int32
_acqSvProfile_cf_min :: Int32
_acqSvProfile_time_spent :: Word32
_acqSvProfile_timestamp :: Word32
_acqSvProfile_bin_width :: Word16
_acqSvProfile_sid :: GnssSignal
_acqSvProfile_int_time :: Word8
_acqSvProfile_cn0 :: Word16
_acqSvProfile_status :: Word8
_acqSvProfile_job_type :: Word8
_acqSvProfile_cp :: AcqSvProfile -> Word32
_acqSvProfile_cf :: AcqSvProfile -> Int32
_acqSvProfile_cf_max :: AcqSvProfile -> Int32
_acqSvProfile_cf_min :: AcqSvProfile -> Int32
_acqSvProfile_time_spent :: AcqSvProfile -> Word32
_acqSvProfile_timestamp :: AcqSvProfile -> Word32
_acqSvProfile_bin_width :: AcqSvProfile -> Word16
_acqSvProfile_sid :: AcqSvProfile -> GnssSignal
_acqSvProfile_int_time :: AcqSvProfile -> Word8
_acqSvProfile_cn0 :: AcqSvProfile -> Word16
_acqSvProfile_status :: AcqSvProfile -> Word8
_acqSvProfile_job_type :: AcqSvProfile -> Word8
..} = do
    Word8 -> Put
putWord8 Word8
_acqSvProfile_job_type
    Word8 -> Put
putWord8 Word8
_acqSvProfile_status
    Word16 -> Put
putWord16le Word16
_acqSvProfile_cn0
    Word8 -> Put
putWord8 Word8
_acqSvProfile_int_time
    forall t. Binary t => t -> Put
put GnssSignal
_acqSvProfile_sid
    Word16 -> Put
putWord16le Word16
_acqSvProfile_bin_width
    Word32 -> Put
putWord32le Word32
_acqSvProfile_timestamp
    Word32 -> Put
putWord32le Word32
_acqSvProfile_time_spent
    (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
_acqSvProfile_cf_min
    (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
_acqSvProfile_cf_max
    (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
_acqSvProfile_cf
    Word32 -> Put
putWord32le Word32
_acqSvProfile_cp

$(makeJSON "_acqSvProfile_" ''AcqSvProfile)
$(makeLenses ''AcqSvProfile)

-- | AcqSvProfileDep.
--
-- Deprecated.
data AcqSvProfileDep = AcqSvProfileDep
  { AcqSvProfileDep -> Word8
_acqSvProfileDep_job_type :: !Word8
    -- ^ SV search job type (deep, fallback, etc)
  , AcqSvProfileDep -> Word8
_acqSvProfileDep_status   :: !Word8
    -- ^ Acquisition status 1 is Success, 0 is Failure
  , AcqSvProfileDep -> Word16
_acqSvProfileDep_cn0      :: !Word16
    -- ^ CN0 value. Only valid if status is '1'
  , AcqSvProfileDep -> Word8
_acqSvProfileDep_int_time :: !Word8
    -- ^ Acquisition integration time
  , AcqSvProfileDep -> GnssSignalDep
_acqSvProfileDep_sid      :: !GnssSignalDep
    -- ^ GNSS signal for which acquisition was attempted
  , AcqSvProfileDep -> Word16
_acqSvProfileDep_bin_width :: !Word16
    -- ^ Acq frequency bin width
  , AcqSvProfileDep -> Word32
_acqSvProfileDep_timestamp :: !Word32
    -- ^ Timestamp of the job complete event
  , AcqSvProfileDep -> Word32
_acqSvProfileDep_time_spent :: !Word32
    -- ^ Time spent to search for sid.code
  , AcqSvProfileDep -> Int32
_acqSvProfileDep_cf_min   :: !Int32
    -- ^ Doppler range lowest frequency
  , AcqSvProfileDep -> Int32
_acqSvProfileDep_cf_max   :: !Int32
    -- ^ Doppler range highest frequency
  , AcqSvProfileDep -> Int32
_acqSvProfileDep_cf       :: !Int32
    -- ^ Doppler value of detected peak. Only valid if status is '1'
  , AcqSvProfileDep -> Word32
_acqSvProfileDep_cp       :: !Word32
    -- ^ Codephase of detected peak. Only valid if status is '1'
  } deriving ( Int -> AcqSvProfileDep -> ShowS
[AcqSvProfileDep] -> ShowS
AcqSvProfileDep -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AcqSvProfileDep] -> ShowS
$cshowList :: [AcqSvProfileDep] -> ShowS
show :: AcqSvProfileDep -> String
$cshow :: AcqSvProfileDep -> String
showsPrec :: Int -> AcqSvProfileDep -> ShowS
$cshowsPrec :: Int -> AcqSvProfileDep -> ShowS
Show, ReadPrec [AcqSvProfileDep]
ReadPrec AcqSvProfileDep
Int -> ReadS AcqSvProfileDep
ReadS [AcqSvProfileDep]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AcqSvProfileDep]
$creadListPrec :: ReadPrec [AcqSvProfileDep]
readPrec :: ReadPrec AcqSvProfileDep
$creadPrec :: ReadPrec AcqSvProfileDep
readList :: ReadS [AcqSvProfileDep]
$creadList :: ReadS [AcqSvProfileDep]
readsPrec :: Int -> ReadS AcqSvProfileDep
$creadsPrec :: Int -> ReadS AcqSvProfileDep
Read, AcqSvProfileDep -> AcqSvProfileDep -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AcqSvProfileDep -> AcqSvProfileDep -> Bool
$c/= :: AcqSvProfileDep -> AcqSvProfileDep -> Bool
== :: AcqSvProfileDep -> AcqSvProfileDep -> Bool
$c== :: AcqSvProfileDep -> AcqSvProfileDep -> Bool
Eq )

instance Binary AcqSvProfileDep where
  get :: Get AcqSvProfileDep
get = do
    Word8
_acqSvProfileDep_job_type <- Get Word8
getWord8
    Word8
_acqSvProfileDep_status <- Get Word8
getWord8
    Word16
_acqSvProfileDep_cn0 <- Get Word16
getWord16le
    Word8
_acqSvProfileDep_int_time <- Get Word8
getWord8
    GnssSignalDep
_acqSvProfileDep_sid <- forall t. Binary t => Get t
get
    Word16
_acqSvProfileDep_bin_width <- Get Word16
getWord16le
    Word32
_acqSvProfileDep_timestamp <- Get Word32
getWord32le
    Word32
_acqSvProfileDep_time_spent <- Get Word32
getWord32le
    Int32
_acqSvProfileDep_cf_min <- (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
_acqSvProfileDep_cf_max <- (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
_acqSvProfileDep_cf <- (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
_acqSvProfileDep_cp <- Get Word32
getWord32le
    forall (f :: * -> *) a. Applicative f => a -> f a
pure AcqSvProfileDep {Int32
Word8
Word16
Word32
GnssSignalDep
_acqSvProfileDep_cp :: Word32
_acqSvProfileDep_cf :: Int32
_acqSvProfileDep_cf_max :: Int32
_acqSvProfileDep_cf_min :: Int32
_acqSvProfileDep_time_spent :: Word32
_acqSvProfileDep_timestamp :: Word32
_acqSvProfileDep_bin_width :: Word16
_acqSvProfileDep_sid :: GnssSignalDep
_acqSvProfileDep_int_time :: Word8
_acqSvProfileDep_cn0 :: Word16
_acqSvProfileDep_status :: Word8
_acqSvProfileDep_job_type :: Word8
_acqSvProfileDep_cp :: Word32
_acqSvProfileDep_cf :: Int32
_acqSvProfileDep_cf_max :: Int32
_acqSvProfileDep_cf_min :: Int32
_acqSvProfileDep_time_spent :: Word32
_acqSvProfileDep_timestamp :: Word32
_acqSvProfileDep_bin_width :: Word16
_acqSvProfileDep_sid :: GnssSignalDep
_acqSvProfileDep_int_time :: Word8
_acqSvProfileDep_cn0 :: Word16
_acqSvProfileDep_status :: Word8
_acqSvProfileDep_job_type :: Word8
..}

  put :: AcqSvProfileDep -> Put
put AcqSvProfileDep {Int32
Word8
Word16
Word32
GnssSignalDep
_acqSvProfileDep_cp :: Word32
_acqSvProfileDep_cf :: Int32
_acqSvProfileDep_cf_max :: Int32
_acqSvProfileDep_cf_min :: Int32
_acqSvProfileDep_time_spent :: Word32
_acqSvProfileDep_timestamp :: Word32
_acqSvProfileDep_bin_width :: Word16
_acqSvProfileDep_sid :: GnssSignalDep
_acqSvProfileDep_int_time :: Word8
_acqSvProfileDep_cn0 :: Word16
_acqSvProfileDep_status :: Word8
_acqSvProfileDep_job_type :: Word8
_acqSvProfileDep_cp :: AcqSvProfileDep -> Word32
_acqSvProfileDep_cf :: AcqSvProfileDep -> Int32
_acqSvProfileDep_cf_max :: AcqSvProfileDep -> Int32
_acqSvProfileDep_cf_min :: AcqSvProfileDep -> Int32
_acqSvProfileDep_time_spent :: AcqSvProfileDep -> Word32
_acqSvProfileDep_timestamp :: AcqSvProfileDep -> Word32
_acqSvProfileDep_bin_width :: AcqSvProfileDep -> Word16
_acqSvProfileDep_sid :: AcqSvProfileDep -> GnssSignalDep
_acqSvProfileDep_int_time :: AcqSvProfileDep -> Word8
_acqSvProfileDep_cn0 :: AcqSvProfileDep -> Word16
_acqSvProfileDep_status :: AcqSvProfileDep -> Word8
_acqSvProfileDep_job_type :: AcqSvProfileDep -> Word8
..} = do
    Word8 -> Put
putWord8 Word8
_acqSvProfileDep_job_type
    Word8 -> Put
putWord8 Word8
_acqSvProfileDep_status
    Word16 -> Put
putWord16le Word16
_acqSvProfileDep_cn0
    Word8 -> Put
putWord8 Word8
_acqSvProfileDep_int_time
    forall t. Binary t => t -> Put
put GnssSignalDep
_acqSvProfileDep_sid
    Word16 -> Put
putWord16le Word16
_acqSvProfileDep_bin_width
    Word32 -> Put
putWord32le Word32
_acqSvProfileDep_timestamp
    Word32 -> Put
putWord32le Word32
_acqSvProfileDep_time_spent
    (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
_acqSvProfileDep_cf_min
    (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
_acqSvProfileDep_cf_max
    (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
_acqSvProfileDep_cf
    Word32 -> Put
putWord32le Word32
_acqSvProfileDep_cp

$(makeJSON "_acqSvProfileDep_" ''AcqSvProfileDep)
$(makeLenses ''AcqSvProfileDep)

msgAcqSvProfile :: Word16
msgAcqSvProfile :: Word16
msgAcqSvProfile = Word16
0x002E

-- | SBP class for message MSG_ACQ_SV_PROFILE (0x002E).
--
-- The message describes all SV profiles during acquisition time. The message
-- is used to debug and measure the performance.
data MsgAcqSvProfile = MsgAcqSvProfile
  { MsgAcqSvProfile -> [AcqSvProfile]
_msgAcqSvProfile_acq_sv_profile :: ![AcqSvProfile]
    -- ^ SV profiles during acquisition time
  } deriving ( Int -> MsgAcqSvProfile -> ShowS
[MsgAcqSvProfile] -> ShowS
MsgAcqSvProfile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgAcqSvProfile] -> ShowS
$cshowList :: [MsgAcqSvProfile] -> ShowS
show :: MsgAcqSvProfile -> String
$cshow :: MsgAcqSvProfile -> String
showsPrec :: Int -> MsgAcqSvProfile -> ShowS
$cshowsPrec :: Int -> MsgAcqSvProfile -> ShowS
Show, ReadPrec [MsgAcqSvProfile]
ReadPrec MsgAcqSvProfile
Int -> ReadS MsgAcqSvProfile
ReadS [MsgAcqSvProfile]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgAcqSvProfile]
$creadListPrec :: ReadPrec [MsgAcqSvProfile]
readPrec :: ReadPrec MsgAcqSvProfile
$creadPrec :: ReadPrec MsgAcqSvProfile
readList :: ReadS [MsgAcqSvProfile]
$creadList :: ReadS [MsgAcqSvProfile]
readsPrec :: Int -> ReadS MsgAcqSvProfile
$creadsPrec :: Int -> ReadS MsgAcqSvProfile
Read, MsgAcqSvProfile -> MsgAcqSvProfile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgAcqSvProfile -> MsgAcqSvProfile -> Bool
$c/= :: MsgAcqSvProfile -> MsgAcqSvProfile -> Bool
== :: MsgAcqSvProfile -> MsgAcqSvProfile -> Bool
$c== :: MsgAcqSvProfile -> MsgAcqSvProfile -> Bool
Eq )

instance Binary MsgAcqSvProfile where
  get :: Get MsgAcqSvProfile
get = do
    [AcqSvProfile]
_msgAcqSvProfile_acq_sv_profile <- 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 MsgAcqSvProfile {[AcqSvProfile]
_msgAcqSvProfile_acq_sv_profile :: [AcqSvProfile]
_msgAcqSvProfile_acq_sv_profile :: [AcqSvProfile]
..}

  put :: MsgAcqSvProfile -> Put
put MsgAcqSvProfile {[AcqSvProfile]
_msgAcqSvProfile_acq_sv_profile :: [AcqSvProfile]
_msgAcqSvProfile_acq_sv_profile :: MsgAcqSvProfile -> [AcqSvProfile]
..} = do
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall t. Binary t => t -> Put
put [AcqSvProfile]
_msgAcqSvProfile_acq_sv_profile

$(makeSBP 'msgAcqSvProfile ''MsgAcqSvProfile)
$(makeJSON "_msgAcqSvProfile_" ''MsgAcqSvProfile)
$(makeLenses ''MsgAcqSvProfile)

msgAcqSvProfileDep :: Word16
msgAcqSvProfileDep :: Word16
msgAcqSvProfileDep = Word16
0x001E

-- | SBP class for message MSG_ACQ_SV_PROFILE_DEP (0x001E).
--
-- Deprecated.
data MsgAcqSvProfileDep = MsgAcqSvProfileDep
  { MsgAcqSvProfileDep -> [AcqSvProfileDep]
_msgAcqSvProfileDep_acq_sv_profile :: ![AcqSvProfileDep]
    -- ^ SV profiles during acquisition time
  } deriving ( Int -> MsgAcqSvProfileDep -> ShowS
[MsgAcqSvProfileDep] -> ShowS
MsgAcqSvProfileDep -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgAcqSvProfileDep] -> ShowS
$cshowList :: [MsgAcqSvProfileDep] -> ShowS
show :: MsgAcqSvProfileDep -> String
$cshow :: MsgAcqSvProfileDep -> String
showsPrec :: Int -> MsgAcqSvProfileDep -> ShowS
$cshowsPrec :: Int -> MsgAcqSvProfileDep -> ShowS
Show, ReadPrec [MsgAcqSvProfileDep]
ReadPrec MsgAcqSvProfileDep
Int -> ReadS MsgAcqSvProfileDep
ReadS [MsgAcqSvProfileDep]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgAcqSvProfileDep]
$creadListPrec :: ReadPrec [MsgAcqSvProfileDep]
readPrec :: ReadPrec MsgAcqSvProfileDep
$creadPrec :: ReadPrec MsgAcqSvProfileDep
readList :: ReadS [MsgAcqSvProfileDep]
$creadList :: ReadS [MsgAcqSvProfileDep]
readsPrec :: Int -> ReadS MsgAcqSvProfileDep
$creadsPrec :: Int -> ReadS MsgAcqSvProfileDep
Read, MsgAcqSvProfileDep -> MsgAcqSvProfileDep -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgAcqSvProfileDep -> MsgAcqSvProfileDep -> Bool
$c/= :: MsgAcqSvProfileDep -> MsgAcqSvProfileDep -> Bool
== :: MsgAcqSvProfileDep -> MsgAcqSvProfileDep -> Bool
$c== :: MsgAcqSvProfileDep -> MsgAcqSvProfileDep -> Bool
Eq )

instance Binary MsgAcqSvProfileDep where
  get :: Get MsgAcqSvProfileDep
get = do
    [AcqSvProfileDep]
_msgAcqSvProfileDep_acq_sv_profile <- 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 MsgAcqSvProfileDep {[AcqSvProfileDep]
_msgAcqSvProfileDep_acq_sv_profile :: [AcqSvProfileDep]
_msgAcqSvProfileDep_acq_sv_profile :: [AcqSvProfileDep]
..}

  put :: MsgAcqSvProfileDep -> Put
put MsgAcqSvProfileDep {[AcqSvProfileDep]
_msgAcqSvProfileDep_acq_sv_profile :: [AcqSvProfileDep]
_msgAcqSvProfileDep_acq_sv_profile :: MsgAcqSvProfileDep -> [AcqSvProfileDep]
..} = do
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall t. Binary t => t -> Put
put [AcqSvProfileDep]
_msgAcqSvProfileDep_acq_sv_profile

$(makeSBP 'msgAcqSvProfileDep ''MsgAcqSvProfileDep)
$(makeJSON "_msgAcqSvProfileDep_" ''MsgAcqSvProfileDep)
$(makeLenses ''MsgAcqSvProfileDep)