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

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

module SwiftNav.SBP.Vehicle
  ( module SwiftNav.SBP.Vehicle
  ) 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

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


msgOdometry :: Word16
msgOdometry :: Word16
msgOdometry = Word16
0x0903

-- | SBP class for message MSG_ODOMETRY (0x0903).
--
-- Message representing the x component of vehicle velocity in the user frame
-- at the odometry reference point(s) specified by the user. The offset for
-- the odometry reference point and the definition and origin of the user
-- frame are defined through the device settings interface. There are 4
-- possible user-defined sources of this message which are labeled arbitrarily
-- source 0 through 3. If using "processor time" time tags, the receiving end
-- will expect a `MSG_GNSS_TIME_OFFSET` when a PVT fix becomes available to
-- synchronise odometry measurements with GNSS. Processor time shall roll over
-- to zero after one week.
data MsgOdometry = MsgOdometry
  { MsgOdometry -> Word32
_msgOdometry_tow    :: !Word32
    -- ^ Time field representing either milliseconds in the GPS Week or local
    -- CPU time from the producing system in milliseconds.  See the tow_source
    -- flag for the exact source of this timestamp.
  , MsgOdometry -> Int32
_msgOdometry_velocity :: !Int32
    -- ^ The signed forward component of vehicle velocity.
  , MsgOdometry -> Word8
_msgOdometry_flags  :: !Word8
    -- ^ Status flags
  } deriving ( Int -> MsgOdometry -> ShowS
[MsgOdometry] -> ShowS
MsgOdometry -> String
(Int -> MsgOdometry -> ShowS)
-> (MsgOdometry -> String)
-> ([MsgOdometry] -> ShowS)
-> Show MsgOdometry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgOdometry] -> ShowS
$cshowList :: [MsgOdometry] -> ShowS
show :: MsgOdometry -> String
$cshow :: MsgOdometry -> String
showsPrec :: Int -> MsgOdometry -> ShowS
$cshowsPrec :: Int -> MsgOdometry -> ShowS
Show, ReadPrec [MsgOdometry]
ReadPrec MsgOdometry
Int -> ReadS MsgOdometry
ReadS [MsgOdometry]
(Int -> ReadS MsgOdometry)
-> ReadS [MsgOdometry]
-> ReadPrec MsgOdometry
-> ReadPrec [MsgOdometry]
-> Read MsgOdometry
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgOdometry]
$creadListPrec :: ReadPrec [MsgOdometry]
readPrec :: ReadPrec MsgOdometry
$creadPrec :: ReadPrec MsgOdometry
readList :: ReadS [MsgOdometry]
$creadList :: ReadS [MsgOdometry]
readsPrec :: Int -> ReadS MsgOdometry
$creadsPrec :: Int -> ReadS MsgOdometry
Read, MsgOdometry -> MsgOdometry -> Bool
(MsgOdometry -> MsgOdometry -> Bool)
-> (MsgOdometry -> MsgOdometry -> Bool) -> Eq MsgOdometry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgOdometry -> MsgOdometry -> Bool
$c/= :: MsgOdometry -> MsgOdometry -> Bool
== :: MsgOdometry -> MsgOdometry -> Bool
$c== :: MsgOdometry -> MsgOdometry -> Bool
Eq )

instance Binary MsgOdometry where
  get :: Get MsgOdometry
get = do
    Word32
_msgOdometry_tow <- Get Word32
getWord32le
    Int32
