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

-- |
-- Module:      SwiftNav.SBP.Gnss
-- Copyright:   Copyright (C) 2015-2021 Swift Navigation, Inc.
-- License:     MIT
-- Contact:     https://support.swiftnav.com
-- Stability:   experimental
-- Portability: portable
--
-- \< Various structs shared between modules \>

module SwiftNav.SBP.Gnss
  ( module SwiftNav.SBP.Gnss
  ) where

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

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


-- | GnssSignal.
--
-- Signal identifier containing constellation, band, and satellite identifier.
data GnssSignal = GnssSignal
  { GnssSignal -> Word8
_gnssSignal_sat :: !Word8
    -- ^ Constellation-specific satellite identifier. This field for Glonass can
    -- either be (100+FCN) where FCN is in [-7,+6] or the Slot ID in [1,28].
  , GnssSignal -> Word8
_gnssSignal_code :: !Word8
    -- ^ Signal constellation, band and code
  } deriving ( Int -> GnssSignal -> ShowS
[GnssSignal] -> ShowS
GnssSignal -> String
(Int -> GnssSignal -> ShowS)
-> (GnssSignal -> String)
-> ([GnssSignal] -> ShowS)
-> Show GnssSignal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GnssSignal] -> ShowS
$cshowList :: [GnssSignal] -> ShowS
show :: GnssSignal -> String
$cshow :: GnssSignal -> String
showsPrec :: Int -> GnssSignal -> ShowS
$cshowsPrec :: Int -> GnssSignal -> ShowS
Show, ReadPrec [GnssSignal]
ReadPrec GnssSignal
Int -> ReadS GnssSignal
ReadS [GnssSignal]
(Int -> ReadS GnssSignal)
-> ReadS [GnssSignal]
-> ReadPrec GnssSignal
-> ReadPrec [GnssSignal]
-> Read GnssSignal
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GnssSignal]
$creadListPrec :: ReadPrec [GnssSignal]
readPrec :: ReadPrec GnssSignal
$creadPrec :: ReadPrec GnssSignal
readList :: ReadS [GnssSignal]
$creadList :: ReadS [GnssSignal]
readsPrec :: Int -> ReadS GnssSignal
$creadsPrec :: Int -> ReadS GnssSignal
Read, GnssSignal -> GnssSignal -> Bool
(GnssSignal -> GnssSignal -> Bool)
-> (GnssSignal -> GnssSignal -> Bool) -> Eq GnssSignal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GnssSignal -> GnssSignal -> Bool
$c/= :: GnssSignal -> GnssSignal -> Bool
== :: GnssSignal -> GnssSignal -> Bool
$c== :: GnssSignal -> GnssSignal -> Bool
Eq )

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

  put :: GnssSignal -> Put
put GnssSignal {Word8
_gnssSignal_code :: Word8
_gnssSignal_sat :: Word8
_gnssSignal_code :: GnssSignal -> Word8
_gnssSignal_sat :: GnssSignal -> Word8
..} = do
    Word8 -> Put
putWord8 Word8
_gnssSignal_sat
    Word8 -> Put
putWord8 Word8
_gnssSignal_code

$(makeJSON "_gnssSignal_" ''GnssSignal)
$(makeLenses ''GnssSignal)

