diff --git a/sbp.cabal b/sbp.cabal --- a/sbp.cabal +++ b/sbp.cabal @@ -1,5 +1,5 @@ name: sbp -version: 5.0.5 +version: 5.0.7 synopsis: SwiftNav's SBP Library homepage: https://github.com/swift-nav/libsbp license: MIT @@ -41,6 +41,7 @@ , SwiftNav.SBP.Observation , SwiftNav.SBP.Orientation , SwiftNav.SBP.Piksi + , SwiftNav.SBP.Profiling , SwiftNav.SBP.Sbas , SwiftNav.SBP.Settings , SwiftNav.SBP.Signing diff --git a/src/SwiftNav/SBP.hs b/src/SwiftNav/SBP.hs --- a/src/SwiftNav/SBP.hs +++ b/src/SwiftNav/SBP.hs @@ -30,6 +30,7 @@ import SwiftNav.SBP.Observation as Exports import SwiftNav.SBP.Orientation as Exports import SwiftNav.SBP.Piksi as Exports +import SwiftNav.SBP.Profiling as Exports import SwiftNav.SBP.Sbas as Exports import SwiftNav.SBP.Settings as Exports import SwiftNav.SBP.Signing as Exports diff --git a/src/SwiftNav/SBP/Msg.hs b/src/SwiftNav/SBP/Msg.hs --- a/src/SwiftNav/SBP/Msg.hs +++ b/src/SwiftNav/SBP/Msg.hs @@ -40,6 +40,7 @@ import SwiftNav.SBP.Observation import SwiftNav.SBP.Orientation import SwiftNav.SBP.Piksi +import SwiftNav.SBP.Profiling import SwiftNav.SBP.Sbas import SwiftNav.SBP.Settings import SwiftNav.SBP.Signing @@ -175,6 +176,7 @@ | SBPMsgMagRaw MsgMagRaw Msg | SBPMsgMaskSatellite MsgMaskSatellite Msg | SBPMsgMaskSatelliteDep MsgMaskSatelliteDep Msg + | SBPMsgMeasurementPoint MsgMeasurementPoint Msg | SBPMsgMeasurementState MsgMeasurementState Msg | SBPMsgNapDeviceDnaReq MsgNapDeviceDnaReq Msg | SBPMsgNapDeviceDnaResp MsgNapDeviceDnaResp Msg @@ -421,6 +423,7 @@ | _msgSBPType == msgMagRaw = SBPMsgMagRaw (decode (fromStrict (unBytes _msgSBPPayload))) m | _msgSBPType == msgMaskSatellite = SBPMsgMaskSatellite (decode (fromStrict (unBytes _msgSBPPayload))) m | _msgSBPType == msgMaskSatelliteDep = SBPMsgMaskSatelliteDep (decode (fromStrict (unBytes _msgSBPPayload))) m + | _msgSBPType == msgMeasurementPoint = SBPMsgMeasurementPoint (decode (fromStrict (unBytes _msgSBPPayload))) m | _msgSBPType == msgMeasurementState = SBPMsgMeasurementState (decode (fromStrict (unBytes _msgSBPPayload))) m | _msgSBPType == msgNapDeviceDnaReq = SBPMsgNapDeviceDnaReq (decode (fromStrict (unBytes _msgSBPPayload))) m | _msgSBPType == msgNapDeviceDnaResp = SBPMsgNapDeviceDnaResp (decode (fromStrict (unBytes _msgSBPPayload))) m @@ -659,6 +662,7 @@ encoder (SBPMsgMagRaw _ m) = put m encoder (SBPMsgMaskSatellite _ m) = put m encoder (SBPMsgMaskSatelliteDep _ m) = put m + encoder (SBPMsgMeasurementPoint _ m) = put m encoder (SBPMsgMeasurementState _ m) = put m encoder (SBPMsgNapDeviceDnaReq _ m) = put m encoder (SBPMsgNapDeviceDnaResp _ m) = put m @@ -901,6 +905,7 @@ | msgType == msgMagRaw = SBPMsgMagRaw <$> pure (decode (fromStrict (unBytes payload))) <*> parseJSON obj | msgType == msgMaskSatellite = SBPMsgMaskSatellite <$> pure (decode (fromStrict (unBytes payload))) <*> parseJSON obj | msgType == msgMaskSatelliteDep = SBPMsgMaskSatelliteDep <$> pure (decode (fromStrict (unBytes payload))) <*> parseJSON obj + | msgType == msgMeasurementPoint = SBPMsgMeasurementPoint <$> pure (decode (fromStrict (unBytes payload))) <*> parseJSON obj | msgType == msgMeasurementState = SBPMsgMeasurementState <$> pure (decode (fromStrict (unBytes payload))) <*> parseJSON obj | msgType == msgNapDeviceDnaReq = SBPMsgNapDeviceDnaReq <$> pure (decode (fromStrict (unBytes payload))) <*> parseJSON obj | msgType == msgNapDeviceDnaResp = SBPMsgNapDeviceDnaResp <$> pure (decode (fromStrict (unBytes payload))) <*> parseJSON obj @@ -1144,6 +1149,7 @@ toJSON (SBPMsgMagRaw n m) = toJSON n <<>> toJSON m toJSON (SBPMsgMaskSatellite n m) = toJSON n <<>> toJSON m toJSON (SBPMsgMaskSatelliteDep n m) = toJSON n <<>> toJSON m + toJSON (SBPMsgMeasurementPoint n m) = toJSON n <<>> toJSON m toJSON (SBPMsgMeasurementState n m) = toJSON n <<>> toJSON m toJSON (SBPMsgNapDeviceDnaReq _ m) = toJSON m toJSON (SBPMsgNapDeviceDnaResp n m) = toJSON n <<>> toJSON m @@ -1381,6 +1387,7 @@ msg f (SBPMsgMagRaw n m) = SBPMsgMagRaw n <$> f m msg f (SBPMsgMaskSatellite n m) = SBPMsgMaskSatellite n <$> f m msg f (SBPMsgMaskSatelliteDep n m) = SBPMsgMaskSatelliteDep n <$> f m + msg f (SBPMsgMeasurementPoint n m) = SBPMsgMeasurementPoint n <$> f m msg f (SBPMsgMeasurementState n m) = SBPMsgMeasurementState n <$> f m msg f (SBPMsgNapDeviceDnaReq n m) = SBPMsgNapDeviceDnaReq n <$> f m msg f (SBPMsgNapDeviceDnaResp n m) = SBPMsgNapDeviceDnaResp n <$> f m diff --git a/src/SwiftNav/SBP/Profiling.hs b/src/SwiftNav/SBP/Profiling.hs new file mode 100644 --- /dev/null +++ b/src/SwiftNav/SBP/Profiling.hs @@ -0,0 +1,93 @@ +{-# OPTIONS_GHC -fno-warn-unused-imports #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE RecordWildCards #-} + +-- | +-- Module: SwiftNav.SBP.Profiling +-- Copyright: Copyright (C) 2015-2021 Swift Navigation, Inc. +-- License: MIT +-- Contact: https://support.swiftnav.com +-- Stability: experimental +-- Portability: portable +-- +-- \< Standardized profiling messages from Swift Navigation devices. \> + +module SwiftNav.SBP.Profiling + ( module SwiftNav.SBP.Profiling + ) 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) #-} + + +msgMeasurementPoint :: Word16 +msgMeasurementPoint = 0xCF00 + +-- | SBP class for message MSG_MEASUREMENT_POINT (0xCF00). +-- +-- Tracks execution time of certain code paths in specially built products. +-- This message should only be expected and processed on the direction of +-- Swift's engineering teams. +data MsgMeasurementPoint = MsgMeasurementPoint + { _msgMeasurementPoint_total_time :: !Word32 + -- ^ Total time spent in measurement point (microseconds) + , _msgMeasurementPoint_num_executions :: !Word16 + -- ^ Number of times measurement point has executed + , _msgMeasurementPoint_min :: !Word32 + -- ^ Minimum execution time (microseconds) + , _msgMeasurementPoint_max :: !Word32 + -- ^ Maximum execution time (microseconds) + , _msgMeasurementPoint_return_addr :: !Word64 + -- ^ Return address + , _msgMeasurementPoint_id :: !Word64 + -- ^ Unique ID + , _msgMeasurementPoint_slice_time :: !Word64 + -- ^ CPU slice time (milliseconds) + , _msgMeasurementPoint_line :: !Word16 + -- ^ Line number + , _msgMeasurementPoint_func :: !Text + -- ^ Function name + } deriving ( Show, Read, Eq ) + +instance Binary MsgMeasurementPoint where + get = do + _msgMeasurementPoint_total_time <- getWord32le + _msgMeasurementPoint_num_executions <- getWord16le + _msgMeasurementPoint_min <- getWord32le + _msgMeasurementPoint_max <- getWord32le + _msgMeasurementPoint_return_addr <- getWord64le + _msgMeasurementPoint_id <- getWord64le + _msgMeasurementPoint_slice_time <- getWord64le + _msgMeasurementPoint_line <- getWord16le + _msgMeasurementPoint_func <- decodeUtf8 . toStrict <$> getRemainingLazyByteString + pure MsgMeasurementPoint {..} + + put MsgMeasurementPoint {..} = do + putWord32le _msgMeasurementPoint_total_time + putWord16le _msgMeasurementPoint_num_executions + putWord32le _msgMeasurementPoint_min + putWord32le _msgMeasurementPoint_max + putWord64le _msgMeasurementPoint_return_addr + putWord64le _msgMeasurementPoint_id + putWord64le _msgMeasurementPoint_slice_time + putWord16le _msgMeasurementPoint_line + putByteString $ encodeUtf8 _msgMeasurementPoint_func + +$(makeSBP 'msgMeasurementPoint ''MsgMeasurementPoint) +$(makeJSON "_msgMeasurementPoint_" ''MsgMeasurementPoint) +$(makeLenses ''MsgMeasurementPoint)