_msgOdometry_velocity <- (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
_msgOdometry_flags <- Get Word8
getWord8
    MsgOdometry -> Get MsgOdometry
forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgOdometry :: Word32 -> Int32 -> Word8 -> MsgOdometry
MsgOdometry {Int32
Word8
Word32
_msgOdometry_flags :: Word8
_msgOdometry_velocity :: Int32
_msgOdometry_tow :: Word32
_msgOdometry_flags :: Word8
_msgOdometry_velocity :: Int32
_msgOdometry_tow :: Word32
..}

  put :: MsgOdometry -> Put
put MsgOdometry {Int32
Word8
Word32
_msgOdometry_flags :: Word8
_msgOdometry_velocity :: Int32
_msgOdometry_tow :: Word32
_msgOdometry_flags :: MsgOdometry -> Word8
_msgOdometry_velocity :: MsgOdometry -> Int32
_msgOdometry_tow :: MsgOdometry -> Word32
..} = do
    Word32 -> Put
putWord32le Word32
_msgOdometry_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
_msgOdometry_velocity
    Word8 -> Put
putWord8 Word8
_msgOdometry_flags

$(makeSBP 'msgOdometry ''MsgOdometry)
$(makeJSON "_msgOdometry_" ''MsgOdometry)
$(makeLenses ''MsgOdometry)

msgWheeltick :: Word16
msgWheeltick :: Word16
msgWheeltick = Word16
0x0904

-- | SBP class for message MSG_WHEELTICK (0x0904).
--
-- Message containing the accumulated distance travelled by a wheel located at
-- an odometry reference point defined by the user. The offset for the
-- odometry reference point and the definition and origin of the user frame
-- are defined through the device settings interface. The source of this
-- message is identified by the source field, which is an integer ranging from
-- 0 to 255. The timestamp associated with this message should represent the
-- time when the accumulated tick count reached the value given by the
-- contents of this message as accurately as possible. If using "local CPU
-- time" time tags, the receiving end will expect a `MSG_GNSS_TIME_OFFSET`
-- when a PVT fix becomes available to synchronise wheeltick measurements with
-- GNSS. Local CPU time shall roll over to zero after one week.
data MsgWheeltick = MsgWheeltick
  { MsgWheeltick -> Word64
_msgWheeltick_time :: !Word64
    -- ^ Time field representing either microseconds since the last PPS,
    -- microseconds in the GPS Week or local CPU time from the producing
    -- system in microseconds. See the synch_type field for the exact meaning
    -- of this timestamp.
  , MsgWheeltick -> Word8
_msgWheeltick_flags :: !Word8
    -- ^ Field indicating the type of timestamp contained in the time field.
  , MsgWheeltick -> Word8
_msgWheeltick_source :: !Word8
    -- ^ ID of the sensor producing this message
  , MsgWheeltick -> Int32
_msgWheeltick_ticks :: !Int32
    -- ^ Free-running counter of the accumulated distance for this sensor. The
    -- counter should be incrementing if travelling into one direction and
    -- decrementing when travelling in the opposite direction.
  } deriving ( Int -> MsgWheeltick -> ShowS
[MsgWheeltick] -> ShowS
MsgWheeltick -> String
(Int -> MsgWheeltick -> ShowS)
-> (MsgWheeltick -> String)
-> ([MsgWheeltick] -> ShowS)
-> Show MsgWheeltick
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgWheeltick] -> ShowS
$cshowList :: [MsgWheeltick] -> ShowS
show :: MsgWheeltick -> String
$cshow :: MsgWheeltick -> String
showsPrec :: Int -> MsgWheeltick -> ShowS
$cshowsPrec :: Int -> MsgWheeltick -> ShowS
Show, ReadPrec [MsgWheeltick]
ReadPrec MsgWheeltick
Int -> ReadS MsgWheeltick
ReadS [MsgWheeltick]
(Int -> ReadS MsgWheeltick)
-> ReadS [MsgWheeltick]
-> ReadPrec MsgWheeltick
-> ReadPrec [MsgWheeltick]
-> Read MsgWheeltick
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgWheeltick]
$creadListPrec :: ReadPrec [MsgWheeltick]
readPrec :: ReadPrec MsgWheeltick
$creadPrec :: ReadPrec MsgWheeltick
readList :: ReadS [MsgWheeltick]
$creadList :: ReadS [MsgWheeltick]
readsPrec :: Int -> ReadS MsgWheeltick
$creadsPrec :: Int -> ReadS MsgWheeltick
Read, MsgWheeltick -> MsgWheeltick -> Bool
(MsgWheeltick -> MsgWheeltick -> Bool)
-> (MsgWheeltick -> MsgWheeltick -> Bool) -> Eq MsgWheeltick
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgWheeltick -> MsgWheeltick -> Bool
$c/= :: MsgWheeltick -> MsgWheeltick -> Bool
== :: MsgWheeltick -> MsgWheeltick -> Bool
$c== :: MsgWheeltick -> MsgWheeltick -> Bool
Eq )

instance Binary MsgWheeltick where
  get :: Get MsgWheeltick
get = do
    Word64
_msgWheeltick_time <- Get Word64
getWord64le
    Word8
_msgWheeltick_flags <- Get Word8
getWord8
    Word8
_msgWheeltick_source <- Get Word8
getWord8
    Int32
_msgWheeltick_ticks <- (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)
    MsgWheeltick -> Get MsgWheeltick
forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgWheeltick :: Word64 -> Word8 -> Word8 -> Int32 -> MsgWheeltick
MsgWheeltick {Int32
Word8
Word64
_msgWheeltick_ticks :: Int32
_msgWheeltick_source :: Word8
_msgWheeltick_flags :: Word8
_msgWheeltick_time :: Word64
_msgWheeltick_ticks :: Int32
_msgWheeltick_source :: Word8
_msgWheeltick_flags :: Word8
_msgWheeltick_time :: Word64
..}

  put :: MsgWheeltick -> Put
put MsgWheeltick {Int32
Word8
Word64
_msgWheeltick_ticks :: Int32
_msgWheeltick_source :: Word8
_msgWheeltick_flags :: Word8
_msgWheeltick_time :: Word64
_msgWheeltick_ticks :: MsgWheeltick -> Int32
_msgWheeltick_source :: MsgWheeltick -> Word8
_msgWheeltick_flags :: MsgWheeltick -> Word8
_msgWheeltick_time :: MsgWheeltick -> Word64
..} = do
    Word64 -> Put
putWord64le Word64
_msgWheeltick_time
    Word8 -> Put
putWord8 Word8
_msgWheeltick_flags
    Word8 -> Put
putWord8 Word8
_msgWheeltick_source
    (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
_msgWheeltick_ticks

$(makeSBP 'msgWheeltick ''MsgWheeltick)
$(makeJSON "_msgWheeltick_" ''MsgWheeltick)
$(makeLenses ''MsgWheeltick)