-- | SvId.
--
-- A (Constellation ID, satellite ID) tuple that uniquely identifies a space
-- vehicle.
data SvId = SvId
  { SvId -> Word8
_svId_satId       :: !Word8
    -- ^ ID of the space vehicle within its constellation
  , SvId -> Word8
_svId_constellation :: !Word8
    -- ^ Constellation ID to which the SV belongs
  } deriving ( Int -> SvId -> ShowS
[SvId] -> ShowS
SvId -> String
(Int -> SvId -> ShowS)
-> (SvId -> String) -> ([SvId] -> ShowS) -> Show SvId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SvId] -> ShowS
$cshowList :: [SvId] -> ShowS
show :: SvId -> String
$cshow :: SvId -> String
showsPrec :: Int -> SvId -> ShowS
$cshowsPrec :: Int -> SvId -> ShowS
Show, ReadPrec [SvId]
ReadPrec SvId
Int -> ReadS SvId
ReadS [SvId]
(Int -> ReadS SvId)
-> ReadS [SvId] -> ReadPrec SvId -> ReadPrec [SvId] -> Read SvId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SvId]
$creadListPrec :: ReadPrec [SvId]
readPrec :: ReadPrec SvId
$creadPrec :: ReadPrec SvId
readList :: ReadS [SvId]
$creadList :: ReadS [SvId]
readsPrec :: Int -> ReadS SvId
$creadsPrec :: Int -> ReadS SvId
Read, SvId -> SvId -> Bool
(SvId -> SvId -> Bool) -> (SvId -> SvId -> Bool) -> Eq SvId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SvId -> SvId -> Bool
$c/= :: SvId -> SvId -> Bool
== :: SvId -> SvId -> Bool
$c== :: SvId -> SvId -> Bool
Eq )

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

  put :: SvId -> Put
put SvId {Word8
_svId_constellation :: Word8
_svId_satId :: Word8
_svId_constellation :: SvId -> Word8
_svId_satId :: SvId -> Word8
..} = do
    Word8 -> Put
putWord8 Word8
_svId_satId
    Word8 -> Put
putWord8 Word8
_svId_constellation

$(makeJSON "_svId_" ''SvId)
$(makeLenses ''SvId)

-- | GnssSignalDep.
--
-- Deprecated.
data GnssSignalDep = GnssSignalDep
  { GnssSignalDep -> Word16
_gnssSignalDep_sat    :: !Word16
    -- ^ Constellation-specific satellite identifier.
    --
    -- Note: unlike GnssSignal, GPS satellites are encoded as (PRN - 1). Other
    -- constellations do not have this offset.
  , GnssSignalDep -> Word8
_gnssSignalDep_code   :: !Word8
    -- ^ Signal constellation, band and code
  , GnssSignalDep -> Word8
_gnssSignalDep_reserved :: !Word8
    -- ^ Reserved
  } deriving ( Int -> GnssSignalDep -> ShowS
[GnssSignalDep] -> ShowS
GnssSignalDep -> String
(Int -> GnssSignalDep -> ShowS)
-> (GnssSignalDep -> String)
-> ([GnssSignalDep] -> ShowS)
-> Show GnssSignalDep
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GnssSignalDep] -> ShowS
$cshowList :: [GnssSignalDep] -> ShowS
show :: GnssSignalDep -> String
$cshow :: GnssSignalDep -> String
showsPrec :: Int -> GnssSignalDep -> ShowS
$cshowsPrec :: Int -> GnssSignalDep -> ShowS
Show, ReadPrec [GnssSignalDep]
ReadPrec GnssSignalDep
Int -> ReadS GnssSignalDep
ReadS [GnssSignalDep]
(Int -> ReadS GnssSignalDep)
-> ReadS [GnssSignalDep]
-> ReadPrec GnssSignalDep
-> ReadPrec [GnssSignalDep]
-> Read GnssSignalDep
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GnssSignalDep]
$creadListPrec :: ReadPrec [GnssSignalDep]
readPrec :: ReadPrec GnssSignalDep
$creadPrec :: ReadPrec GnssSignalDep
readList :: ReadS [GnssSignalDep]
$creadList :: ReadS [GnssSignalDep]
readsPrec :: Int -> ReadS GnssSignalDep
$creadsPrec :: Int -> ReadS GnssSignalDep
Read, GnssSignalDep -> GnssSignalDep -> Bool
(GnssSignalDep -> GnssSignalDep -> Bool)
-> (GnssSignalDep -> GnssSignalDep -> Bool) -> Eq GnssSignalDep
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GnssSignalDep -> GnssSignalDep -> Bool
$c/= :: GnssSignalDep -> GnssSignalDep -> Bool
== :: GnssSignalDep -> GnssSignalDep -> Bool
$c== :: GnssSignalDep -> GnssSignalDep -> Bool
Eq )

instance Binary GnssSignalDep where
  get :: Get GnssSignalDep
get = do
    Word16
