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

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

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


msgSbasRaw :: Word16
msgSbasRaw :: Word16
msgSbasRaw = Word16
0x7777

-- | SBP class for message MSG_SBAS_RAW (0x7777).
--
-- This message is sent once per second per SBAS satellite. ME checks the
-- parity of the data block and sends only blocks that pass the check.
data MsgSbasRaw = MsgSbasRaw
  { MsgSbasRaw -> GnssSignal
_msgSbasRaw_sid        :: !GnssSignal
    -- ^ GNSS signal identifier.
  , MsgSbasRaw -> Word32
_msgSbasRaw_tow        :: !Word32
    -- ^ GPS time-of-week at the start of the data block.
  , MsgSbasRaw -> Word8
_msgSbasRaw_message_type :: !Word8
    -- ^ SBAS message type (0-63)
  , MsgSbasRaw -> [Word8]
_msgSbasRaw_data       :: ![Word8]
    -- ^ Raw SBAS data field of 212 bits (last byte padded with zeros).
  } deriving ( Int -> MsgSbasRaw -> ShowS
[MsgSbasRaw] -> ShowS
MsgSbasRaw -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgSbasRaw] -> ShowS
$cshowList :: [MsgSbasRaw] -> ShowS
show :: MsgSbasRaw -> String
$cshow :: MsgSbasRaw -> String
showsPrec :: Int -> MsgSbasRaw -> ShowS
$cshowsPrec :: Int -> MsgSbasRaw -> ShowS
Show, ReadPrec [MsgSbasRaw]
ReadPrec MsgSbasRaw
Int -> ReadS MsgSbasRaw
ReadS [MsgSbasRaw]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgSbasRaw]
$creadListPrec :: ReadPrec [MsgSbasRaw]
readPrec :: ReadPrec MsgSbasRaw
$creadPrec :: ReadPrec MsgSbasRaw
readList :: ReadS [MsgSbasRaw]
$creadList :: ReadS [MsgSbasRaw]
readsPrec :: Int -> ReadS MsgSbasRaw
$creadsPrec :: Int -> ReadS MsgSbasRaw
Read, MsgSbasRaw -> MsgSbasRaw -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgSbasRaw -> MsgSbasRaw -> Bool
$c/= :: MsgSbasRaw -> MsgSbasRaw -> Bool
== :: MsgSbasRaw -> MsgSbasRaw -> Bool
$c== :: MsgSbasRaw -> MsgSbasRaw -> Bool
Eq )

instance Binary MsgSbasRaw where
  get :: Get MsgSbasRaw
get = do
    GnssSignal
_msgSbasRaw_sid <- forall t. Binary t => Get t
get
    Word32
_msgSbasRaw_tow <- Get Word32
getWord32le
    Word8
_msgSbasRaw_message_type <- Get Word8
getWord8
    [Word8]
_msgSbasRaw_data <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
27 Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgSbasRaw {[Word8]
Word8
Word32
GnssSignal
_msgSbasRaw_data :: [Word8]
_msgSbasRaw_message_type :: Word8
_msgSbasRaw_tow :: Word32
_msgSbasRaw_sid :: GnssSignal
_msgSbasRaw_data :: [Word8]
_msgSbasRaw_message_type :: Word8
_msgSbasRaw_tow :: Word32
_msgSbasRaw_sid :: GnssSignal
..}

  put :: MsgSbasRaw -> Put
put MsgSbasRaw {[Word8]
Word8
Word32
GnssSignal
_msgSbasRaw_data :: [Word8]
_msgSbasRaw_message_type :: Word8
_msgSbasRaw_tow :: Word32
_msgSbasRaw_sid :: GnssSignal
_msgSbasRaw_data :: MsgSbasRaw -> [Word8]
_msgSbasRaw_message_type :: MsgSbasRaw -> Word8
_msgSbasRaw_tow :: MsgSbasRaw -> Word32
_msgSbasRaw_sid :: MsgSbasRaw -> GnssSignal
..} = do
    forall t. Binary t => t -> Put
put GnssSignal
_msgSbasRaw_sid
    Word32 -> Put
putWord32le Word32
_msgSbasRaw_tow
    Word8 -> Put
putWord8 Word8
_msgSbasRaw_message_type
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
_msgSbasRaw_data

$(makeSBP 'msgSbasRaw ''MsgSbasRaw)
$(makeJSON "_msgSbasRaw_" ''MsgSbasRaw)
$(makeLenses ''MsgSbasRaw)