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

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

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


msgMagRaw :: Word16
msgMagRaw :: Word16
msgMagRaw = Word16
0x0902

-- | SBP class for message MSG_MAG_RAW (0x0902).
--
-- Raw data from the magnetometer.
data MsgMagRaw = MsgMagRaw
  { MsgMagRaw -> Word32
_msgMagRaw_tow :: !Word32
    -- ^ Milliseconds since start of GPS week. If the high bit is set, the time
    -- is unknown or invalid.
  , MsgMagRaw -> Word8
_msgMagRaw_tow_f :: !Word8
    -- ^ Milliseconds since start of GPS week, fractional part
  , MsgMagRaw -> Int16
_msgMagRaw_mag_x :: !Int16
    -- ^ Magnetic field in the body frame X axis
  , MsgMagRaw -> Int16
_msgMagRaw_mag_y :: !Int16
    -- ^ Magnetic field in the body frame Y axis
  , MsgMagRaw -> Int16
_msgMagRaw_mag_z :: !Int16
    -- ^ Magnetic field in the body frame Z axis
  } deriving ( Int -> MsgMagRaw -> ShowS
[MsgMagRaw] -> ShowS
MsgMagRaw -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgMagRaw] -> ShowS
$cshowList :: [MsgMagRaw] -> ShowS
show :: MsgMagRaw -> String
$cshow :: MsgMagRaw -> String
showsPrec :: Int -> MsgMagRaw -> ShowS
$cshowsPrec :: Int -> MsgMagRaw -> ShowS
Show, ReadPrec [MsgMagRaw]
ReadPrec MsgMagRaw
Int -> ReadS MsgMagRaw
ReadS [MsgMagRaw]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgMagRaw]
$creadListPrec :: ReadPrec [MsgMagRaw]
readPrec :: ReadPrec MsgMagRaw
$creadPrec :: ReadPrec MsgMagRaw
readList :: ReadS [MsgMagRaw]
$creadList :: ReadS [MsgMagRaw]
readsPrec :: Int -> ReadS MsgMagRaw
$creadsPrec :: Int -> ReadS MsgMagRaw
Read, MsgMagRaw -> MsgMagRaw -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgMagRaw -> MsgMagRaw -> Bool
$c/= :: MsgMagRaw -> MsgMagRaw -> Bool
== :: MsgMagRaw -> MsgMagRaw -> Bool
$c== :: MsgMagRaw -> MsgMagRaw -> Bool
Eq )

instance Binary MsgMagRaw where
  get :: Get MsgMagRaw
get = do
    Word32
_msgMagRaw_tow <- Get Word32
getWord32le
    Word8
_msgMagRaw_tow_f <- Get Word8
getWord8
    Int16
_msgMagRaw_mag_x <- (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le)
    Int16
_msgMagRaw_mag_y <- (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le)
    Int16
_msgMagRaw_mag_z <- (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgMagRaw {Int16
Word8
Word32
_msgMagRaw_mag_z :: Int16
_msgMagRaw_mag_y :: Int16
_msgMagRaw_mag_x :: Int16
_msgMagRaw_tow_f :: Word8
_msgMagRaw_tow :: Word32
_msgMagRaw_mag_z :: Int16
_msgMagRaw_mag_y :: Int16
_msgMagRaw_mag_x :: Int16
_msgMagRaw_tow_f :: Word8
_msgMagRaw_tow :: Word32
..}

  put :: MsgMagRaw -> Put
put MsgMagRaw {Int16
Word8
Word32
_msgMagRaw_mag_z :: Int16
_msgMagRaw_mag_y :: Int16
_msgMagRaw_mag_x :: Int16
_msgMagRaw_tow_f :: Word8
_msgMagRaw_tow :: Word32
_msgMagRaw_mag_z :: MsgMagRaw -> Int16
_msgMagRaw_mag_y :: MsgMagRaw -> Int16
_msgMagRaw_mag_x :: MsgMagRaw -> Int16
_msgMagRaw_tow_f :: MsgMagRaw -> Word8
_msgMagRaw_tow :: MsgMagRaw -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgMagRaw_tow
    Word8 -> Put
putWord8 Word8
_msgMagRaw_tow_f
    (Word16 -> Put
putWord16le 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) Int16
_msgMagRaw_mag_x
    (Word16 -> Put
putWord16le 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) Int16
_msgMagRaw_mag_y
    (Word16 -> Put
putWord16le 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) Int16
_msgMagRaw_mag_z

$(makeSBP 'msgMagRaw ''MsgMagRaw)
$(makeJSON "_msgMagRaw_" ''MsgMagRaw)
$(makeLenses ''MsgMagRaw)