_gnssSignalDep_sat <- Get Word16
getWord16le
    Word8
_gnssSignalDep_code <- Get Word8
getWord8
    Word8
_gnssSignalDep_reserved <- Get Word8
getWord8
    GnssSignalDep -> Get GnssSignalDep
forall (f :: * -> *) a. Applicative f => a -> f a
pure GnssSignalDep :: Word16 -> Word8 -> Word8 -> GnssSignalDep
GnssSignalDep {Word8
Word16
_gnssSignalDep_reserved :: Word8
_gnssSignalDep_code :: Word8
_gnssSignalDep_sat :: Word16
_gnssSignalDep_reserved :: Word8
_gnssSignalDep_code :: Word8
_gnssSignalDep_sat :: Word16
..}

  put :: GnssSignalDep -> Put
put GnssSignalDep {Word8
Word16
_gnssSignalDep_reserved :: Word8
_gnssSignalDep_code :: Word8
_gnssSignalDep_sat :: Word16
_gnssSignalDep_reserved :: GnssSignalDep -> Word8
_gnssSignalDep_code :: GnssSignalDep -> Word8
_gnssSignalDep_sat :: GnssSignalDep -> Word16
..} = do
    Word16 -> Put
putWord16le Word16
_gnssSignalDep_sat
    Word8 -> Put
putWord8 Word8
_gnssSignalDep_code
    Word8 -> Put
putWord8 Word8
_gnssSignalDep_reserved

$(makeJSON "_gnssSignalDep_" ''GnssSignalDep)
$(makeLenses ''GnssSignalDep)

-- | GPSTimeDep.
--
-- A wire-appropriate GPS time, defined as the number of milliseconds since
-- beginning of the week on the Saturday/Sunday transition.
data GpsTimeDep = GpsTimeDep
  { GpsTimeDep -> Word32
_gpsTimeDep_tow :: !Word32
    -- ^ Milliseconds since start of GPS week
  , GpsTimeDep -> Word16
_gpsTimeDep_wn :: !Word16
    -- ^ GPS week number
  } deriving ( Int -> GpsTimeDep -> ShowS
[GpsTimeDep] -> ShowS
GpsTimeDep -> String
(Int -> GpsTimeDep -> ShowS)
-> (GpsTimeDep -> String)
-> ([GpsTimeDep] -> ShowS)
-> Show GpsTimeDep
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GpsTimeDep] -> ShowS
$cshowList :: [GpsTimeDep] -> ShowS
show :: GpsTimeDep -> String
$cshow :: GpsTimeDep -> String
showsPrec :: Int -> GpsTimeDep -> ShowS
$cshowsPrec :: Int -> GpsTimeDep -> ShowS
Show, ReadPrec [GpsTimeDep]
ReadPrec GpsTimeDep
Int -> ReadS GpsTimeDep
ReadS [GpsTimeDep]
(Int -> ReadS GpsTimeDep)
-> ReadS [GpsTimeDep]
-> ReadPrec GpsTimeDep
-> ReadPrec [GpsTimeDep]
-> Read GpsTimeDep
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GpsTimeDep]
$creadListPrec :: ReadPrec [GpsTimeDep]
readPrec :: ReadPrec GpsTimeDep
$creadPrec :: ReadPrec GpsTimeDep
readList :: ReadS [GpsTimeDep]
$creadList :: ReadS [GpsTimeDep]
readsPrec :: Int -> ReadS GpsTimeDep
$creadsPrec :: Int -> ReadS GpsTimeDep
Read, GpsTimeDep -> GpsTimeDep -> Bool
(GpsTimeDep -> GpsTimeDep -> Bool)
-> (GpsTimeDep -> GpsTimeDep -> Bool) -> Eq GpsTimeDep
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GpsTimeDep -> GpsTimeDep -> Bool
$c/= :: GpsTimeDep -> GpsTimeDep -> Bool
== :: GpsTimeDep -> GpsTimeDep -> Bool
$c== :: GpsTimeDep -> GpsTimeDep -> Bool
Eq )

instance Binary GpsTimeDep where
  get :: Get GpsTimeDep
get = do
    Word32
_gpsTimeDep_tow <- Get Word32
getWord32le
    Word16
_gpsTimeDep_wn <- Get Word16
getWord16le
    GpsTimeDep -> Get GpsTimeDep
forall (f :: * -> *) a. Applicative f => a -> f a
pure GpsTimeDep :: Word32 -> Word16 -> GpsTimeDep
GpsTimeDep {Word16
Word32
_gpsTimeDep_wn :: Word16
_gpsTimeDep_tow :: Word32
_gpsTimeDep_wn :: Word16
_gpsTimeDep_tow :: Word32
..}

  put :: GpsTimeDep -> Put
put GpsTimeDep {Word16
Word32
_gpsTimeDep_wn :: Word16
_gpsTimeDep_tow :: Word32
_gpsTimeDep_wn :: GpsTimeDep -> Word16
_gpsTimeDep_tow :: GpsTimeDep -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_gpsTimeDep_tow
    Word16 -> Put
putWord16le Word16
_gpsTimeDep_wn

$(makeJSON "_gpsTimeDep_" ''GpsTimeDep)
$(makeLenses ''GpsTimeDep)

-- | GPSTimeSec.
--
-- A GPS time, defined as the number of seconds since beginning of the week on
-- the Saturday/Sunday transition.
data GpsTimeSec = GpsTimeSec
  { GpsTimeSec -> Word32
_gpsTimeSec_tow :: !Word32
    -- ^ Seconds since start of GPS week
  , GpsTimeSec -> Word16
_gpsTimeSec_wn :: !Word16
    -- ^ GPS week number
  } deriving ( Int -> GpsTimeSec -> ShowS
[GpsTimeSec] -> ShowS
GpsTimeSec -> String
(Int -> GpsTimeSec -> ShowS)
-> (GpsTimeSec -> String)
-> ([GpsTimeSec] -> ShowS)
-> Show GpsTimeSec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GpsTimeSec] -> ShowS
$cshowList :: [GpsTimeSec] -> ShowS
show :: GpsTimeSec -> String
$cshow :: GpsTimeSec -> String
showsPrec :: Int -> GpsTimeSec -> ShowS
$cshowsPrec :: Int -> GpsTimeSec -> ShowS
Show, ReadPrec [GpsTimeSec]
ReadPrec GpsTimeSec
Int -> ReadS GpsTimeSec
ReadS [GpsTimeSec]
(Int -> ReadS GpsTimeSec)
-> ReadS [GpsTimeSec]
-> ReadPrec GpsTimeSec
-> ReadPrec [GpsTimeSec]
-> Read GpsTimeSec
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GpsTimeSec]
$creadListPrec :: ReadPrec [GpsTimeSec]
readPrec :: ReadPrec GpsTimeSec
$creadPrec :: ReadPrec GpsTimeSec
readList :: ReadS [GpsTimeSec]
$creadList :: ReadS [GpsTimeSec]
readsPrec :: Int -> ReadS GpsTimeSec
$creadsPrec :: Int -> ReadS GpsTimeSec
Read, GpsTimeSec -> GpsTimeSec -> Bool
(GpsTimeSec -> GpsTimeSec -> Bool)
-> (GpsTimeSec -> GpsTimeSec -> Bool) -> Eq GpsTimeSec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GpsTimeSec -> GpsTimeSec -> Bool
$c/= :: GpsTimeSec -> GpsTimeSec -> Bool
== :: GpsTimeSec -> GpsTimeSec -> Bool
$c== :: GpsTimeSec -> GpsTimeSec -> Bool
Eq )

instance Binary GpsTimeSec where
  get :: Get GpsTimeSec
get = do
    Word32
_gpsTimeSec_tow <- Get Word32
getWord32le
    Word16
_gpsTimeSec_wn <- Get Word16
getWord16le
    GpsTimeSec -> Get GpsTimeSec
forall (f :: * -> *) a. Applicative f => a -> f a
pure GpsTimeSec :: Word32 -> Word16 -> GpsTimeSec
GpsTimeSec {Word16
Word32
_gpsTimeSec_wn :: Word16
_gpsTimeSec_tow :: Word32
_gpsTimeSec_wn :: Word16
_gpsTimeSec_tow :: Word32
..}

  put :: GpsTimeSec -> Put
put GpsTimeSec {Word16
Word32
_gpsTimeSec_wn :: Word16
_gpsTimeSec_tow :: Word32
_gpsTimeSec_wn :: GpsTimeSec -> Word16
_gpsTimeSec_tow :: GpsTimeSec -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_gpsTimeSec_tow
    Word16 -> Put
putWord16le Word16
_gpsTimeSec_wn

$(makeJSON "_gpsTimeSec_" ''GpsTimeSec)
$(makeLenses ''GpsTimeSec)

-- | GPSTime.
--
-- A wire-appropriate receiver clock time, defined as the time since the
-- beginning of the week on the Saturday/Sunday transition. In most cases,
-- observations are epoch aligned so ns field will be 0.
data GpsTime = GpsTime
  { GpsTime -> Word32
_gpsTime_tow       :: !Word32
    -- ^ Milliseconds since start of GPS week
  , GpsTime -> Int32
_gpsTime_ns_residual :: !Int32
    -- ^ Nanosecond residual of millisecond-rounded TOW (ranges from -500000 to
    -- 500000)
  , GpsTime -> Word16
_gpsTime_wn        :: !Word16
    -- ^ GPS week number
  } deriving ( Int -> GpsTime -> ShowS
[GpsTime] -> ShowS
GpsTime -> String
(Int -> GpsTime -> ShowS)
-> (GpsTime -> String) -> ([GpsTime] -> ShowS) -> Show GpsTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GpsTime] -> ShowS
$cshowList :: [GpsTime] -> ShowS
show :: GpsTime -> String
$cshow :: GpsTime -> String
showsPrec :: Int -> GpsTime -> ShowS
$cshowsPrec :: Int -> GpsTime -> ShowS
Show, ReadPrec [GpsTime]
ReadPrec GpsTime
Int -> ReadS GpsTime
ReadS [GpsTime]
(Int -> ReadS GpsTime)
-> ReadS [GpsTime]
-> ReadPrec GpsTime
-> ReadPrec [GpsTime]
-> Read GpsTime
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GpsTime]
$creadListPrec :: ReadPrec [GpsTime]
readPrec :: ReadPrec GpsTime
$creadPrec :: ReadPrec GpsTime
readList :: ReadS [GpsTime]
$creadList :: ReadS [GpsTime]
readsPrec :: Int -> ReadS GpsTime
$creadsPrec :: Int -> ReadS GpsTime
Read, GpsTime -> GpsTime -> Bool
(GpsTime -> GpsTime -> Bool)
-> (GpsTime -> GpsTime -> Bool) -> Eq GpsTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GpsTime -> GpsTime -> Bool
$c/= :: GpsTime -> GpsTime -> Bool
== :: GpsTime -> GpsTime -> Bool
$c== :: GpsTime -> GpsTime -> Bool
Eq )

instance Binary GpsTime where
  get :: Get GpsTime
get = do
    Word32
_gpsTime_tow <- Get Word32
getWord32le
    Int32
_gpsTime_ns_residual <- (Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int32) -> Get Word32 -> Get Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le)
    Word16
_gpsTime_wn <- Get Word16
getWord16le
    GpsTime -> Get GpsTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure GpsTime :: Word32 -> Int32 -> Word16 -> GpsTime
GpsTime {Int32
Word16
Word32
_gpsTime_wn :: Word16
_gpsTime_ns_residual :: Int32
_gpsTime_tow :: Word32
_gpsTime_wn :: Word16
_gpsTime_ns_residual :: Int32
_gpsTime_tow :: Word32
..}

  put :: GpsTime -> Put
put GpsTime {Int32
Word16
Word32
_gpsTime_wn :: Word16
_gpsTime_ns_residual :: Int32
_gpsTime_tow :: Word32
_gpsTime_wn :: GpsTime -> Word16
_gpsTime_ns_residual :: GpsTime -> Int32
_gpsTime_tow :: GpsTime -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_gpsTime_tow
    (Word32 -> Put
putWord32le (Word32 -> Put) -> (Int32 -> Word32) -> Int32 -> Put
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral) Int32
_gpsTime_ns_residual
    Word16 -> Put
putWord16le Word16
_gpsTime_wn

$(makeJSON "_gpsTime_" ''GpsTime)
$(makeLenses ''GpsTime)

-- | CarrierPhase.
--
-- Carrier phase measurement in cycles represented as a 40-bit fixed point
-- number with Q32.8 layout, i.e. 32-bits of whole cycles and 8-bits of
-- fractional cycles. This phase has the same sign as the pseudorange.
data CarrierPhase = CarrierPhase
  { CarrierPhase -> Int32
_carrierPhase_i :: !Int32
    -- ^ Carrier phase whole cycles
  , CarrierPhase -> Word8
_carrierPhase_f :: !Word8
    -- ^ Carrier phase fractional part
  } deriving ( Int -> CarrierPhase -> ShowS
[CarrierPhase] -> ShowS
CarrierPhase -> String
(Int -> CarrierPhase -> ShowS)
-> (CarrierPhase -> String)
-> ([CarrierPhase] -> ShowS)
-> Show CarrierPhase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CarrierPhase] -> ShowS
$cshowList :: [CarrierPhase] -> ShowS
show :: CarrierPhase -> String
$cshow :: CarrierPhase -> String
showsPrec :: Int -> CarrierPhase -> ShowS
$cshowsPrec :: Int -> CarrierPhase -> ShowS
Show, ReadPrec [CarrierPhase]
ReadPrec CarrierPhase
Int -> ReadS CarrierPhase
ReadS [CarrierPhase]
(Int -> ReadS CarrierPhase)
-> ReadS [CarrierPhase]
-> ReadPrec CarrierPhase
-> ReadPrec [CarrierPhase]
-> Read CarrierPhase
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CarrierPhase]
$creadListPrec :: ReadPrec [CarrierPhase]
readPrec :: ReadPrec CarrierPhase
$creadPrec :: ReadPrec CarrierPhase
readList :: ReadS [CarrierPhase]
$creadList :: ReadS [CarrierPhase]
readsPrec :: Int -> ReadS CarrierPhase
$creadsPrec :: Int -> ReadS CarrierPhase
Read, CarrierPhase -> CarrierPhase -> Bool
(CarrierPhase -> CarrierPhase -> Bool)
-> (CarrierPhase -> CarrierPhase -> Bool) -> Eq CarrierPhase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CarrierPhase -> CarrierPhase -> Bool
$c/= :: CarrierPhase -> CarrierPhase -> Bool
== :: CarrierPhase -> CarrierPhase -> Bool
$c== :: CarrierPhase -> CarrierPhase -> Bool
Eq )

instance Binary CarrierPhase where
  get :: Get CarrierPhase
get = do
    Int32
_carrierPhase_i <- (Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int32) -> Get Word32 -> Get Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le)
    Word8
_carrierPhase_f <- Get Word8
getWord8
    CarrierPhase -> Get CarrierPhase
forall (f :: * -> *) a. Applicative f => a -> f a
pure CarrierPhase :: Int32 -> Word8 -> CarrierPhase
CarrierPhase {Int32
Word8
_carrierPhase_f :: Word8
_carrierPhase_i :: Int32
_carrierPhase_f :: Word8
_carrierPhase_i :: Int32
..}

  put :: CarrierPhase -> Put
put CarrierPhase {Int32
Word8
_carrierPhase_f :: Word8
_carrierPhase_i :: Int32
_carrierPhase_f :: CarrierPhase -> Word8
_carrierPhase_i :: CarrierPhase -> Int32
..} = do
    (Word32 -> Put
putWord32le (Word32 -> Put) -> (Int32 -> Word32) -> Int32 -> Put
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral) Int32
_carrierPhase_i
    Word8 -> Put
putWord8 Word8
_carrierPhase_f

$(makeJSON "_carrierPhase_" ''CarrierPhase)
$(makeLenses ''CarrierPhase)