diff --git a/sbp.cabal b/sbp.cabal --- a/sbp.cabal +++ b/sbp.cabal @@ -1,5 +1,5 @@ name: sbp -version: 0.50.3 +version: 0.50.4 synopsis: SwiftNav's SBP Library homepage: https://github.com/swift-nav/libsbp license: LGPL-3 @@ -23,7 +23,8 @@ location: git@github.com:swift-nav/libsbp.git library - exposed-modules: SwiftNav.SBP + exposed-modules: SwiftNav.CRC16 + , SwiftNav.SBP , SwiftNav.SBP.Acquisition , SwiftNav.SBP.Bootload , SwiftNav.SBP.ExtEvents @@ -36,12 +37,52 @@ , SwiftNav.SBP.Settings , SwiftNav.SBP.System , SwiftNav.SBP.Tracking + , SwiftNav.SBP.Encoding default-language: Haskell2010 hs-source-dirs: src - ghc-options: -Wall -fno-warn-unused-imports - build-depends: base >= 4.7 && < 5 + ghc-options: -Wall -fno-warn-unused-imports -fno-warn-orphans + build-depends: aeson + , array + , base >= 4.7 && < 5 + , base64-bytestring + , basic-prelude , binary , bytestring , data-binary-ieee754 , monad-loops + , text default-extensions: RecordWildCards + TemplateHaskell + NoImplicitPrelude + +test-suite test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Test.hs + other-modules: Test.SwiftNav.CRC16 + , Test.SwiftNav.SBP.Acquisition + , Test.SwiftNav.SBP.Bootload + , Test.SwiftNav.SBP.Encoding + , Test.SwiftNav.SBP.ExtEvents + , Test.SwiftNav.SBP.Logging + , Test.SwiftNav.SBP.Navigation + , Test.SwiftNav.SBP.Observation + , Test.SwiftNav.SBP.Piksi + , Test.SwiftNav.SBP.System + , Test.SwiftNav.SBP.Table + , Test.SwiftNav.SBP.Tracking + , Test.SwiftNav.SBP.Utils + build-depends: aeson + , base + , basic-prelude + , bytestring + , QuickCheck + , sbp + , tasty + , tasty-hunit + , tasty-quickcheck + , yaml-light + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall + default-language: Haskell2010 + default-extensions: NoImplicitPrelude + OverloadedStrings diff --git a/src/SwiftNav/CRC16.hs b/src/SwiftNav/CRC16.hs new file mode 100644 --- /dev/null +++ b/src/SwiftNav/CRC16.hs @@ -0,0 +1,59 @@ +-- | +-- Module: SwiftNav.SBP +-- Copyright: Copyright (C) 2015 Swift Navigation, Inc. +-- License: LGPL-3 +-- Maintainer: Mark Fine +-- Stability: experimental +-- Portability: portable + +module SwiftNav.CRC16 + ( crc16 + ) where + +import BasicPrelude hiding ( foldl' ) +import Data.Array +import Data.Bits +import Data.ByteString +import Data.Word + +table :: Array Word16 Word16 +table = listArray (0, 255) + [ 0x0000, 0x1021, 0x2042, 0x3063, 0x4084, 0x50a5, 0x60c6, 0x70e7 + , 0x8108, 0x9129, 0xa14a, 0xb16b, 0xc18c, 0xd1ad, 0xe1ce, 0xf1ef + , 0x1231, 0x0210, 0x3273, 0x2252, 0x52b5, 0x4294, 0x72f7, 0x62d6 + , 0x9339, 0x8318, 0xb37b, 0xa35a, 0xd3bd, 0xc39c, 0xf3ff, 0xe3de + , 0x2462, 0x3443, 0x0420, 0x1401, 0x64e6, 0x74c7, 0x44a4, 0x5485 + , 0xa56a, 0xb54b, 0x8528, 0x9509, 0xe5ee, 0xf5cf, 0xc5ac, 0xd58d + , 0x3653, 0x2672, 0x1611, 0x0630, 0x76d7, 0x66f6, 0x5695, 0x46b4 + , 0xb75b, 0xa77a, 0x9719, 0x8738, 0xf7df, 0xe7fe, 0xd79d, 0xc7bc + , 0x48c4, 0x58e5, 0x6886, 0x78a7, 0x0840, 0x1861, 0x2802, 0x3823 + , 0xc9cc, 0xd9ed, 0xe98e, 0xf9af, 0x8948, 0x9969, 0xa90a, 0xb92b + , 0x5af5, 0x4ad4, 0x7ab7, 0x6a96, 0x1a71, 0x0a50, 0x3a33, 0x2a12 + , 0xdbfd, 0xcbdc, 0xfbbf, 0xeb9e, 0x9b79, 0x8b58, 0xbb3b, 0xab1a + , 0x6ca6, 0x7c87, 0x4ce4, 0x5cc5, 0x2c22, 0x3c03, 0x0c60, 0x1c41 + , 0xedae, 0xfd8f, 0xcdec, 0xddcd, 0xad2a, 0xbd0b, 0x8d68, 0x9d49 + , 0x7e97, 0x6eb6, 0x5ed5, 0x4ef4, 0x3e13, 0x2e32, 0x1e51, 0x0e70 + , 0xff9f, 0xefbe, 0xdfdd, 0xcffc, 0xbf1b, 0xaf3a, 0x9f59, 0x8f78 + , 0x9188, 0x81a9, 0xb1ca, 0xa1eb, 0xd10c, 0xc12d, 0xf14e, 0xe16f + , 0x1080, 0x00a1, 0x30c2, 0x20e3, 0x5004, 0x4025, 0x7046, 0x6067 + , 0x83b9, 0x9398, 0xa3fb, 0xb3da, 0xc33d, 0xd31c, 0xe37f, 0xf35e + , 0x02b1, 0x1290, 0x22f3, 0x32d2, 0x4235, 0x5214, 0x6277, 0x7256 + , 0xb5ea, 0xa5cb, 0x95a8, 0x8589, 0xf56e, 0xe54f, 0xd52c, 0xc50d + , 0x34e2, 0x24c3, 0x14a0, 0x0481, 0x7466, 0x6447, 0x5424, 0x4405 + , 0xa7db, 0xb7fa, 0x8799, 0x97b8, 0xe75f, 0xf77e, 0xc71d, 0xd73c + , 0x26d3, 0x36f2, 0x0691, 0x16b0, 0x6657, 0x7676, 0x4615, 0x5634 + , 0xd94c, 0xc96d, 0xf90e, 0xe92f, 0x99c8, 0x89e9, 0xb98a, 0xa9ab + , 0x5844, 0x4865, 0x7806, 0x6827, 0x18c0, 0x08e1, 0x3882, 0x28a3 + , 0xcb7d, 0xdb5c, 0xeb3f, 0xfb1e, 0x8bf9, 0x9bd8, 0xabbb, 0xbb9a + , 0x4a75, 0x5a54, 0x6a37, 0x7a16, 0x0af1, 0x1ad0, 0x2ab3, 0x3a92 + , 0xfd2e, 0xed0f, 0xdd6c, 0xcd4d, 0xbdaa, 0xad8b, 0x9de8, 0x8dc9 + , 0x7c26, 0x6c07, 0x5c64, 0x4c45, 0x3ca2, 0x2c83, 0x1ce0, 0x0cc1 + , 0xef1f, 0xff3e, 0xcf5d, 0xdf7c, 0xaf9b, 0xbfba, 0x8fd9, 0x9ff8 + , 0x6e17, 0x7e36, 0x4e55, 0x5e74, 0x2e93, 0x3eb2, 0x0ed1, 0x1ef0 + ] + +crc16 :: ByteString -> Word16 +crc16 = + (.&. 0xffff) . foldl' f 0 where + f ac v = ((ac `shiftL` 8) .&. 0xff00) `xor` (table ! idx) where + idx = ((ac `shiftR` 8) .&. 0xff) `xor` fromIntegral v diff --git a/src/SwiftNav/SBP.hs b/src/SwiftNav/SBP.hs --- a/src/SwiftNav/SBP.hs +++ b/src/SwiftNav/SBP.hs @@ -1,10 +1,21 @@ +-- | +-- Module: SwiftNav.SBP +-- Copyright: Copyright (C) 2015 Swift Navigation, Inc. +-- License: LGPL-3 +-- Maintainer: Mark Fine +-- Stability: experimental +-- Portability: portable + module SwiftNav.SBP where +import BasicPrelude import Data.Binary import Data.Binary.Get import Data.Binary.Put import Data.ByteString +import Data.ByteString.Lazy hiding (ByteString) import Data.Word +import SwiftNav.CRC16 import SwiftNav.SBP.Acquisition import SwiftNav.SBP.Bootload import SwiftNav.SBP.ExtEvents @@ -18,14 +29,14 @@ import SwiftNav.SBP.System import SwiftNav.SBP.Tracking -msgPreamble :: Word8 -msgPreamble = 0x55 +msgSBPPreamble :: Word8 +msgSBPPreamble = 0x55 data Msg = Msg { msgSBPType :: Word16 , msgSBPSender :: Word16 , msgSBPLen :: Word8 - , msgSBPPayload :: ByteString + , msgSBPPayload :: !ByteString , msgSBPCrc :: Word16 } deriving ( Show, Read, Eq ) @@ -45,81 +56,221 @@ putByteString msgSBPPayload putWord16le msgSBPCrc -getMsg :: Get Msg -getMsg = do - preamble <- getWord8 - if preamble /= msgPreamble then getMsg else get -putMsg :: Msg -> Put -putMsg msg = do - putWord8 msgPreamble - put msg - data SBPMsg = - SBPMsgAcqResult MsgAcqResult - | SBPMsgAcqResultDepA MsgAcqResultDepA - | SBPMsgAlmanac MsgAlmanac - | SBPMsgBasePos MsgBasePos - | SBPMsgBaselineEcef MsgBaselineEcef - | SBPMsgBaselineNed MsgBaselineNed - | SBPMsgBootloaderHandshakeDepA MsgBootloaderHandshakeDepA - | SBPMsgBootloaderHandshakeReq MsgBootloaderHandshakeReq - | SBPMsgBootloaderHandshakeResp MsgBootloaderHandshakeResp - | SBPMsgBootloaderJumpToApp MsgBootloaderJumpToApp - | SBPMsgCwResults MsgCwResults - | SBPMsgCwStart MsgCwStart - | SBPMsgDops MsgDops - | SBPMsgEphemeris MsgEphemeris - | SBPMsgEphemerisDepA MsgEphemerisDepA - | SBPMsgEphemerisDepB MsgEphemerisDepB - | SBPMsgExtEvent MsgExtEvent - | SBPMsgFileioReadDirReq MsgFileioReadDirReq - | SBPMsgFileioReadDirResp MsgFileioReadDirResp - | SBPMsgFileioReadReq MsgFileioReadReq - | SBPMsgFileioReadResp MsgFileioReadResp - | SBPMsgFileioRemove MsgFileioRemove - | SBPMsgFileioWriteReq MsgFileioWriteReq - | SBPMsgFileioWriteResp MsgFileioWriteResp - | SBPMsgFlashDone MsgFlashDone - | SBPMsgFlashErase MsgFlashErase - | SBPMsgFlashProgram MsgFlashProgram - | SBPMsgFlashReadReq MsgFlashReadReq - | SBPMsgFlashReadResp MsgFlashReadResp - | SBPMsgGpsTime MsgGpsTime - | SBPMsgHeartbeat MsgHeartbeat - | SBPMsgIarState MsgIarState - | SBPMsgInitBase MsgInitBase - | SBPMsgLog MsgLog - | SBPMsgM25FlashWriteStatus MsgM25FlashWriteStatus - | SBPMsgMaskSatellite MsgMaskSatellite - | SBPMsgNapDeviceDnaReq MsgNapDeviceDnaReq - | SBPMsgNapDeviceDnaResp MsgNapDeviceDnaResp - | SBPMsgObs MsgObs - | SBPMsgObsDepA MsgObsDepA - | SBPMsgPosEcef MsgPosEcef - | SBPMsgPosLlh MsgPosLlh - | SBPMsgPrintDep MsgPrintDep - | SBPMsgReset MsgReset - | SBPMsgResetFilters MsgResetFilters - | SBPMsgSetTime MsgSetTime - | SBPMsgSettingsReadByIndexDone MsgSettingsReadByIndexDone - | SBPMsgSettingsReadByIndexReq MsgSettingsReadByIndexReq - | SBPMsgSettingsReadByIndexResp MsgSettingsReadByIndexResp - | SBPMsgSettingsReadReq MsgSettingsReadReq - | SBPMsgSettingsReadResp MsgSettingsReadResp - | SBPMsgSettingsSave MsgSettingsSave - | SBPMsgSettingsWrite MsgSettingsWrite - | SBPMsgStartup MsgStartup - | SBPMsgStmFlashLockSector MsgStmFlashLockSector - | SBPMsgStmFlashUnlockSector MsgStmFlashUnlockSector - | SBPMsgStmUniqueIdReq MsgStmUniqueIdReq - | SBPMsgStmUniqueIdResp MsgStmUniqueIdResp - | SBPMsgThreadState MsgThreadState - | SBPMsgTrackingIq MsgTrackingIq - | SBPMsgTrackingState MsgTrackingState - | SBPMsgTrackingStateDepA MsgTrackingStateDepA - | SBPMsgTweet MsgTweet - | SBPMsgUartState MsgUartState - | SBPMsgVelEcef MsgVelEcef - | SBPMsgVelNed MsgVelNed + SBPMsgAcqResult MsgAcqResult Msg + | SBPMsgAcqResultDepA MsgAcqResultDepA Msg + | SBPMsgAlmanac MsgAlmanac Msg + | SBPMsgBasePos MsgBasePos Msg + | SBPMsgBaselineEcef MsgBaselineEcef Msg + | SBPMsgBaselineNed MsgBaselineNed Msg + | SBPMsgBootloaderHandshakeDepA MsgBootloaderHandshakeDepA Msg + | SBPMsgBootloaderHandshakeReq MsgBootloaderHandshakeReq Msg + | SBPMsgBootloaderHandshakeResp MsgBootloaderHandshakeResp Msg + | SBPMsgBootloaderJumpToApp MsgBootloaderJumpToApp Msg + | SBPMsgCwResults MsgCwResults Msg + | SBPMsgCwStart MsgCwStart Msg + | SBPMsgDops MsgDops Msg + | SBPMsgEphemeris MsgEphemeris Msg + | SBPMsgEphemerisDepA MsgEphemerisDepA Msg + | SBPMsgEphemerisDepB MsgEphemerisDepB Msg + | SBPMsgExtEvent MsgExtEvent Msg + | SBPMsgFileioReadDirReq MsgFileioReadDirReq Msg + | SBPMsgFileioReadDirResp MsgFileioReadDirResp Msg + | SBPMsgFileioReadReq MsgFileioReadReq Msg + | SBPMsgFileioReadResp MsgFileioReadResp Msg + | SBPMsgFileioRemove MsgFileioRemove Msg + | SBPMsgFileioWriteReq MsgFileioWriteReq Msg + | SBPMsgFileioWriteResp MsgFileioWriteResp Msg + | SBPMsgFlashDone MsgFlashDone Msg + | SBPMsgFlashErase MsgFlashErase Msg + | SBPMsgFlashProgram MsgFlashProgram Msg + | SBPMsgFlashReadReq MsgFlashReadReq Msg + | SBPMsgFlashReadResp MsgFlashReadResp Msg + | SBPMsgGpsTime MsgGpsTime Msg + | SBPMsgHeartbeat MsgHeartbeat Msg + | SBPMsgIarState MsgIarState Msg + | SBPMsgInitBase MsgInitBase Msg + | SBPMsgLog MsgLog Msg + | SBPMsgM25FlashWriteStatus MsgM25FlashWriteStatus Msg + | SBPMsgMaskSatellite MsgMaskSatellite Msg + | SBPMsgNapDeviceDnaReq MsgNapDeviceDnaReq Msg + | SBPMsgNapDeviceDnaResp MsgNapDeviceDnaResp Msg + | SBPMsgObs MsgObs Msg + | SBPMsgObsDepA MsgObsDepA Msg + | SBPMsgPosEcef MsgPosEcef Msg + | SBPMsgPosLlh MsgPosLlh Msg + | SBPMsgPrintDep MsgPrintDep Msg + | SBPMsgReset MsgReset Msg + | SBPMsgResetFilters MsgResetFilters Msg + | SBPMsgSetTime MsgSetTime Msg + | SBPMsgSettingsReadByIndexDone MsgSettingsReadByIndexDone Msg + | SBPMsgSettingsReadByIndexReq MsgSettingsReadByIndexReq Msg + | SBPMsgSettingsReadByIndexResp MsgSettingsReadByIndexResp Msg + | SBPMsgSettingsReadReq MsgSettingsReadReq Msg + | SBPMsgSettingsReadResp MsgSettingsReadResp Msg + | SBPMsgSettingsSave MsgSettingsSave Msg + | SBPMsgSettingsWrite MsgSettingsWrite Msg + | SBPMsgStartup MsgStartup Msg + | SBPMsgStmFlashLockSector MsgStmFlashLockSector Msg + | SBPMsgStmFlashUnlockSector MsgStmFlashUnlockSector Msg + | SBPMsgStmUniqueIdReq MsgStmUniqueIdReq Msg + | SBPMsgStmUniqueIdResp MsgStmUniqueIdResp Msg + | SBPMsgThreadState MsgThreadState Msg + | SBPMsgTrackingIq MsgTrackingIq Msg + | SBPMsgTrackingState MsgTrackingState Msg + | SBPMsgTrackingStateDepA MsgTrackingStateDepA Msg + | SBPMsgTweet MsgTweet Msg + | SBPMsgUartState MsgUartState Msg + | SBPMsgVelEcef MsgVelEcef Msg + | SBPMsgVelNed MsgVelNed Msg + | SBPMsgUnknown Msg deriving ( Show, Read, Eq ) + +instance Binary SBPMsg where + get = do + preamble <- getWord8 + if preamble /= msgSBPPreamble then get else do + sbp <- get + if crc16 (msgSBPPayload sbp) /= msgSBPCrc sbp then get else + return $ decode' sbp where + decode' sbp + | msgSBPType sbp == msgAcqResult = SBPMsgAcqResult (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgAcqResultDepA = SBPMsgAcqResultDepA (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgAlmanac = SBPMsgAlmanac (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgBasePos = SBPMsgBasePos (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgBaselineEcef = SBPMsgBaselineEcef (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgBaselineNed = SBPMsgBaselineNed (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgBootloaderHandshakeDepA = SBPMsgBootloaderHandshakeDepA (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgBootloaderHandshakeReq = SBPMsgBootloaderHandshakeReq (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgBootloaderHandshakeResp = SBPMsgBootloaderHandshakeResp (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgBootloaderJumpToApp = SBPMsgBootloaderJumpToApp (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgCwResults = SBPMsgCwResults (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgCwStart = SBPMsgCwStart (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgDops = SBPMsgDops (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgEphemeris = SBPMsgEphemeris (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgEphemerisDepA = SBPMsgEphemerisDepA (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgEphemerisDepB = SBPMsgEphemerisDepB (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgExtEvent = SBPMsgExtEvent (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgFileioReadDirReq = SBPMsgFileioReadDirReq (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgFileioReadDirResp = SBPMsgFileioReadDirResp (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgFileioReadReq = SBPMsgFileioReadReq (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgFileioReadResp = SBPMsgFileioReadResp (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgFileioRemove = SBPMsgFileioRemove (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgFileioWriteReq = SBPMsgFileioWriteReq (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgFileioWriteResp = SBPMsgFileioWriteResp (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgFlashDone = SBPMsgFlashDone (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgFlashErase = SBPMsgFlashErase (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgFlashProgram = SBPMsgFlashProgram (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgFlashReadReq = SBPMsgFlashReadReq (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgFlashReadResp = SBPMsgFlashReadResp (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgGpsTime = SBPMsgGpsTime (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgHeartbeat = SBPMsgHeartbeat (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgIarState = SBPMsgIarState (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgInitBase = SBPMsgInitBase (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgLog = SBPMsgLog (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgM25FlashWriteStatus = SBPMsgM25FlashWriteStatus (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgMaskSatellite = SBPMsgMaskSatellite (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgNapDeviceDnaReq = SBPMsgNapDeviceDnaReq (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgNapDeviceDnaResp = SBPMsgNapDeviceDnaResp (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgObs = SBPMsgObs (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgObsDepA = SBPMsgObsDepA (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgPosEcef = SBPMsgPosEcef (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgPosLlh = SBPMsgPosLlh (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgPrintDep = SBPMsgPrintDep (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgReset = SBPMsgReset (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgResetFilters = SBPMsgResetFilters (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgSetTime = SBPMsgSetTime (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgSettingsReadByIndexDone = SBPMsgSettingsReadByIndexDone (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgSettingsReadByIndexReq = SBPMsgSettingsReadByIndexReq (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgSettingsReadByIndexResp = SBPMsgSettingsReadByIndexResp (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgSettingsReadReq = SBPMsgSettingsReadReq (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgSettingsReadResp = SBPMsgSettingsReadResp (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgSettingsSave = SBPMsgSettingsSave (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgSettingsWrite = SBPMsgSettingsWrite (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgStartup = SBPMsgStartup (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgStmFlashLockSector = SBPMsgStmFlashLockSector (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgStmFlashUnlockSector = SBPMsgStmFlashUnlockSector (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgStmUniqueIdReq = SBPMsgStmUniqueIdReq (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgStmUniqueIdResp = SBPMsgStmUniqueIdResp (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgThreadState = SBPMsgThreadState (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgTrackingIq = SBPMsgTrackingIq (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgTrackingState = SBPMsgTrackingState (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgTrackingStateDepA = SBPMsgTrackingStateDepA (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgTweet = SBPMsgTweet (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgUartState = SBPMsgUartState (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgVelEcef = SBPMsgVelEcef (decode (fromStrict (msgSBPPayload sbp))) sbp + | msgSBPType sbp == msgVelNed = SBPMsgVelNed (decode (fromStrict (msgSBPPayload sbp))) sbp + | otherwise = SBPMsgUnknown sbp + + put msg = do + putWord8 msgSBPPreamble + put $ encode' msg + where + encode' (SBPMsgAcqResult _ sbp) = sbp + encode' (SBPMsgAcqResultDepA _ sbp) = sbp + encode' (SBPMsgAlmanac _ sbp) = sbp + encode' (SBPMsgBasePos _ sbp) = sbp + encode' (SBPMsgBaselineEcef _ sbp) = sbp + encode' (SBPMsgBaselineNed _ sbp) = sbp + encode' (SBPMsgBootloaderHandshakeDepA _ sbp) = sbp + encode' (SBPMsgBootloaderHandshakeReq _ sbp) = sbp + encode' (SBPMsgBootloaderHandshakeResp _ sbp) = sbp + encode' (SBPMsgBootloaderJumpToApp _ sbp) = sbp + encode' (SBPMsgCwResults _ sbp) = sbp + encode' (SBPMsgCwStart _ sbp) = sbp + encode' (SBPMsgDops _ sbp) = sbp + encode' (SBPMsgEphemeris _ sbp) = sbp + encode' (SBPMsgEphemerisDepA _ sbp) = sbp + encode' (SBPMsgEphemerisDepB _ sbp) = sbp + encode' (SBPMsgExtEvent _ sbp) = sbp + encode' (SBPMsgFileioReadDirReq _ sbp) = sbp + encode' (SBPMsgFileioReadDirResp _ sbp) = sbp + encode' (SBPMsgFileioReadReq _ sbp) = sbp + encode' (SBPMsgFileioReadResp _ sbp) = sbp + encode' (SBPMsgFileioRemove _ sbp) = sbp + encode' (SBPMsgFileioWriteReq _ sbp) = sbp + encode' (SBPMsgFileioWriteResp _ sbp) = sbp + encode' (SBPMsgFlashDone _ sbp) = sbp + encode' (SBPMsgFlashErase _ sbp) = sbp + encode' (SBPMsgFlashProgram _ sbp) = sbp + encode' (SBPMsgFlashReadReq _ sbp) = sbp + encode' (SBPMsgFlashReadResp _ sbp) = sbp + encode' (SBPMsgGpsTime _ sbp) = sbp + encode' (SBPMsgHeartbeat _ sbp) = sbp + encode' (SBPMsgIarState _ sbp) = sbp + encode' (SBPMsgInitBase _ sbp) = sbp + encode' (SBPMsgLog _ sbp) = sbp + encode' (SBPMsgM25FlashWriteStatus _ sbp) = sbp + encode' (SBPMsgMaskSatellite _ sbp) = sbp + encode' (SBPMsgNapDeviceDnaReq _ sbp) = sbp + encode' (SBPMsgNapDeviceDnaResp _ sbp) = sbp + encode' (SBPMsgObs _ sbp) = sbp + encode' (SBPMsgObsDepA _ sbp) = sbp + encode' (SBPMsgPosEcef _ sbp) = sbp + encode' (SBPMsgPosLlh _ sbp) = sbp + encode' (SBPMsgPrintDep _ sbp) = sbp + encode' (SBPMsgReset _ sbp) = sbp + encode' (SBPMsgResetFilters _ sbp) = sbp + encode' (SBPMsgSetTime _ sbp) = sbp + encode' (SBPMsgSettingsReadByIndexDone _ sbp) = sbp + encode' (SBPMsgSettingsReadByIndexReq _ sbp) = sbp + encode' (SBPMsgSettingsReadByIndexResp _ sbp) = sbp + encode' (SBPMsgSettingsReadReq _ sbp) = sbp + encode' (SBPMsgSettingsReadResp _ sbp) = sbp + encode' (SBPMsgSettingsSave _ sbp) = sbp + encode' (SBPMsgSettingsWrite _ sbp) = sbp + encode' (SBPMsgStartup _ sbp) = sbp + encode' (SBPMsgStmFlashLockSector _ sbp) = sbp + encode' (SBPMsgStmFlashUnlockSector _ sbp) = sbp + encode' (SBPMsgStmUniqueIdReq _ sbp) = sbp + encode' (SBPMsgStmUniqueIdResp _ sbp) = sbp + encode' (SBPMsgThreadState _ sbp) = sbp + encode' (SBPMsgTrackingIq _ sbp) = sbp + encode' (SBPMsgTrackingState _ sbp) = sbp + encode' (SBPMsgTrackingStateDepA _ sbp) = sbp + encode' (SBPMsgTweet _ sbp) = sbp + encode' (SBPMsgUartState _ sbp) = sbp + encode' (SBPMsgVelEcef _ sbp) = sbp + encode' (SBPMsgVelNed _ sbp) = sbp + encode' (SBPMsgUnknown sbp) = sbp diff --git a/src/SwiftNav/SBP/Acquisition.hs b/src/SwiftNav/SBP/Acquisition.hs --- a/src/SwiftNav/SBP/Acquisition.hs +++ b/src/SwiftNav/SBP/Acquisition.hs @@ -10,8 +10,10 @@ module SwiftNav.SBP.Acquisition where +import BasicPrelude import Control.Monad import Control.Monad.Loops +import Data.Aeson.TH (deriveJSON, defaultOptions, fieldLabelModifier) import Data.Binary import Data.Binary.Get import Data.Binary.IEEE754 @@ -20,6 +22,7 @@ import Data.ByteString.Lazy hiding ( ByteString ) import Data.Int import Data.Word +import SwiftNav.SBP.Encoding msgAcqResult :: Word16 msgAcqResult = 0x0014 @@ -31,14 +34,14 @@ -- contains the parameters of the point in the acquisition search space with -- the best signal-to-noise (SNR) ratio. data MsgAcqResult = MsgAcqResult - { msgAcqResultSnr :: Float + { msgAcqResult_snr :: Float -- ^ SNR of best point. Currently dimensonless, but will have units of dB Hz -- in the revision of this message. - , msgAcqResultCp :: Float + , msgAcqResult_cp :: Float -- ^ Code phase of best point - , msgAcqResultCf :: Float + , msgAcqResult_cf :: Float -- ^ Carrier frequency of best point - , msgAcqResultSid :: Word32 + , msgAcqResult_sid :: Word32 -- ^ Signal identifier of the satellite signal for which acquisition was -- attempted - values 0x00 through 0x1F represent GPS PRNs 1 through 32 -- respectively (PRN-1 notation); other values reserved for future use. @@ -46,18 +49,21 @@ instance Binary MsgAcqResult where get = do - msgAcqResultSnr <- getFloat32le - msgAcqResultCp <- getFloat32le - msgAcqResultCf <- getFloat32le - msgAcqResultSid <- getWord32le + msgAcqResult_snr <- getFloat32le + msgAcqResult_cp <- getFloat32le + msgAcqResult_cf <- getFloat32le + msgAcqResult_sid <- getWord32le return MsgAcqResult {..} put MsgAcqResult {..} = do - putFloat32le msgAcqResultSnr - putFloat32le msgAcqResultCp - putFloat32le msgAcqResultCf - putWord32le msgAcqResultSid + putFloat32le msgAcqResult_snr + putFloat32le msgAcqResult_cp + putFloat32le msgAcqResult_cf + putWord32le msgAcqResult_sid +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgAcqResult_" . stripPrefix "msgAcqResult_"} + ''MsgAcqResult) + msgAcqResultDepA :: Word16 msgAcqResultDepA = 0x0015 @@ -65,28 +71,31 @@ -- -- Deprecated. data MsgAcqResultDepA = MsgAcqResultDepA - { msgAcqResultDepASnr :: Float + { msgAcqResultDepA_snr :: Float -- ^ SNR of best point. Currently dimensonless, but will have units of dB Hz -- in the revision of this message. - , msgAcqResultDepACp :: Float + , msgAcqResultDepA_cp :: Float -- ^ Code phase of best point - , msgAcqResultDepACf :: Float + , msgAcqResultDepA_cf :: Float -- ^ Carrier frequency of best point - , msgAcqResultDepAPrn :: Word8 + , msgAcqResultDepA_prn :: Word8 -- ^ PRN-1 identifier of the satellite signal for which acquisition was -- attempted } deriving ( Show, Read, Eq ) instance Binary MsgAcqResultDepA where get = do - msgAcqResultDepASnr <- getFloat32le - msgAcqResultDepACp <- getFloat32le - msgAcqResultDepACf <- getFloat32le - msgAcqResultDepAPrn <- getWord8 + msgAcqResultDepA_snr <- getFloat32le + msgAcqResultDepA_cp <- getFloat32le + msgAcqResultDepA_cf <- getFloat32le + msgAcqResultDepA_prn <- getWord8 return MsgAcqResultDepA {..} put MsgAcqResultDepA {..} = do - putFloat32le msgAcqResultDepASnr - putFloat32le msgAcqResultDepACp - putFloat32le msgAcqResultDepACf - putWord8 msgAcqResultDepAPrn + putFloat32le msgAcqResultDepA_snr + putFloat32le msgAcqResultDepA_cp + putFloat32le msgAcqResultDepA_cf + putWord8 msgAcqResultDepA_prn + +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgAcqResultDepA_" . stripPrefix "msgAcqResultDepA_"} + ''MsgAcqResultDepA) diff --git a/src/SwiftNav/SBP/Bootload.hs b/src/SwiftNav/SBP/Bootload.hs --- a/src/SwiftNav/SBP/Bootload.hs +++ b/src/SwiftNav/SBP/Bootload.hs @@ -13,8 +13,10 @@ module SwiftNav.SBP.Bootload where +import BasicPrelude import Control.Monad import Control.Monad.Loops +import Data.Aeson.TH (deriveJSON, defaultOptions, fieldLabelModifier) import Data.Binary import Data.Binary.Get import Data.Binary.IEEE754 @@ -23,6 +25,7 @@ import Data.ByteString.Lazy hiding ( ByteString ) import Data.Int import Data.Word +import SwiftNav.SBP.Encoding msgBootloaderHandshakeReq :: Word16 msgBootloaderHandshakeReq = 0x00B3 @@ -52,22 +55,25 @@ -- MSG_BOOTLOADER_HANDSHAKE_REQ. The payload contains the bootloader version -- number and the SBP protocol version number. data MsgBootloaderHandshakeResp = MsgBootloaderHandshakeResp - { msgBootloaderHandshakeRespFlags :: Word32 + { msgBootloaderHandshakeResp_flags :: Word32 -- ^ Bootloader flags - , msgBootloaderHandshakeRespVersion :: ByteString + , msgBootloaderHandshakeResp_version :: ByteString -- ^ Bootloader version number } deriving ( Show, Read, Eq ) instance Binary MsgBootloaderHandshakeResp where get = do - msgBootloaderHandshakeRespFlags <- getWord32le - msgBootloaderHandshakeRespVersion <- liftM toStrict getRemainingLazyByteString + msgBootloaderHandshakeResp_flags <- getWord32le + msgBootloaderHandshakeResp_version <- liftM toStrict getRemainingLazyByteString return MsgBootloaderHandshakeResp {..} put MsgBootloaderHandshakeResp {..} = do - putWord32le msgBootloaderHandshakeRespFlags - putByteString msgBootloaderHandshakeRespVersion + putWord32le msgBootloaderHandshakeResp_flags + putByteString msgBootloaderHandshakeResp_version +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgBootloaderHandshakeResp_" . stripPrefix "msgBootloaderHandshakeResp_"} + ''MsgBootloaderHandshakeResp) + msgBootloaderJumpToApp :: Word16 msgBootloaderJumpToApp = 0x00B1 @@ -75,18 +81,21 @@ -- -- The host initiates the bootloader to jump to the application. data MsgBootloaderJumpToApp = MsgBootloaderJumpToApp - { msgBootloaderJumpToAppJump :: Word8 + { msgBootloaderJumpToApp_jump :: Word8 -- ^ Ignored by the device } deriving ( Show, Read, Eq ) instance Binary MsgBootloaderJumpToApp where get = do - msgBootloaderJumpToAppJump <- getWord8 + msgBootloaderJumpToApp_jump <- getWord8 return MsgBootloaderJumpToApp {..} put MsgBootloaderJumpToApp {..} = do - putWord8 msgBootloaderJumpToAppJump + putWord8 msgBootloaderJumpToApp_jump +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgBootloaderJumpToApp_" . stripPrefix "msgBootloaderJumpToApp_"} + ''MsgBootloaderJumpToApp) + msgNapDeviceDnaReq :: Word16 msgNapDeviceDnaReq = 0x00DE @@ -119,18 +128,21 @@ -- that this ID is tied to the FPGA, and not related to the Piksi's serial -- number. data MsgNapDeviceDnaResp = MsgNapDeviceDnaResp - { msgNapDeviceDnaRespDna :: [Word8] + { msgNapDeviceDnaResp_dna :: [Word8] -- ^ 57-bit SwiftNAP FPGA Device ID. Remaining bits are padded on the right. } deriving ( Show, Read, Eq ) instance Binary MsgNapDeviceDnaResp where get = do - msgNapDeviceDnaRespDna <- replicateM 8 getWord8 + msgNapDeviceDnaResp_dna <- replicateM 8 getWord8 return MsgNapDeviceDnaResp {..} put MsgNapDeviceDnaResp {..} = do - mapM_ putWord8 msgNapDeviceDnaRespDna + mapM_ putWord8 msgNapDeviceDnaResp_dna +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgNapDeviceDnaResp_" . stripPrefix "msgNapDeviceDnaResp_"} + ''MsgNapDeviceDnaResp) + msgBootloaderHandshakeDepA :: Word16 msgBootloaderHandshakeDepA = 0x00B0 @@ -138,14 +150,17 @@ -- -- Deprecated. data MsgBootloaderHandshakeDepA = MsgBootloaderHandshakeDepA - { msgBootloaderHandshakeDepAHandshake :: [Word8] + { msgBootloaderHandshakeDepA_handshake :: [Word8] -- ^ Version number string (not NULL terminated) } deriving ( Show, Read, Eq ) instance Binary MsgBootloaderHandshakeDepA where get = do - msgBootloaderHandshakeDepAHandshake <- whileM (liftM not isEmpty) getWord8 + msgBootloaderHandshakeDepA_handshake <- whileM (liftM not isEmpty) getWord8 return MsgBootloaderHandshakeDepA {..} put MsgBootloaderHandshakeDepA {..} = do - mapM_ putWord8 msgBootloaderHandshakeDepAHandshake + mapM_ putWord8 msgBootloaderHandshakeDepA_handshake + +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgBootloaderHandshakeDepA_" . stripPrefix "msgBootloaderHandshakeDepA_"} + ''MsgBootloaderHandshakeDepA) diff --git a/src/SwiftNav/SBP/Encoding.hs b/src/SwiftNav/SBP/Encoding.hs new file mode 100644 --- /dev/null +++ b/src/SwiftNav/SBP/Encoding.hs @@ -0,0 +1,30 @@ +-- | +-- Module: SwiftNav.SBP.Encoding +-- Copyright: Copyright (C) 2015 Swift Navigation, Inc. +-- License: LGPL-3 +-- Maintainer: Mark Fine +-- Stability: experimental +-- Portability: portable +-- +-- Encoding utilities. + +module SwiftNav.SBP.Encoding where + +import BasicPrelude +import Control.Applicative +import Data.Aeson +import qualified Data.ByteString as B +import Data.ByteString.Base64 as Base64 +import Data.Text.Encoding (encodeUtf8, decodeUtf8With) +import Data.Text.Encoding.Error + +-- ByteString doesn't have Aeson instances defined for it since +-- arbitrary ByteString's aren't really valid JSON. This defines +-- orphaned instances for ByteStrings that are expected to be valid +-- text. + +instance ToJSON B.ByteString where + toJSON = toJSON . decodeUtf8With ignore . Base64.encode + +instance FromJSON B.ByteString where + parseJSON = withText "ByteString" (pure . Base64.decodeLenient . encodeUtf8) diff --git a/src/SwiftNav/SBP/ExtEvents.hs b/src/SwiftNav/SBP/ExtEvents.hs --- a/src/SwiftNav/SBP/ExtEvents.hs +++ b/src/SwiftNav/SBP/ExtEvents.hs @@ -11,8 +11,10 @@ module SwiftNav.SBP.ExtEvents where +import BasicPrelude import Control.Monad import Control.Monad.Loops +import Data.Aeson.TH (deriveJSON, defaultOptions, fieldLabelModifier) import Data.Binary import Data.Binary.Get import Data.Binary.IEEE754 @@ -21,6 +23,7 @@ import Data.ByteString.Lazy hiding ( ByteString ) import Data.Int import Data.Word +import SwiftNav.SBP.Encoding msgExtEvent :: Word16 msgExtEvent = 0x0101 @@ -30,31 +33,34 @@ -- Reports detection of an external event, the GPS time it occurred, which pin -- it was and whether it was rising or falling. data MsgExtEvent = MsgExtEvent - { msgExtEventWn :: Word16 + { msgExtEvent_wn :: Word16 -- ^ GPS week number - , msgExtEventTow :: Word32 + , msgExtEvent_tow :: Word32 -- ^ GPS time of week rounded to the nearest millisecond - , msgExtEventNs :: Int32 + , msgExtEvent_ns :: Int32 -- ^ Nanosecond residual of millisecond-rounded TOW (ranges from -500000 to -- 500000) - , msgExtEventFlags :: Word8 + , msgExtEvent_flags :: Word8 -- ^ Flags - , msgExtEventPin :: Word8 + , msgExtEvent_pin :: Word8 -- ^ Pin number. 0..9 = DEBUG0..9. } deriving ( Show, Read, Eq ) instance Binary MsgExtEvent where get = do - msgExtEventWn <- getWord16le - msgExtEventTow <- getWord32le - msgExtEventNs <- liftM fromIntegral getWord32le - msgExtEventFlags <- getWord8 - msgExtEventPin <- getWord8 + msgExtEvent_wn <- getWord16le + msgExtEvent_tow <- getWord32le + msgExtEvent_ns <- liftM fromIntegral getWord32le + msgExtEvent_flags <- getWord8 + msgExtEvent_pin <- getWord8 return MsgExtEvent {..} put MsgExtEvent {..} = do - putWord16le msgExtEventWn - putWord32le msgExtEventTow - putWord32le $ fromIntegral msgExtEventNs - putWord8 msgExtEventFlags - putWord8 msgExtEventPin + putWord16le msgExtEvent_wn + putWord32le msgExtEvent_tow + putWord32le $ fromIntegral msgExtEvent_ns + putWord8 msgExtEvent_flags + putWord8 msgExtEvent_pin + +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgExtEvent_" . stripPrefix "msgExtEvent_"} + ''MsgExtEvent) diff --git a/src/SwiftNav/SBP/FileIo.hs b/src/SwiftNav/SBP/FileIo.hs --- a/src/SwiftNav/SBP/FileIo.hs +++ b/src/SwiftNav/SBP/FileIo.hs @@ -17,8 +17,10 @@ module SwiftNav.SBP.FileIo where +import BasicPrelude import Control.Monad import Control.Monad.Loops +import Data.Aeson.TH (deriveJSON, defaultOptions, fieldLabelModifier) import Data.Binary import Data.Binary.Get import Data.Binary.IEEE754 @@ -27,6 +29,7 @@ import Data.ByteString.Lazy hiding ( ByteString ) import Data.Int import Data.Word +import SwiftNav.SBP.Encoding msgFileioReadReq :: Word16 msgFileioReadReq = 0x00A8 @@ -38,30 +41,33 @@ -- where the message length field indicates how many bytes were succesfully -- read.The sequence number in the request will be returned in the response. data MsgFileioReadReq = MsgFileioReadReq - { msgFileioReadReqSequence :: Word32 + { msgFileioReadReq_sequence :: Word32 -- ^ Read sequence number - , msgFileioReadReqOffset :: Word32 + , msgFileioReadReq_offset :: Word32 -- ^ File offset - , msgFileioReadReqChunkSize :: Word8 + , msgFileioReadReq_chunk_size :: Word8 -- ^ Chunk size to read - , msgFileioReadReqFilename :: ByteString + , msgFileioReadReq_filename :: ByteString -- ^ Name of the file to read from } deriving ( Show, Read, Eq ) instance Binary MsgFileioReadReq where get = do - msgFileioReadReqSequence <- getWord32le - msgFileioReadReqOffset <- getWord32le - msgFileioReadReqChunkSize <- getWord8 - msgFileioReadReqFilename <- liftM toStrict getRemainingLazyByteString + msgFileioReadReq_sequence <- getWord32le + msgFileioReadReq_offset <- getWord32le + msgFileioReadReq_chunk_size <- getWord8 + msgFileioReadReq_filename <- liftM toStrict getRemainingLazyByteString return MsgFileioReadReq {..} put MsgFileioReadReq {..} = do - putWord32le msgFileioReadReqSequence - putWord32le msgFileioReadReqOffset - putWord8 msgFileioReadReqChunkSize - putByteString msgFileioReadReqFilename + putWord32le msgFileioReadReq_sequence + putWord32le msgFileioReadReq_offset + putWord8 msgFileioReadReq_chunk_size + putByteString msgFileioReadReq_filename +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgFileioReadReq_" . stripPrefix "msgFileioReadReq_"} + ''MsgFileioReadReq) + msgFileioReadResp :: Word16 msgFileioReadResp = 0x00A3 @@ -72,22 +78,25 @@ -- length field indicates how many bytes were succesfully read. The sequence -- number in the response is preserved from the request. data MsgFileioReadResp = MsgFileioReadResp - { msgFileioReadRespSequence :: Word32 + { msgFileioReadResp_sequence :: Word32 -- ^ Read sequence number - , msgFileioReadRespContents :: [Word8] + , msgFileioReadResp_contents :: [Word8] -- ^ Contents of read file } deriving ( Show, Read, Eq ) instance Binary MsgFileioReadResp where get = do - msgFileioReadRespSequence <- getWord32le - msgFileioReadRespContents <- whileM (liftM not isEmpty) getWord8 + msgFileioReadResp_sequence <- getWord32le + msgFileioReadResp_contents <- whileM (liftM not isEmpty) getWord8 return MsgFileioReadResp {..} put MsgFileioReadResp {..} = do - putWord32le msgFileioReadRespSequence - mapM_ putWord8 msgFileioReadRespContents + putWord32le msgFileioReadResp_sequence + mapM_ putWord8 msgFileioReadResp_contents +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgFileioReadResp_" . stripPrefix "msgFileioReadResp_"} + ''MsgFileioReadResp) + msgFileioReadDirReq :: Word16 msgFileioReadDirReq = 0x00A9 @@ -100,26 +109,29 @@ -- listing is chunked over multiple SBP packets. The sequence number in the -- request will be returned in the response. data MsgFileioReadDirReq = MsgFileioReadDirReq - { msgFileioReadDirReqSequence :: Word32 + { msgFileioReadDirReq_sequence :: Word32 -- ^ Read sequence number - , msgFileioReadDirReqOffset :: Word32 + , msgFileioReadDirReq_offset :: Word32 -- ^ The offset to skip the first n elements of the file list - , msgFileioReadDirReqDirname :: ByteString + , msgFileioReadDirReq_dirname :: ByteString -- ^ Name of the directory to list } deriving ( Show, Read, Eq ) instance Binary MsgFileioReadDirReq where get = do - msgFileioReadDirReqSequence <- getWord32le - msgFileioReadDirReqOffset <- getWord32le - msgFileioReadDirReqDirname <- liftM toStrict getRemainingLazyByteString + msgFileioReadDirReq_sequence <- getWord32le + msgFileioReadDirReq_offset <- getWord32le + msgFileioReadDirReq_dirname <- liftM toStrict getRemainingLazyByteString return MsgFileioReadDirReq {..} put MsgFileioReadDirReq {..} = do - putWord32le msgFileioReadDirReqSequence - putWord32le msgFileioReadDirReqOffset - putByteString msgFileioReadDirReqDirname + putWord32le msgFileioReadDirReq_sequence + putWord32le msgFileioReadDirReq_offset + putByteString msgFileioReadDirReq_dirname +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgFileioReadDirReq_" . stripPrefix "msgFileioReadDirReq_"} + ''MsgFileioReadDirReq) + msgFileioReadDirResp :: Word16 msgFileioReadDirResp = 0x00AA @@ -131,22 +143,25 @@ -- of the list is identified by an entry containing just the character 0xFF. -- The sequence number in the response is preserved from the request. data MsgFileioReadDirResp = MsgFileioReadDirResp - { msgFileioReadDirRespSequence :: Word32 + { msgFileioReadDirResp_sequence :: Word32 -- ^ Read sequence number - , msgFileioReadDirRespContents :: [Word8] + , msgFileioReadDirResp_contents :: [Word8] -- ^ Contents of read directory } deriving ( Show, Read, Eq ) instance Binary MsgFileioReadDirResp where get = do - msgFileioReadDirRespSequence <- getWord32le - msgFileioReadDirRespContents <- whileM (liftM not isEmpty) getWord8 + msgFileioReadDirResp_sequence <- getWord32le + msgFileioReadDirResp_contents <- whileM (liftM not isEmpty) getWord8 return MsgFileioReadDirResp {..} put MsgFileioReadDirResp {..} = do - putWord32le msgFileioReadDirRespSequence - mapM_ putWord8 msgFileioReadDirRespContents + putWord32le msgFileioReadDirResp_sequence + mapM_ putWord8 msgFileioReadDirResp_contents +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgFileioReadDirResp_" . stripPrefix "msgFileioReadDirResp_"} + ''MsgFileioReadDirResp) + msgFileioRemove :: Word16 msgFileioRemove = 0x00AC @@ -154,18 +169,21 @@ -- -- The file remove message deletes a file from the file system. data MsgFileioRemove = MsgFileioRemove - { msgFileioRemoveFilename :: ByteString + { msgFileioRemove_filename :: ByteString -- ^ Name of the file to delete } deriving ( Show, Read, Eq ) instance Binary MsgFileioRemove where get = do - msgFileioRemoveFilename <- liftM toStrict getRemainingLazyByteString + msgFileioRemove_filename <- liftM toStrict getRemainingLazyByteString return MsgFileioRemove {..} put MsgFileioRemove {..} = do - putByteString msgFileioRemoveFilename + putByteString msgFileioRemove_filename +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgFileioRemove_" . stripPrefix "msgFileioRemove_"} + ''MsgFileioRemove) + msgFileioWriteReq :: Word16 msgFileioWriteReq = 0x00AD @@ -176,30 +194,33 @@ -- MSG_FILEIO_WRITE_RESP message to check integrity of the write. The sequence -- number in the request will be returned in the response. data MsgFileioWriteReq = MsgFileioWriteReq - { msgFileioWriteReqSequence :: Word32 + { msgFileioWriteReq_sequence :: Word32 -- ^ Write sequence number - , msgFileioWriteReqOffset :: Word32 + , msgFileioWriteReq_offset :: Word32 -- ^ Offset into the file at which to start writing in bytes - , msgFileioWriteReqFilename :: ByteString + , msgFileioWriteReq_filename :: ByteString -- ^ Name of the file to write to - , msgFileioWriteReqData :: [Word8] + , msgFileioWriteReq_data :: [Word8] -- ^ Variable-length array of data to write } deriving ( Show, Read, Eq ) instance Binary MsgFileioWriteReq where get = do - msgFileioWriteReqSequence <- getWord32le - msgFileioWriteReqOffset <- getWord32le - msgFileioWriteReqFilename <- liftM toStrict getRemainingLazyByteString - msgFileioWriteReqData <- whileM (liftM not isEmpty) getWord8 + msgFileioWriteReq_sequence <- getWord32le + msgFileioWriteReq_offset <- getWord32le + msgFileioWriteReq_filename <- liftM toStrict getRemainingLazyByteString + msgFileioWriteReq_data <- whileM (liftM not isEmpty) getWord8 return MsgFileioWriteReq {..} put MsgFileioWriteReq {..} = do - putWord32le msgFileioWriteReqSequence - putWord32le msgFileioWriteReqOffset - putByteString msgFileioWriteReqFilename - mapM_ putWord8 msgFileioWriteReqData + putWord32le msgFileioWriteReq_sequence + putWord32le msgFileioWriteReq_offset + putByteString msgFileioWriteReq_filename + mapM_ putWord8 msgFileioWriteReq_data +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgFileioWriteReq_" . stripPrefix "msgFileioWriteReq_"} + ''MsgFileioWriteReq) + msgFileioWriteResp :: Word16 msgFileioWriteResp = 0x00AB @@ -210,14 +231,17 @@ -- MSG_FILEIO_WRITE_REQ message to check integrity of the write. The sequence -- number in the response is preserved from the request. data MsgFileioWriteResp = MsgFileioWriteResp - { msgFileioWriteRespSequence :: Word32 + { msgFileioWriteResp_sequence :: Word32 -- ^ Write sequence number } deriving ( Show, Read, Eq ) instance Binary MsgFileioWriteResp where get = do - msgFileioWriteRespSequence <- getWord32le + msgFileioWriteResp_sequence <- getWord32le return MsgFileioWriteResp {..} put MsgFileioWriteResp {..} = do - putWord32le msgFileioWriteRespSequence + putWord32le msgFileioWriteResp_sequence + +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgFileioWriteResp_" . stripPrefix "msgFileioWriteResp_"} + ''MsgFileioWriteResp) diff --git a/src/SwiftNav/SBP/Flash.hs b/src/SwiftNav/SBP/Flash.hs --- a/src/SwiftNav/SBP/Flash.hs +++ b/src/SwiftNav/SBP/Flash.hs @@ -14,8 +14,10 @@ module SwiftNav.SBP.Flash where +import BasicPrelude import Control.Monad import Control.Monad.Loops +import Data.Aeson.TH (deriveJSON, defaultOptions, fieldLabelModifier) import Data.Binary import Data.Binary.Get import Data.Binary.IEEE754 @@ -24,6 +26,7 @@ import Data.ByteString.Lazy hiding ( ByteString ) import Data.Int import Data.Word +import SwiftNav.SBP.Encoding msgFlashProgram :: Word16 msgFlashProgram = 0x00E6 @@ -36,30 +39,33 @@ -- if the maximum write size is exceeded. Note that the sector-containing -- addresses must be erased before addresses can be programmed. data MsgFlashProgram = MsgFlashProgram - { msgFlashProgramTarget :: Word8 + { msgFlashProgram_target :: Word8 -- ^ Target flags - , msgFlashProgramAddrStart :: [Word8] + , msgFlashProgram_addr_start :: [Word8] -- ^ Starting address offset to program - , msgFlashProgramAddrLen :: Word8 + , msgFlashProgram_addr_len :: Word8 -- ^ Length of set of addresses to program, counting up from starting address - , msgFlashProgramData :: [Word8] + , msgFlashProgram_data :: [Word8] -- ^ Data to program addresses with, with length N=addr_len } deriving ( Show, Read, Eq ) instance Binary MsgFlashProgram where get = do - msgFlashProgramTarget <- getWord8 - msgFlashProgramAddrStart <- replicateM 3 getWord8 - msgFlashProgramAddrLen <- getWord8 - msgFlashProgramData <- whileM (liftM not isEmpty) getWord8 + msgFlashProgram_target <- getWord8 + msgFlashProgram_addr_start <- replicateM 3 getWord8 + msgFlashProgram_addr_len <- getWord8 + msgFlashProgram_data <- whileM (liftM not isEmpty) getWord8 return MsgFlashProgram {..} put MsgFlashProgram {..} = do - putWord8 msgFlashProgramTarget - mapM_ putWord8 msgFlashProgramAddrStart - putWord8 msgFlashProgramAddrLen - mapM_ putWord8 msgFlashProgramData + putWord8 msgFlashProgram_target + mapM_ putWord8 msgFlashProgram_addr_start + putWord8 msgFlashProgram_addr_len + mapM_ putWord8 msgFlashProgram_data +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgFlashProgram_" . stripPrefix "msgFlashProgram_"} + ''MsgFlashProgram) + msgFlashDone :: Word16 msgFlashDone = 0x00E0 @@ -70,18 +76,21 @@ -- MSG_FLASH_READ_REQ, or MSG_FLASH_PROGRAM, may return this message on -- failure. data MsgFlashDone = MsgFlashDone - { msgFlashDoneResponse :: Word8 + { msgFlashDone_response :: Word8 -- ^ Response flags } deriving ( Show, Read, Eq ) instance Binary MsgFlashDone where get = do - msgFlashDoneResponse <- getWord8 + msgFlashDone_response <- getWord8 return MsgFlashDone {..} put MsgFlashDone {..} = do - putWord8 msgFlashDoneResponse + putWord8 msgFlashDone_response +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgFlashDone_" . stripPrefix "msgFlashDone_"} + ''MsgFlashDone) + msgFlashReadReq :: Word16 msgFlashReadReq = 0x00E7 @@ -94,26 +103,29 @@ -- exceeded or FLASH_INVALID_ADDR (3) if the address is outside of the allowed -- range. data MsgFlashReadReq = MsgFlashReadReq - { msgFlashReadReqTarget :: Word8 + { msgFlashReadReq_target :: Word8 -- ^ Target flags - , msgFlashReadReqAddrStart :: [Word8] + , msgFlashReadReq_addr_start :: [Word8] -- ^ Starting address offset to read from - , msgFlashReadReqAddrLen :: Word8 + , msgFlashReadReq_addr_len :: Word8 -- ^ Length of set of addresses to read, counting up from starting address } deriving ( Show, Read, Eq ) instance Binary MsgFlashReadReq where get = do - msgFlashReadReqTarget <- getWord8 - msgFlashReadReqAddrStart <- replicateM 3 getWord8 - msgFlashReadReqAddrLen <- getWord8 + msgFlashReadReq_target <- getWord8 + msgFlashReadReq_addr_start <- replicateM 3 getWord8 + msgFlashReadReq_addr_len <- getWord8 return MsgFlashReadReq {..} put MsgFlashReadReq {..} = do - putWord8 msgFlashReadReqTarget - mapM_ putWord8 msgFlashReadReqAddrStart - putWord8 msgFlashReadReqAddrLen + putWord8 msgFlashReadReq_target + mapM_ putWord8 msgFlashReadReq_addr_start + putWord8 msgFlashReadReq_addr_len +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgFlashReadReq_" . stripPrefix "msgFlashReadReq_"} + ''MsgFlashReadReq) + msgFlashReadResp :: Word16 msgFlashReadResp = 0x00E1 @@ -126,26 +138,29 @@ -- exceeded or FLASH_INVALID_ADDR (3) if the address is outside of the allowed -- range. data MsgFlashReadResp = MsgFlashReadResp - { msgFlashReadRespTarget :: Word8 + { msgFlashReadResp_target :: Word8 -- ^ Target flags - , msgFlashReadRespAddrStart :: [Word8] + , msgFlashReadResp_addr_start :: [Word8] -- ^ Starting address offset to read from - , msgFlashReadRespAddrLen :: Word8 + , msgFlashReadResp_addr_len :: Word8 -- ^ Length of set of addresses to read, counting up from starting address } deriving ( Show, Read, Eq ) instance Binary MsgFlashReadResp where get = do - msgFlashReadRespTarget <- getWord8 - msgFlashReadRespAddrStart <- replicateM 3 getWord8 - msgFlashReadRespAddrLen <- getWord8 + msgFlashReadResp_target <- getWord8 + msgFlashReadResp_addr_start <- replicateM 3 getWord8 + msgFlashReadResp_addr_len <- getWord8 return MsgFlashReadResp {..} put MsgFlashReadResp {..} = do - putWord8 msgFlashReadRespTarget - mapM_ putWord8 msgFlashReadRespAddrStart - putWord8 msgFlashReadRespAddrLen + putWord8 msgFlashReadResp_target + mapM_ putWord8 msgFlashReadResp_addr_start + putWord8 msgFlashReadResp_addr_len +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgFlashReadResp_" . stripPrefix "msgFlashReadResp_"} + ''MsgFlashReadResp) + msgFlashErase :: Word16 msgFlashErase = 0x00E2 @@ -156,22 +171,25 @@ -- message containing the return code - FLASH_OK (0) on success or -- FLASH_INVALID_FLASH (1) if the flash specified is invalid. data MsgFlashErase = MsgFlashErase - { msgFlashEraseTarget :: Word8 + { msgFlashErase_target :: Word8 -- ^ Target flags - , msgFlashEraseSectorNum :: Word32 + , msgFlashErase_sector_num :: Word32 -- ^ Flash sector number to erase (0-11 for the STM, 0-15 for the M25) } deriving ( Show, Read, Eq ) instance Binary MsgFlashErase where get = do - msgFlashEraseTarget <- getWord8 - msgFlashEraseSectorNum <- getWord32le + msgFlashErase_target <- getWord8 + msgFlashErase_sector_num <- getWord32le return MsgFlashErase {..} put MsgFlashErase {..} = do - putWord8 msgFlashEraseTarget - putWord32le msgFlashEraseSectorNum + putWord8 msgFlashErase_target + putWord32le msgFlashErase_sector_num +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgFlashErase_" . stripPrefix "msgFlashErase_"} + ''MsgFlashErase) + msgStmFlashLockSector :: Word16 msgStmFlashLockSector = 0x00E3 @@ -180,18 +198,21 @@ -- The flash lock message locks a sector of the STM flash memory. The device -- replies with a MSG_FLASH_DONE message. data MsgStmFlashLockSector = MsgStmFlashLockSector - { msgStmFlashLockSectorSector :: Word32 + { msgStmFlashLockSector_sector :: Word32 -- ^ Flash sector number to lock } deriving ( Show, Read, Eq ) instance Binary MsgStmFlashLockSector where get = do - msgStmFlashLockSectorSector <- getWord32le + msgStmFlashLockSector_sector <- getWord32le return MsgStmFlashLockSector {..} put MsgStmFlashLockSector {..} = do - putWord32le msgStmFlashLockSectorSector + putWord32le msgStmFlashLockSector_sector +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgStmFlashLockSector_" . stripPrefix "msgStmFlashLockSector_"} + ''MsgStmFlashLockSector) + msgStmFlashUnlockSector :: Word16 msgStmFlashUnlockSector = 0x00E4 @@ -200,18 +221,21 @@ -- The flash unlock message unlocks a sector of the STM flash memory. The -- device replies with a MSG_FLASH_DONE message. data MsgStmFlashUnlockSector = MsgStmFlashUnlockSector - { msgStmFlashUnlockSectorSector :: Word32 + { msgStmFlashUnlockSector_sector :: Word32 -- ^ Flash sector number to unlock } deriving ( Show, Read, Eq ) instance Binary MsgStmFlashUnlockSector where get = do - msgStmFlashUnlockSectorSector <- getWord32le + msgStmFlashUnlockSector_sector <- getWord32le return MsgStmFlashUnlockSector {..} put MsgStmFlashUnlockSector {..} = do - putWord32le msgStmFlashUnlockSectorSector + putWord32le msgStmFlashUnlockSector_sector +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgStmFlashUnlockSector_" . stripPrefix "msgStmFlashUnlockSector_"} + ''MsgStmFlashUnlockSector) + msgStmUniqueIdReq :: Word16 msgStmUniqueIdReq = 0x00E8 @@ -239,18 +263,21 @@ -- ID by sending a MSG_STM_UNIQUE_ID_REQ. The device responds with a -- MSG_STM_UNIQUE_ID_RESP with the 12-byte unique ID in the payload.. data MsgStmUniqueIdResp = MsgStmUniqueIdResp - { msgStmUniqueIdRespStmId :: [Word8] + { msgStmUniqueIdResp_stm_id :: [Word8] -- ^ Device unique ID } deriving ( Show, Read, Eq ) instance Binary MsgStmUniqueIdResp where get = do - msgStmUniqueIdRespStmId <- replicateM 12 getWord8 + msgStmUniqueIdResp_stm_id <- replicateM 12 getWord8 return MsgStmUniqueIdResp {..} put MsgStmUniqueIdResp {..} = do - mapM_ putWord8 msgStmUniqueIdRespStmId + mapM_ putWord8 msgStmUniqueIdResp_stm_id +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgStmUniqueIdResp_" . stripPrefix "msgStmUniqueIdResp_"} + ''MsgStmUniqueIdResp) + msgM25FlashWriteStatus :: Word16 msgM25FlashWriteStatus = 0x00F3 @@ -259,14 +286,17 @@ -- The flash status message writes to the 8-bit M25 flash status register. The -- device replies with a MSG_FLASH_DONE message. data MsgM25FlashWriteStatus = MsgM25FlashWriteStatus - { msgM25FlashWriteStatusStatus :: [Word8] + { msgM25FlashWriteStatus_status :: [Word8] -- ^ Byte to write to the M25 flash status register } deriving ( Show, Read, Eq ) instance Binary MsgM25FlashWriteStatus where get = do - msgM25FlashWriteStatusStatus <- replicateM 1 getWord8 + msgM25FlashWriteStatus_status <- replicateM 1 getWord8 return MsgM25FlashWriteStatus {..} put MsgM25FlashWriteStatus {..} = do - mapM_ putWord8 msgM25FlashWriteStatusStatus + mapM_ putWord8 msgM25FlashWriteStatus_status + +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgM25FlashWriteStatus_" . stripPrefix "msgM25FlashWriteStatus_"} + ''MsgM25FlashWriteStatus) diff --git a/src/SwiftNav/SBP/Logging.hs b/src/SwiftNav/SBP/Logging.hs --- a/src/SwiftNav/SBP/Logging.hs +++ b/src/SwiftNav/SBP/Logging.hs @@ -11,8 +11,10 @@ module SwiftNav.SBP.Logging where +import BasicPrelude import Control.Monad import Control.Monad.Loops +import Data.Aeson.TH (deriveJSON, defaultOptions, fieldLabelModifier) import Data.Binary import Data.Binary.Get import Data.Binary.IEEE754 @@ -21,6 +23,7 @@ import Data.ByteString.Lazy hiding ( ByteString ) import Data.Int import Data.Word +import SwiftNav.SBP.Encoding msgLog :: Word16 msgLog = 0x0401 @@ -31,22 +34,25 @@ -- containing errors, warnings and informational messages at ERROR, WARNING, -- DEBUG, INFO logging levels. data MsgLog = MsgLog - { msgLogLevel :: Word8 + { msgLog_level :: Word8 -- ^ Logging level - , msgLogText :: ByteString + , msgLog_text :: ByteString -- ^ Human-readable string } deriving ( Show, Read, Eq ) instance Binary MsgLog where get = do - msgLogLevel <- getWord8 - msgLogText <- liftM toStrict getRemainingLazyByteString + msgLog_level <- getWord8 + msgLog_text <- liftM toStrict getRemainingLazyByteString return MsgLog {..} put MsgLog {..} = do - putWord8 msgLogLevel - putByteString msgLogText + putWord8 msgLog_level + putByteString msgLog_text +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgLog_" . stripPrefix "msgLog_"} + ''MsgLog) + msgTweet :: Word16 msgTweet = 0x0012 @@ -54,18 +60,21 @@ -- -- All the news fit to tweet. data MsgTweet = MsgTweet - { msgTweetTweet :: ByteString + { msgTweet_tweet :: ByteString -- ^ Human-readable string } deriving ( Show, Read, Eq ) instance Binary MsgTweet where get = do - msgTweetTweet <- getByteString 140 + msgTweet_tweet <- getByteString 140 return MsgTweet {..} put MsgTweet {..} = do - putByteString msgTweetTweet + putByteString msgTweet_tweet +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgTweet_" . stripPrefix "msgTweet_"} + ''MsgTweet) + msgPrintDep :: Word16 msgPrintDep = 0x0010 @@ -73,14 +82,17 @@ -- -- Deprecated. data MsgPrintDep = MsgPrintDep - { msgPrintDepText :: ByteString + { msgPrintDep_text :: ByteString -- ^ Human-readable string } deriving ( Show, Read, Eq ) instance Binary MsgPrintDep where get = do - msgPrintDepText <- liftM toStrict getRemainingLazyByteString + msgPrintDep_text <- liftM toStrict getRemainingLazyByteString return MsgPrintDep {..} put MsgPrintDep {..} = do - putByteString msgPrintDepText + putByteString msgPrintDep_text + +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgPrintDep_" . stripPrefix "msgPrintDep_"} + ''MsgPrintDep) diff --git a/src/SwiftNav/SBP/Navigation.hs b/src/SwiftNav/SBP/Navigation.hs --- a/src/SwiftNav/SBP/Navigation.hs +++ b/src/SwiftNav/SBP/Navigation.hs @@ -18,8 +18,10 @@ module SwiftNav.SBP.Navigation where +import BasicPrelude import Control.Monad import Control.Monad.Loops +import Data.Aeson.TH (deriveJSON, defaultOptions, fieldLabelModifier) import Data.Binary import Data.Binary.Get import Data.Binary.IEEE754 @@ -28,6 +30,7 @@ import Data.ByteString.Lazy hiding ( ByteString ) import Data.Int import Data.Word +import SwiftNav.SBP.Encoding msgGpsTime :: Word16 msgGpsTime = 0x0100 @@ -44,31 +47,34 @@ -- other navigation messages referenced to the same time (but lacking the ns -- field) and indicates a more precise time of these messages. data MsgGpsTime = MsgGpsTime - { msgGpsTimeWn :: Word16 + { msgGpsTime_wn :: Word16 -- ^ GPS week number - , msgGpsTimeTow :: Word32 + , msgGpsTime_tow :: Word32 -- ^ GPS time of week rounded to the nearest millisecond - , msgGpsTimeNs :: Int32 + , msgGpsTime_ns :: Int32 -- ^ Nanosecond residual of millisecond-rounded TOW (ranges from -500000 to -- 500000) - , msgGpsTimeFlags :: Word8 + , msgGpsTime_flags :: Word8 -- ^ Status flags (reserved) } deriving ( Show, Read, Eq ) instance Binary MsgGpsTime where get = do - msgGpsTimeWn <- getWord16le - msgGpsTimeTow <- getWord32le - msgGpsTimeNs <- liftM fromIntegral getWord32le - msgGpsTimeFlags <- getWord8 + msgGpsTime_wn <- getWord16le + msgGpsTime_tow <- getWord32le + msgGpsTime_ns <- liftM fromIntegral getWord32le + msgGpsTime_flags <- getWord8 return MsgGpsTime {..} put MsgGpsTime {..} = do - putWord16le msgGpsTimeWn - putWord32le msgGpsTimeTow - putWord32le $ fromIntegral msgGpsTimeNs - putWord8 msgGpsTimeFlags + putWord16le msgGpsTime_wn + putWord32le msgGpsTime_tow + putWord32le $ fromIntegral msgGpsTime_ns + putWord8 msgGpsTime_flags +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgGpsTime_" . stripPrefix "msgGpsTime_"} + ''MsgGpsTime) + msgDops :: Word16 msgDops = 0x0206 @@ -77,38 +83,41 @@ -- This dilution of precision (DOP) message describes the effect of navigation -- satellite geometry on positional measurement precision. data MsgDops = MsgDops - { msgDopsTow :: Word32 + { msgDops_tow :: Word32 -- ^ GPS Time of Week - , msgDopsGdop :: Word16 + , msgDops_gdop :: Word16 -- ^ Geometric Dilution of Precision - , msgDopsPdop :: Word16 + , msgDops_pdop :: Word16 -- ^ Position Dilution of Precision - , msgDopsTdop :: Word16 + , msgDops_tdop :: Word16 -- ^ Time Dilution of Precision - , msgDopsHdop :: Word16 + , msgDops_hdop :: Word16 -- ^ Horizontal Dilution of Precision - , msgDopsVdop :: Word16 + , msgDops_vdop :: Word16 -- ^ Vertical Dilution of Precision } deriving ( Show, Read, Eq ) instance Binary MsgDops where get = do - msgDopsTow <- getWord32le - msgDopsGdop <- getWord16le - msgDopsPdop <- getWord16le - msgDopsTdop <- getWord16le - msgDopsHdop <- getWord16le - msgDopsVdop <- getWord16le + msgDops_tow <- getWord32le + msgDops_gdop <- getWord16le + msgDops_pdop <- getWord16le + msgDops_tdop <- getWord16le + msgDops_hdop <- getWord16le + msgDops_vdop <- getWord16le return MsgDops {..} put MsgDops {..} = do - putWord32le msgDopsTow - putWord16le msgDopsGdop - putWord16le msgDopsPdop - putWord16le msgDopsTdop - putWord16le msgDopsHdop - putWord16le msgDopsVdop + putWord32le msgDops_tow + putWord16le msgDops_gdop + putWord16le msgDops_pdop + putWord16le msgDops_tdop + putWord16le msgDops_hdop + putWord16le msgDops_vdop +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgDops_" . stripPrefix "msgDops_"} + ''MsgDops) + msgPosEcef :: Word16 msgPosEcef = 0x0200 @@ -122,42 +131,45 @@ -- baseline vector. The full GPS time is given by the preceding MSG_GPS_TIME -- with the matching time-of-week (tow). data MsgPosEcef = MsgPosEcef - { msgPosEcefTow :: Word32 + { msgPosEcef_tow :: Word32 -- ^ GPS Time of Week - , msgPosEcefX :: Double + , msgPosEcef_x :: Double -- ^ ECEF X coordinate - , msgPosEcefY :: Double + , msgPosEcef_y :: Double -- ^ ECEF Y coordinate - , msgPosEcefZ :: Double + , msgPosEcef_z :: Double -- ^ ECEF Z coordinate - , msgPosEcefAccuracy :: Word16 + , msgPosEcef_accuracy :: Word16 -- ^ Position accuracy estimate (not implemented). Defaults to 0. - , msgPosEcefNSats :: Word8 + , msgPosEcef_n_sats :: Word8 -- ^ Number of satellites used in solution - , msgPosEcefFlags :: Word8 + , msgPosEcef_flags :: Word8 -- ^ Status flags } deriving ( Show, Read, Eq ) instance Binary MsgPosEcef where get = do - msgPosEcefTow <- getWord32le - msgPosEcefX <- getFloat64le - msgPosEcefY <- getFloat64le - msgPosEcefZ <- getFloat64le - msgPosEcefAccuracy <- getWord16le - msgPosEcefNSats <- getWord8 - msgPosEcefFlags <- getWord8 + msgPosEcef_tow <- getWord32le + msgPosEcef_x <- getFloat64le + msgPosEcef_y <- getFloat64le + msgPosEcef_z <- getFloat64le + msgPosEcef_accuracy <- getWord16le + msgPosEcef_n_sats <- getWord8 + msgPosEcef_flags <- getWord8 return MsgPosEcef {..} put MsgPosEcef {..} = do - putWord32le msgPosEcefTow - putFloat64le msgPosEcefX - putFloat64le msgPosEcefY - putFloat64le msgPosEcefZ - putWord16le msgPosEcefAccuracy - putWord8 msgPosEcefNSats - putWord8 msgPosEcefFlags + putWord32le msgPosEcef_tow + putFloat64le msgPosEcef_x + putFloat64le msgPosEcef_y + putFloat64le msgPosEcef_z + putWord16le msgPosEcef_accuracy + putWord8 msgPosEcef_n_sats + putWord8 msgPosEcef_flags +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgPosEcef_" . stripPrefix "msgPosEcef_"} + ''MsgPosEcef) + msgPosLlh :: Word16 msgPosLlh = 0x0201 @@ -171,46 +183,49 @@ -- time is given by the preceding MSG_GPS_TIME with the matching time-of-week -- (tow). data MsgPosLlh = MsgPosLlh - { msgPosLlhTow :: Word32 + { msgPosLlh_tow :: Word32 -- ^ GPS Time of Week - , msgPosLlhLat :: Double + , msgPosLlh_lat :: Double -- ^ Latitude - , msgPosLlhLon :: Double + , msgPosLlh_lon :: Double -- ^ Longitude - , msgPosLlhHeight :: Double + , msgPosLlh_height :: Double -- ^ Height - , msgPosLlhHAccuracy :: Word16 + , msgPosLlh_h_accuracy :: Word16 -- ^ Horizontal position accuracy estimate (not implemented). Defaults to 0. - , msgPosLlhVAccuracy :: Word16 + , msgPosLlh_v_accuracy :: Word16 -- ^ Vertical position accuracy estimate (not implemented). Defaults to 0. - , msgPosLlhNSats :: Word8 + , msgPosLlh_n_sats :: Word8 -- ^ Number of satellites used in solution. - , msgPosLlhFlags :: Word8 + , msgPosLlh_flags :: Word8 -- ^ Status flags } deriving ( Show, Read, Eq ) instance Binary MsgPosLlh where get = do - msgPosLlhTow <- getWord32le - msgPosLlhLat <- getFloat64le - msgPosLlhLon <- getFloat64le - msgPosLlhHeight <- getFloat64le - msgPosLlhHAccuracy <- getWord16le - msgPosLlhVAccuracy <- getWord16le - msgPosLlhNSats <- getWord8 - msgPosLlhFlags <- getWord8 + msgPosLlh_tow <- getWord32le + msgPosLlh_lat <- getFloat64le + msgPosLlh_lon <- getFloat64le + msgPosLlh_height <- getFloat64le + msgPosLlh_h_accuracy <- getWord16le + msgPosLlh_v_accuracy <- getWord16le + msgPosLlh_n_sats <- getWord8 + msgPosLlh_flags <- getWord8 return MsgPosLlh {..} put MsgPosLlh {..} = do - putWord32le msgPosLlhTow - putFloat64le msgPosLlhLat - putFloat64le msgPosLlhLon - putFloat64le msgPosLlhHeight - putWord16le msgPosLlhHAccuracy - putWord16le msgPosLlhVAccuracy - putWord8 msgPosLlhNSats - putWord8 msgPosLlhFlags + putWord32le msgPosLlh_tow + putFloat64le msgPosLlh_lat + putFloat64le msgPosLlh_lon + putFloat64le msgPosLlh_height + putWord16le msgPosLlh_h_accuracy + putWord16le msgPosLlh_v_accuracy + putWord8 msgPosLlh_n_sats + putWord8 msgPosLlh_flags +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgPosLlh_" . stripPrefix "msgPosLlh_"} + ''MsgPosLlh) + msgBaselineEcef :: Word16 msgBaselineEcef = 0x0202 @@ -221,42 +236,45 @@ -- base station to the rover receiver. The full GPS time is given by the -- preceding MSG_GPS_TIME with the matching time-of-week (tow). data MsgBaselineEcef = MsgBaselineEcef - { msgBaselineEcefTow :: Word32 + { msgBaselineEcef_tow :: Word32 -- ^ GPS Time of Week - , msgBaselineEcefX :: Int32 + , msgBaselineEcef_x :: Int32 -- ^ Baseline ECEF X coordinate - , msgBaselineEcefY :: Int32 + , msgBaselineEcef_y :: Int32 -- ^ Baseline ECEF Y coordinate - , msgBaselineEcefZ :: Int32 + , msgBaselineEcef_z :: Int32 -- ^ Baseline ECEF Z coordinate - , msgBaselineEcefAccuracy :: Word16 + , msgBaselineEcef_accuracy :: Word16 -- ^ Position accuracy estimate (not implemented). Defaults to 0. - , msgBaselineEcefNSats :: Word8 + , msgBaselineEcef_n_sats :: Word8 -- ^ Number of satellites used in solution - , msgBaselineEcefFlags :: Word8 + , msgBaselineEcef_flags :: Word8 -- ^ Status flags } deriving ( Show, Read, Eq ) instance Binary MsgBaselineEcef where get = do - msgBaselineEcefTow <- getWord32le - msgBaselineEcefX <- liftM fromIntegral getWord32le - msgBaselineEcefY <- liftM fromIntegral getWord32le - msgBaselineEcefZ <- liftM fromIntegral getWord32le - msgBaselineEcefAccuracy <- getWord16le - msgBaselineEcefNSats <- getWord8 - msgBaselineEcefFlags <- getWord8 + msgBaselineEcef_tow <- getWord32le + msgBaselineEcef_x <- liftM fromIntegral getWord32le + msgBaselineEcef_y <- liftM fromIntegral getWord32le + msgBaselineEcef_z <- liftM fromIntegral getWord32le + msgBaselineEcef_accuracy <- getWord16le + msgBaselineEcef_n_sats <- getWord8 + msgBaselineEcef_flags <- getWord8 return MsgBaselineEcef {..} put MsgBaselineEcef {..} = do - putWord32le msgBaselineEcefTow - putWord32le $ fromIntegral msgBaselineEcefX - putWord32le $ fromIntegral msgBaselineEcefY - putWord32le $ fromIntegral msgBaselineEcefZ - putWord16le msgBaselineEcefAccuracy - putWord8 msgBaselineEcefNSats - putWord8 msgBaselineEcefFlags + putWord32le msgBaselineEcef_tow + putWord32le $ fromIntegral msgBaselineEcef_x + putWord32le $ fromIntegral msgBaselineEcef_y + putWord32le $ fromIntegral msgBaselineEcef_z + putWord16le msgBaselineEcef_accuracy + putWord8 msgBaselineEcef_n_sats + putWord8 msgBaselineEcef_flags +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgBaselineEcef_" . stripPrefix "msgBaselineEcef_"} + ''MsgBaselineEcef) + msgBaselineNed :: Word16 msgBaselineNed = 0x0203 @@ -269,46 +287,49 @@ -- time is given by the preceding MSG_GPS_TIME with the matching time-of-week -- (tow). data MsgBaselineNed = MsgBaselineNed - { msgBaselineNedTow :: Word32 + { msgBaselineNed_tow :: Word32 -- ^ GPS Time of Week - , msgBaselineNedN :: Int32 + , msgBaselineNed_n :: Int32 -- ^ Baseline North coordinate - , msgBaselineNedE :: Int32 + , msgBaselineNed_e :: Int32 -- ^ Baseline East coordinate - , msgBaselineNedD :: Int32 + , msgBaselineNed_d :: Int32 -- ^ Baseline Down coordinate - , msgBaselineNedHAccuracy :: Word16 + , msgBaselineNed_h_accuracy :: Word16 -- ^ Horizontal position accuracy estimate (not implemented). Defaults to 0. - , msgBaselineNedVAccuracy :: Word16 + , msgBaselineNed_v_accuracy :: Word16 -- ^ Vertical position accuracy estimate (not implemented). Defaults to 0. - , msgBaselineNedNSats :: Word8 + , msgBaselineNed_n_sats :: Word8 -- ^ Number of satellites used in solution - , msgBaselineNedFlags :: Word8 + , msgBaselineNed_flags :: Word8 -- ^ Status flags } deriving ( Show, Read, Eq ) instance Binary MsgBaselineNed where get = do - msgBaselineNedTow <- getWord32le - msgBaselineNedN <- liftM fromIntegral getWord32le - msgBaselineNedE <- liftM fromIntegral getWord32le - msgBaselineNedD <- liftM fromIntegral getWord32le - msgBaselineNedHAccuracy <- getWord16le - msgBaselineNedVAccuracy <- getWord16le - msgBaselineNedNSats <- getWord8 - msgBaselineNedFlags <- getWord8 + msgBaselineNed_tow <- getWord32le + msgBaselineNed_n <- liftM fromIntegral getWord32le + msgBaselineNed_e <- liftM fromIntegral getWord32le + msgBaselineNed_d <- liftM fromIntegral getWord32le + msgBaselineNed_h_accuracy <- getWord16le + msgBaselineNed_v_accuracy <- getWord16le + msgBaselineNed_n_sats <- getWord8 + msgBaselineNed_flags <- getWord8 return MsgBaselineNed {..} put MsgBaselineNed {..} = do - putWord32le msgBaselineNedTow - putWord32le $ fromIntegral msgBaselineNedN - putWord32le $ fromIntegral msgBaselineNedE - putWord32le $ fromIntegral msgBaselineNedD - putWord16le msgBaselineNedHAccuracy - putWord16le msgBaselineNedVAccuracy - putWord8 msgBaselineNedNSats - putWord8 msgBaselineNedFlags + putWord32le msgBaselineNed_tow + putWord32le $ fromIntegral msgBaselineNed_n + putWord32le $ fromIntegral msgBaselineNed_e + putWord32le $ fromIntegral msgBaselineNed_d + putWord16le msgBaselineNed_h_accuracy + putWord16le msgBaselineNed_v_accuracy + putWord8 msgBaselineNed_n_sats + putWord8 msgBaselineNed_flags +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgBaselineNed_" . stripPrefix "msgBaselineNed_"} + ''MsgBaselineNed) + msgVelEcef :: Word16 msgVelEcef = 0x0204 @@ -318,42 +339,45 @@ -- coordinates. The full GPS time is given by the preceding MSG_GPS_TIME with -- the matching time-of-week (tow). data MsgVelEcef = MsgVelEcef - { msgVelEcefTow :: Word32 + { msgVelEcef_tow :: Word32 -- ^ GPS Time of Week - , msgVelEcefX :: Int32 + , msgVelEcef_x :: Int32 -- ^ Velocity ECEF X coordinate - , msgVelEcefY :: Int32 + , msgVelEcef_y :: Int32 -- ^ Velocity ECEF Y coordinate - , msgVelEcefZ :: Int32 + , msgVelEcef_z :: Int32 -- ^ Velocity ECEF Z coordinate - , msgVelEcefAccuracy :: Word16 + , msgVelEcef_accuracy :: Word16 -- ^ Velocity accuracy estimate (not implemented). Defaults to 0. - , msgVelEcefNSats :: Word8 + , msgVelEcef_n_sats :: Word8 -- ^ Number of satellites used in solution - , msgVelEcefFlags :: Word8 + , msgVelEcef_flags :: Word8 -- ^ Status flags (reserved) } deriving ( Show, Read, Eq ) instance Binary MsgVelEcef where get = do - msgVelEcefTow <- getWord32le - msgVelEcefX <- liftM fromIntegral getWord32le - msgVelEcefY <- liftM fromIntegral getWord32le - msgVelEcefZ <- liftM fromIntegral getWord32le - msgVelEcefAccuracy <- getWord16le - msgVelEcefNSats <- getWord8 - msgVelEcefFlags <- getWord8 + msgVelEcef_tow <- getWord32le + msgVelEcef_x <- liftM fromIntegral getWord32le + msgVelEcef_y <- liftM fromIntegral getWord32le + msgVelEcef_z <- liftM fromIntegral getWord32le + msgVelEcef_accuracy <- getWord16le + msgVelEcef_n_sats <- getWord8 + msgVelEcef_flags <- getWord8 return MsgVelEcef {..} put MsgVelEcef {..} = do - putWord32le msgVelEcefTow - putWord32le $ fromIntegral msgVelEcefX - putWord32le $ fromIntegral msgVelEcefY - putWord32le $ fromIntegral msgVelEcefZ - putWord16le msgVelEcefAccuracy - putWord8 msgVelEcefNSats - putWord8 msgVelEcefFlags + putWord32le msgVelEcef_tow + putWord32le $ fromIntegral msgVelEcef_x + putWord32le $ fromIntegral msgVelEcef_y + putWord32le $ fromIntegral msgVelEcef_z + putWord16le msgVelEcef_accuracy + putWord8 msgVelEcef_n_sats + putWord8 msgVelEcef_flags +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgVelEcef_" . stripPrefix "msgVelEcef_"} + ''MsgVelEcef) + msgVelNed :: Word16 msgVelNed = 0x0205 @@ -363,42 +387,45 @@ -- coordinates. The full GPS time is given by the preceding MSG_GPS_TIME with -- the matching time-of-week (tow). data MsgVelNed = MsgVelNed - { msgVelNedTow :: Word32 + { msgVelNed_tow :: Word32 -- ^ GPS Time of Week - , msgVelNedN :: Int32 + , msgVelNed_n :: Int32 -- ^ Velocity North coordinate - , msgVelNedE :: Int32 + , msgVelNed_e :: Int32 -- ^ Velocity East coordinate - , msgVelNedD :: Int32 + , msgVelNed_d :: Int32 -- ^ Velocity Down coordinate - , msgVelNedHAccuracy :: Word16 + , msgVelNed_h_accuracy :: Word16 -- ^ Horizontal velocity accuracy estimate (not implemented). Defaults to 0. - , msgVelNedVAccuracy :: Word16 + , msgVelNed_v_accuracy :: Word16 -- ^ Vertical velocity accuracy estimate (not implemented). Defaults to 0. - , msgVelNedNSats :: Word8 + , msgVelNed_n_sats :: Word8 -- ^ Number of satellites used in solution - , msgVelNedFlags :: Word8 + , msgVelNed_flags :: Word8 -- ^ Status flags (reserved) } deriving ( Show, Read, Eq ) instance Binary MsgVelNed where get = do - msgVelNedTow <- getWord32le - msgVelNedN <- liftM fromIntegral getWord32le - msgVelNedE <- liftM fromIntegral getWord32le - msgVelNedD <- liftM fromIntegral getWord32le - msgVelNedHAccuracy <- getWord16le - msgVelNedVAccuracy <- getWord16le - msgVelNedNSats <- getWord8 - msgVelNedFlags <- getWord8 + msgVelNed_tow <- getWord32le + msgVelNed_n <- liftM fromIntegral getWord32le + msgVelNed_e <- liftM fromIntegral getWord32le + msgVelNed_d <- liftM fromIntegral getWord32le + msgVelNed_h_accuracy <- getWord16le + msgVelNed_v_accuracy <- getWord16le + msgVelNed_n_sats <- getWord8 + msgVelNed_flags <- getWord8 return MsgVelNed {..} put MsgVelNed {..} = do - putWord32le msgVelNedTow - putWord32le $ fromIntegral msgVelNedN - putWord32le $ fromIntegral msgVelNedE - putWord32le $ fromIntegral msgVelNedD - putWord16le msgVelNedHAccuracy - putWord16le msgVelNedVAccuracy - putWord8 msgVelNedNSats - putWord8 msgVelNedFlags + putWord32le msgVelNed_tow + putWord32le $ fromIntegral msgVelNed_n + putWord32le $ fromIntegral msgVelNed_e + putWord32le $ fromIntegral msgVelNed_d + putWord16le msgVelNed_h_accuracy + putWord16le msgVelNed_v_accuracy + putWord8 msgVelNed_n_sats + putWord8 msgVelNed_flags + +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgVelNed_" . stripPrefix "msgVelNed_"} + ''MsgVelNed) diff --git a/src/SwiftNav/SBP/Observation.hs b/src/SwiftNav/SBP/Observation.hs --- a/src/SwiftNav/SBP/Observation.hs +++ b/src/SwiftNav/SBP/Observation.hs @@ -10,8 +10,10 @@ module SwiftNav.SBP.Observation where +import BasicPrelude import Control.Monad import Control.Monad.Loops +import Data.Aeson.TH (deriveJSON, defaultOptions, fieldLabelModifier) import Data.Binary import Data.Binary.Get import Data.Binary.IEEE754 @@ -20,86 +22,96 @@ import Data.ByteString.Lazy hiding ( ByteString ) import Data.Int import Data.Word +import SwiftNav.SBP.Encoding -- | ObsGPSTime. -- -- A wire-appropriate GPS time, defined as the number of milliseconds since -- beginning of the week on the Saturday/Sunday transition. data ObsGPSTime = ObsGPSTime - { obsGPSTimeTow :: Word32 + { obsGPSTime_tow :: Word32 -- ^ Milliseconds since start of GPS week - , obsGPSTimeWn :: Word16 + , obsGPSTime_wn :: Word16 -- ^ GPS week number } deriving ( Show, Read, Eq ) instance Binary ObsGPSTime where get = do - obsGPSTimeTow <- getWord32le - obsGPSTimeWn <- getWord16le + obsGPSTime_tow <- getWord32le + obsGPSTime_wn <- getWord16le return ObsGPSTime {..} put ObsGPSTime {..} = do - putWord32le obsGPSTimeTow - putWord16le obsGPSTimeWn + putWord32le obsGPSTime_tow + putWord16le obsGPSTime_wn +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "obsGPSTime_" . stripPrefix "obsGPSTime_"} + ''ObsGPSTime) + -- | 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. data CarrierPhase = CarrierPhase - { carrierPhaseI :: Int32 + { carrierPhase_i :: Int32 -- ^ Carrier phase whole cycles - , carrierPhaseF :: Word8 + , carrierPhase_f :: Word8 -- ^ Carrier phase fractional part } deriving ( Show, Read, Eq ) instance Binary CarrierPhase where get = do - carrierPhaseI <- liftM fromIntegral getWord32le - carrierPhaseF <- getWord8 + carrierPhase_i <- liftM fromIntegral getWord32le + carrierPhase_f <- getWord8 return CarrierPhase {..} put CarrierPhase {..} = do - putWord32le $ fromIntegral carrierPhaseI - putWord8 carrierPhaseF + putWord32le $ fromIntegral carrierPhase_i + putWord8 carrierPhase_f +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "carrierPhase_" . stripPrefix "carrierPhase_"} + ''CarrierPhase) + -- | ObservationHeader. -- -- Header of a GPS observation message. data ObservationHeader = ObservationHeader - { observationHeaderT :: ObsGPSTime + { observationHeader_t :: ObsGPSTime -- ^ GPS time of this observation - , observationHeaderNObs :: Word8 + , observationHeader_n_obs :: Word8 -- ^ Total number of observations. First nibble is the size of the sequence -- (n), second nibble is the zero-indexed counter (ith packet of n) } deriving ( Show, Read, Eq ) instance Binary ObservationHeader where get = do - observationHeaderT <- get - observationHeaderNObs <- getWord8 + observationHeader_t <- get + observationHeader_n_obs <- getWord8 return ObservationHeader {..} put ObservationHeader {..} = do - put observationHeaderT - putWord8 observationHeaderNObs + put observationHeader_t + putWord8 observationHeader_n_obs +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "observationHeader_" . stripPrefix "observationHeader_"} + ''ObservationHeader) + -- | PackedObsContent. -- -- Pseudorange and carrier phase observation for a satellite being tracked. data PackedObsContent = PackedObsContent - { packedObsContentP :: Word32 + { packedObsContent_P :: Word32 -- ^ Pseudorange observation - , packedObsContentL :: CarrierPhase + , packedObsContent_L :: CarrierPhase -- ^ Carrier phase observation - , packedObsContentCn0 :: Word8 + , packedObsContent_cn0 :: Word8 -- ^ Carrier-to-Noise density - , packedObsContentLock :: Word16 + , packedObsContent_lock :: Word16 -- ^ Lock indicator. This value changes whenever a satellite signal has lost -- and regained lock, indicating that the carrier phase ambiguity may have -- changed. - , packedObsContentSid :: Word32 + , packedObsContent_sid :: Word32 -- ^ Signal identifier of the satellite signal - values 0x00 through 0x1F -- represent GPS PRNs 1 through 32 respectively (PRN-1 notation); other -- values reserved for future use. @@ -107,20 +119,23 @@ instance Binary PackedObsContent where get = do - packedObsContentP <- getWord32le - packedObsContentL <- get - packedObsContentCn0 <- getWord8 - packedObsContentLock <- getWord16le - packedObsContentSid <- getWord32le + packedObsContent_P <- getWord32le + packedObsContent_L <- get + packedObsContent_cn0 <- getWord8 + packedObsContent_lock <- getWord16le + packedObsContent_sid <- getWord32le return PackedObsContent {..} put PackedObsContent {..} = do - putWord32le packedObsContentP - put packedObsContentL - putWord8 packedObsContentCn0 - putWord16le packedObsContentLock - putWord32le packedObsContentSid + putWord32le packedObsContent_P + put packedObsContent_L + putWord8 packedObsContent_cn0 + putWord16le packedObsContent_lock + putWord32le packedObsContent_sid +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "packedObsContent_" . stripPrefix "packedObsContent_"} + ''PackedObsContent) + msgObs :: Word16 msgObs = 0x0043 @@ -131,22 +146,25 @@ -- phase observation here is 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). data MsgObs = MsgObs - { msgObsHeader :: ObservationHeader + { msgObs_header :: ObservationHeader -- ^ Header of a GPS observation message - , msgObsObs :: [PackedObsContent] + , msgObs_obs :: [PackedObsContent] -- ^ Pseudorange and carrier phase observation for a satellite being tracked. } deriving ( Show, Read, Eq ) instance Binary MsgObs where get = do - msgObsHeader <- get - msgObsObs <- whileM (liftM not isEmpty) get + msgObs_header <- get + msgObs_obs <- whileM (liftM not isEmpty) get return MsgObs {..} put MsgObs {..} = do - put msgObsHeader - mapM_ put msgObsObs + put msgObs_header + mapM_ put msgObs_obs +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgObs_" . stripPrefix "msgObs_"} + ''MsgObs) + msgBasePos :: Word16 msgBasePos = 0x0044 @@ -157,26 +175,29 @@ -- required to be a high-accuracy surveyed location of the base station. Any -- error here will result in an error in the pseudo-absolute position output. data MsgBasePos = MsgBasePos - { msgBasePosLat :: Double + { msgBasePos_lat :: Double -- ^ Latitude - , msgBasePosLon :: Double + , msgBasePos_lon :: Double -- ^ Longitude - , msgBasePosHeight :: Double + , msgBasePos_height :: Double -- ^ Height } deriving ( Show, Read, Eq ) instance Binary MsgBasePos where get = do - msgBasePosLat <- getFloat64le - msgBasePosLon <- getFloat64le - msgBasePosHeight <- getFloat64le + msgBasePos_lat <- getFloat64le + msgBasePos_lon <- getFloat64le + msgBasePos_height <- getFloat64le return MsgBasePos {..} put MsgBasePos {..} = do - putFloat64le msgBasePosLat - putFloat64le msgBasePosLon - putFloat64le msgBasePosHeight + putFloat64le msgBasePos_lat + putFloat64le msgBasePos_lon + putFloat64le msgBasePos_height +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgBasePos_" . stripPrefix "msgBasePos_"} + ''MsgBasePos) + msgEphemeris :: Word16 msgEphemeris = 0x0047 @@ -187,136 +208,139 @@ -- see the Navstar GPS Space Segment/Navigation user interfaces (ICD-GPS-200, -- Table 20-III) for more details. data MsgEphemeris = MsgEphemeris - { msgEphemerisTgd :: Double + { msgEphemeris_tgd :: Double -- ^ Group delay differential between L1 and L2 - , msgEphemerisCRs :: Double + , msgEphemeris_c_rs :: Double -- ^ Amplitude of the sine harmonic correction term to the orbit radius - , msgEphemerisCRc :: Double + , msgEphemeris_c_rc :: Double -- ^ Amplitude of the cosine harmonic correction term to the orbit radius - , msgEphemerisCUc :: Double + , msgEphemeris_c_uc :: Double -- ^ Amplitude of the cosine harmonic correction term to the argument of -- latitude - , msgEphemerisCUs :: Double + , msgEphemeris_c_us :: Double -- ^ Amplitude of the sine harmonic correction term to the argument of -- latitude - , msgEphemerisCIc :: Double + , msgEphemeris_c_ic :: Double -- ^ Amplitude of the cosine harmonic correction term to the angle of -- inclination - , msgEphemerisCIs :: Double + , msgEphemeris_c_is :: Double -- ^ Amplitude of the sine harmonic correction term to the angle of -- inclination - , msgEphemerisDn :: Double + , msgEphemeris_dn :: Double -- ^ Mean motion difference - , msgEphemerisM0 :: Double + , msgEphemeris_m0 :: Double -- ^ Mean anomaly at reference time - , msgEphemerisEcc :: Double + , msgEphemeris_ecc :: Double -- ^ Eccentricity of satellite orbit - , msgEphemerisSqrta :: Double + , msgEphemeris_sqrta :: Double -- ^ Square root of the semi-major axis of orbit - , msgEphemerisOmega0 :: Double + , msgEphemeris_omega0 :: Double -- ^ Longitude of ascending node of orbit plane at weekly epoch - , msgEphemerisOmegadot :: Double + , msgEphemeris_omegadot :: Double -- ^ Rate of right ascension - , msgEphemerisW :: Double + , msgEphemeris_w :: Double -- ^ Argument of perigee - , msgEphemerisInc :: Double + , msgEphemeris_inc :: Double -- ^ Inclination - , msgEphemerisIncDot :: Double + , msgEphemeris_inc_dot :: Double -- ^ Inclination first derivative - , msgEphemerisAf0 :: Double + , msgEphemeris_af0 :: Double -- ^ Polynomial clock correction coefficient (clock bias) - , msgEphemerisAf1 :: Double + , msgEphemeris_af1 :: Double -- ^ Polynomial clock correction coefficient (clock drift) - , msgEphemerisAf2 :: Double + , msgEphemeris_af2 :: Double -- ^ Polynomial clock correction coefficient (rate of clock drift) - , msgEphemerisToeTow :: Double + , msgEphemeris_toe_tow :: Double -- ^ Time of week - , msgEphemerisToeWn :: Word16 + , msgEphemeris_toe_wn :: Word16 -- ^ Week number - , msgEphemerisTocTow :: Double + , msgEphemeris_toc_tow :: Double -- ^ Clock reference time of week - , msgEphemerisTocWn :: Word16 + , msgEphemeris_toc_wn :: Word16 -- ^ Clock reference week number - , msgEphemerisValid :: Word8 + , msgEphemeris_valid :: Word8 -- ^ Is valid? - , msgEphemerisHealthy :: Word8 + , msgEphemeris_healthy :: Word8 -- ^ Satellite is healthy? - , msgEphemerisSid :: Word32 + , msgEphemeris_sid :: Word32 -- ^ Signal identifier being tracked - values 0x00 through 0x1F represent GPS -- PRNs 1 through 32 respectively (PRN-1 notation); other values reserved -- for future use - , msgEphemerisIode :: Word8 + , msgEphemeris_iode :: Word8 -- ^ Issue of ephemeris data - , msgEphemerisIodc :: Word16 + , msgEphemeris_iodc :: Word16 -- ^ Issue of clock data - , msgEphemerisReserved :: Word32 + , msgEphemeris_reserved :: Word32 -- ^ Reserved field } deriving ( Show, Read, Eq ) instance Binary MsgEphemeris where get = do - msgEphemerisTgd <- getFloat64le - msgEphemerisCRs <- getFloat64le - msgEphemerisCRc <- getFloat64le - msgEphemerisCUc <- getFloat64le - msgEphemerisCUs <- getFloat64le - msgEphemerisCIc <- getFloat64le - msgEphemerisCIs <- getFloat64le - msgEphemerisDn <- getFloat64le - msgEphemerisM0 <- getFloat64le - msgEphemerisEcc <- getFloat64le - msgEphemerisSqrta <- getFloat64le - msgEphemerisOmega0 <- getFloat64le - msgEphemerisOmegadot <- getFloat64le - msgEphemerisW <- getFloat64le - msgEphemerisInc <- getFloat64le - msgEphemerisIncDot <- getFloat64le - msgEphemerisAf0 <- getFloat64le - msgEphemerisAf1 <- getFloat64le - msgEphemerisAf2 <- getFloat64le - msgEphemerisToeTow <- getFloat64le - msgEphemerisToeWn <- getWord16le - msgEphemerisTocTow <- getFloat64le - msgEphemerisTocWn <- getWord16le - msgEphemerisValid <- getWord8 - msgEphemerisHealthy <- getWord8 - msgEphemerisSid <- getWord32le - msgEphemerisIode <- getWord8 - msgEphemerisIodc <- getWord16le - msgEphemerisReserved <- getWord32le + msgEphemeris_tgd <- getFloat64le + msgEphemeris_c_rs <- getFloat64le + msgEphemeris_c_rc <- getFloat64le + msgEphemeris_c_uc <- getFloat64le + msgEphemeris_c_us <- getFloat64le + msgEphemeris_c_ic <- getFloat64le + msgEphemeris_c_is <- getFloat64le + msgEphemeris_dn <- getFloat64le + msgEphemeris_m0 <- getFloat64le + msgEphemeris_ecc <- getFloat64le + msgEphemeris_sqrta <- getFloat64le + msgEphemeris_omega0 <- getFloat64le + msgEphemeris_omegadot <- getFloat64le + msgEphemeris_w <- getFloat64le + msgEphemeris_inc <- getFloat64le + msgEphemeris_inc_dot <- getFloat64le + msgEphemeris_af0 <- getFloat64le + msgEphemeris_af1 <- getFloat64le + msgEphemeris_af2 <- getFloat64le + msgEphemeris_toe_tow <- getFloat64le + msgEphemeris_toe_wn <- getWord16le + msgEphemeris_toc_tow <- getFloat64le + msgEphemeris_toc_wn <- getWord16le + msgEphemeris_valid <- getWord8 + msgEphemeris_healthy <- getWord8 + msgEphemeris_sid <- getWord32le + msgEphemeris_iode <- getWord8 + msgEphemeris_iodc <- getWord16le + msgEphemeris_reserved <- getWord32le return MsgEphemeris {..} put MsgEphemeris {..} = do - putFloat64le msgEphemerisTgd - putFloat64le msgEphemerisCRs - putFloat64le msgEphemerisCRc - putFloat64le msgEphemerisCUc - putFloat64le msgEphemerisCUs - putFloat64le msgEphemerisCIc - putFloat64le msgEphemerisCIs - putFloat64le msgEphemerisDn - putFloat64le msgEphemerisM0 - putFloat64le msgEphemerisEcc - putFloat64le msgEphemerisSqrta - putFloat64le msgEphemerisOmega0 - putFloat64le msgEphemerisOmegadot - putFloat64le msgEphemerisW - putFloat64le msgEphemerisInc - putFloat64le msgEphemerisIncDot - putFloat64le msgEphemerisAf0 - putFloat64le msgEphemerisAf1 - putFloat64le msgEphemerisAf2 - putFloat64le msgEphemerisToeTow - putWord16le msgEphemerisToeWn - putFloat64le msgEphemerisTocTow - putWord16le msgEphemerisTocWn - putWord8 msgEphemerisValid - putWord8 msgEphemerisHealthy - putWord32le msgEphemerisSid - putWord8 msgEphemerisIode - putWord16le msgEphemerisIodc - putWord32le msgEphemerisReserved + putFloat64le msgEphemeris_tgd + putFloat64le msgEphemeris_c_rs + putFloat64le msgEphemeris_c_rc + putFloat64le msgEphemeris_c_uc + putFloat64le msgEphemeris_c_us + putFloat64le msgEphemeris_c_ic + putFloat64le msgEphemeris_c_is + putFloat64le msgEphemeris_dn + putFloat64le msgEphemeris_m0 + putFloat64le msgEphemeris_ecc + putFloat64le msgEphemeris_sqrta + putFloat64le msgEphemeris_omega0 + putFloat64le msgEphemeris_omegadot + putFloat64le msgEphemeris_w + putFloat64le msgEphemeris_inc + putFloat64le msgEphemeris_inc_dot + putFloat64le msgEphemeris_af0 + putFloat64le msgEphemeris_af1 + putFloat64le msgEphemeris_af2 + putFloat64le msgEphemeris_toe_tow + putWord16le msgEphemeris_toe_wn + putFloat64le msgEphemeris_toc_tow + putWord16le msgEphemeris_toc_wn + putWord8 msgEphemeris_valid + putWord8 msgEphemeris_healthy + putWord32le msgEphemeris_sid + putWord8 msgEphemeris_iode + putWord16le msgEphemeris_iodc + putWord32le msgEphemeris_reserved +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgEphemeris_" . stripPrefix "msgEphemeris_"} + ''MsgEphemeris) + msgEphemerisDepA :: Word16 msgEphemerisDepA = 0x001A @@ -324,122 +348,125 @@ -- -- Deprecated. data MsgEphemerisDepA = MsgEphemerisDepA - { msgEphemerisDepATgd :: Double + { msgEphemerisDepA_tgd :: Double -- ^ Group delay differential between L1 and L2 - , msgEphemerisDepACRs :: Double + , msgEphemerisDepA_c_rs :: Double -- ^ Amplitude of the sine harmonic correction term to the orbit radius - , msgEphemerisDepACRc :: Double + , msgEphemerisDepA_c_rc :: Double -- ^ Amplitude of the cosine harmonic correction term to the orbit radius - , msgEphemerisDepACUc :: Double + , msgEphemerisDepA_c_uc :: Double -- ^ Amplitude of the cosine harmonic correction term to the argument of -- latitude - , msgEphemerisDepACUs :: Double + , msgEphemerisDepA_c_us :: Double -- ^ Amplitude of the sine harmonic correction term to the argument of -- latitude - , msgEphemerisDepACIc :: Double + , msgEphemerisDepA_c_ic :: Double -- ^ Amplitude of the cosine harmonic correction term to the angle of -- inclination - , msgEphemerisDepACIs :: Double + , msgEphemerisDepA_c_is :: Double -- ^ Amplitude of the sine harmonic correction term to the angle of -- inclination - , msgEphemerisDepADn :: Double + , msgEphemerisDepA_dn :: Double -- ^ Mean motion difference - , msgEphemerisDepAM0 :: Double + , msgEphemerisDepA_m0 :: Double -- ^ Mean anomaly at reference time - , msgEphemerisDepAEcc :: Double + , msgEphemerisDepA_ecc :: Double -- ^ Eccentricity of satellite orbit - , msgEphemerisDepASqrta :: Double + , msgEphemerisDepA_sqrta :: Double -- ^ Square root of the semi-major axis of orbit - , msgEphemerisDepAOmega0 :: Double + , msgEphemerisDepA_omega0 :: Double -- ^ Longitude of ascending node of orbit plane at weekly epoch - , msgEphemerisDepAOmegadot :: Double + , msgEphemerisDepA_omegadot :: Double -- ^ Rate of right ascension - , msgEphemerisDepAW :: Double + , msgEphemerisDepA_w :: Double -- ^ Argument of perigee - , msgEphemerisDepAInc :: Double + , msgEphemerisDepA_inc :: Double -- ^ Inclination - , msgEphemerisDepAIncDot :: Double + , msgEphemerisDepA_inc_dot :: Double -- ^ Inclination first derivative - , msgEphemerisDepAAf0 :: Double + , msgEphemerisDepA_af0 :: Double -- ^ Polynomial clock correction coefficient (clock bias) - , msgEphemerisDepAAf1 :: Double + , msgEphemerisDepA_af1 :: Double -- ^ Polynomial clock correction coefficient (clock drift) - , msgEphemerisDepAAf2 :: Double + , msgEphemerisDepA_af2 :: Double -- ^ Polynomial clock correction coefficient (rate of clock drift) - , msgEphemerisDepAToeTow :: Double + , msgEphemerisDepA_toe_tow :: Double -- ^ Time of week - , msgEphemerisDepAToeWn :: Word16 + , msgEphemerisDepA_toe_wn :: Word16 -- ^ Week number - , msgEphemerisDepATocTow :: Double + , msgEphemerisDepA_toc_tow :: Double -- ^ Clock reference time of week - , msgEphemerisDepATocWn :: Word16 + , msgEphemerisDepA_toc_wn :: Word16 -- ^ Clock reference week number - , msgEphemerisDepAValid :: Word8 + , msgEphemerisDepA_valid :: Word8 -- ^ Is valid? - , msgEphemerisDepAHealthy :: Word8 + , msgEphemerisDepA_healthy :: Word8 -- ^ Satellite is healthy? - , msgEphemerisDepAPrn :: Word8 + , msgEphemerisDepA_prn :: Word8 -- ^ PRN being tracked } deriving ( Show, Read, Eq ) instance Binary MsgEphemerisDepA where get = do - msgEphemerisDepATgd <- getFloat64le - msgEphemerisDepACRs <- getFloat64le - msgEphemerisDepACRc <- getFloat64le - msgEphemerisDepACUc <- getFloat64le - msgEphemerisDepACUs <- getFloat64le - msgEphemerisDepACIc <- getFloat64le - msgEphemerisDepACIs <- getFloat64le - msgEphemerisDepADn <- getFloat64le - msgEphemerisDepAM0 <- getFloat64le - msgEphemerisDepAEcc <- getFloat64le - msgEphemerisDepASqrta <- getFloat64le - msgEphemerisDepAOmega0 <- getFloat64le - msgEphemerisDepAOmegadot <- getFloat64le - msgEphemerisDepAW <- getFloat64le - msgEphemerisDepAInc <- getFloat64le - msgEphemerisDepAIncDot <- getFloat64le - msgEphemerisDepAAf0 <- getFloat64le - msgEphemerisDepAAf1 <- getFloat64le - msgEphemerisDepAAf2 <- getFloat64le - msgEphemerisDepAToeTow <- getFloat64le - msgEphemerisDepAToeWn <- getWord16le - msgEphemerisDepATocTow <- getFloat64le - msgEphemerisDepATocWn <- getWord16le - msgEphemerisDepAValid <- getWord8 - msgEphemerisDepAHealthy <- getWord8 - msgEphemerisDepAPrn <- getWord8 + msgEphemerisDepA_tgd <- getFloat64le + msgEphemerisDepA_c_rs <- getFloat64le + msgEphemerisDepA_c_rc <- getFloat64le + msgEphemerisDepA_c_uc <- getFloat64le + msgEphemerisDepA_c_us <- getFloat64le + msgEphemerisDepA_c_ic <- getFloat64le + msgEphemerisDepA_c_is <- getFloat64le + msgEphemerisDepA_dn <- getFloat64le + msgEphemerisDepA_m0 <- getFloat64le + msgEphemerisDepA_ecc <- getFloat64le + msgEphemerisDepA_sqrta <- getFloat64le + msgEphemerisDepA_omega0 <- getFloat64le + msgEphemerisDepA_omegadot <- getFloat64le + msgEphemerisDepA_w <- getFloat64le + msgEphemerisDepA_inc <- getFloat64le + msgEphemerisDepA_inc_dot <- getFloat64le + msgEphemerisDepA_af0 <- getFloat64le + msgEphemerisDepA_af1 <- getFloat64le + msgEphemerisDepA_af2 <- getFloat64le + msgEphemerisDepA_toe_tow <- getFloat64le + msgEphemerisDepA_toe_wn <- getWord16le + msgEphemerisDepA_toc_tow <- getFloat64le + msgEphemerisDepA_toc_wn <- getWord16le + msgEphemerisDepA_valid <- getWord8 + msgEphemerisDepA_healthy <- getWord8 + msgEphemerisDepA_prn <- getWord8 return MsgEphemerisDepA {..} put MsgEphemerisDepA {..} = do - putFloat64le msgEphemerisDepATgd - putFloat64le msgEphemerisDepACRs - putFloat64le msgEphemerisDepACRc - putFloat64le msgEphemerisDepACUc - putFloat64le msgEphemerisDepACUs - putFloat64le msgEphemerisDepACIc - putFloat64le msgEphemerisDepACIs - putFloat64le msgEphemerisDepADn - putFloat64le msgEphemerisDepAM0 - putFloat64le msgEphemerisDepAEcc - putFloat64le msgEphemerisDepASqrta - putFloat64le msgEphemerisDepAOmega0 - putFloat64le msgEphemerisDepAOmegadot - putFloat64le msgEphemerisDepAW - putFloat64le msgEphemerisDepAInc - putFloat64le msgEphemerisDepAIncDot - putFloat64le msgEphemerisDepAAf0 - putFloat64le msgEphemerisDepAAf1 - putFloat64le msgEphemerisDepAAf2 - putFloat64le msgEphemerisDepAToeTow - putWord16le msgEphemerisDepAToeWn - putFloat64le msgEphemerisDepATocTow - putWord16le msgEphemerisDepATocWn - putWord8 msgEphemerisDepAValid - putWord8 msgEphemerisDepAHealthy - putWord8 msgEphemerisDepAPrn + putFloat64le msgEphemerisDepA_tgd + putFloat64le msgEphemerisDepA_c_rs + putFloat64le msgEphemerisDepA_c_rc + putFloat64le msgEphemerisDepA_c_uc + putFloat64le msgEphemerisDepA_c_us + putFloat64le msgEphemerisDepA_c_ic + putFloat64le msgEphemerisDepA_c_is + putFloat64le msgEphemerisDepA_dn + putFloat64le msgEphemerisDepA_m0 + putFloat64le msgEphemerisDepA_ecc + putFloat64le msgEphemerisDepA_sqrta + putFloat64le msgEphemerisDepA_omega0 + putFloat64le msgEphemerisDepA_omegadot + putFloat64le msgEphemerisDepA_w + putFloat64le msgEphemerisDepA_inc + putFloat64le msgEphemerisDepA_inc_dot + putFloat64le msgEphemerisDepA_af0 + putFloat64le msgEphemerisDepA_af1 + putFloat64le msgEphemerisDepA_af2 + putFloat64le msgEphemerisDepA_toe_tow + putWord16le msgEphemerisDepA_toe_wn + putFloat64le msgEphemerisDepA_toc_tow + putWord16le msgEphemerisDepA_toc_wn + putWord8 msgEphemerisDepA_valid + putWord8 msgEphemerisDepA_healthy + putWord8 msgEphemerisDepA_prn +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgEphemerisDepA_" . stripPrefix "msgEphemerisDepA_"} + ''MsgEphemerisDepA) + msgEphemerisDepB :: Word16 msgEphemerisDepB = 0x0046 @@ -447,160 +474,166 @@ -- -- Deprecated. data MsgEphemerisDepB = MsgEphemerisDepB - { msgEphemerisDepBTgd :: Double + { msgEphemerisDepB_tgd :: Double -- ^ Group delay differential between L1 and L2 - , msgEphemerisDepBCRs :: Double + , msgEphemerisDepB_c_rs :: Double -- ^ Amplitude of the sine harmonic correction term to the orbit radius - , msgEphemerisDepBCRc :: Double + , msgEphemerisDepB_c_rc :: Double -- ^ Amplitude of the cosine harmonic correction term to the orbit radius - , msgEphemerisDepBCUc :: Double + , msgEphemerisDepB_c_uc :: Double -- ^ Amplitude of the cosine harmonic correction term to the argument of -- latitude - , msgEphemerisDepBCUs :: Double + , msgEphemerisDepB_c_us :: Double -- ^ Amplitude of the sine harmonic correction term to the argument of -- latitude - , msgEphemerisDepBCIc :: Double + , msgEphemerisDepB_c_ic :: Double -- ^ Amplitude of the cosine harmonic correction term to the angle of -- inclination - , msgEphemerisDepBCIs :: Double + , msgEphemerisDepB_c_is :: Double -- ^ Amplitude of the sine harmonic correction term to the angle of -- inclination - , msgEphemerisDepBDn :: Double + , msgEphemerisDepB_dn :: Double -- ^ Mean motion difference - , msgEphemerisDepBM0 :: Double + , msgEphemerisDepB_m0 :: Double -- ^ Mean anomaly at reference time - , msgEphemerisDepBEcc :: Double + , msgEphemerisDepB_ecc :: Double -- ^ Eccentricity of satellite orbit - , msgEphemerisDepBSqrta :: Double + , msgEphemerisDepB_sqrta :: Double -- ^ Square root of the semi-major axis of orbit - , msgEphemerisDepBOmega0 :: Double + , msgEphemerisDepB_omega0 :: Double -- ^ Longitude of ascending node of orbit plane at weekly epoch - , msgEphemerisDepBOmegadot :: Double + , msgEphemerisDepB_omegadot :: Double -- ^ Rate of right ascension - , msgEphemerisDepBW :: Double + , msgEphemerisDepB_w :: Double -- ^ Argument of perigee - , msgEphemerisDepBInc :: Double + , msgEphemerisDepB_inc :: Double -- ^ Inclination - , msgEphemerisDepBIncDot :: Double + , msgEphemerisDepB_inc_dot :: Double -- ^ Inclination first derivative - , msgEphemerisDepBAf0 :: Double + , msgEphemerisDepB_af0 :: Double -- ^ Polynomial clock correction coefficient (clock bias) - , msgEphemerisDepBAf1 :: Double + , msgEphemerisDepB_af1 :: Double -- ^ Polynomial clock correction coefficient (clock drift) - , msgEphemerisDepBAf2 :: Double + , msgEphemerisDepB_af2 :: Double -- ^ Polynomial clock correction coefficient (rate of clock drift) - , msgEphemerisDepBToeTow :: Double + , msgEphemerisDepB_toe_tow :: Double -- ^ Time of week - , msgEphemerisDepBToeWn :: Word16 + , msgEphemerisDepB_toe_wn :: Word16 -- ^ Week number - , msgEphemerisDepBTocTow :: Double + , msgEphemerisDepB_toc_tow :: Double -- ^ Clock reference time of week - , msgEphemerisDepBTocWn :: Word16 + , msgEphemerisDepB_toc_wn :: Word16 -- ^ Clock reference week number - , msgEphemerisDepBValid :: Word8 + , msgEphemerisDepB_valid :: Word8 -- ^ Is valid? - , msgEphemerisDepBHealthy :: Word8 + , msgEphemerisDepB_healthy :: Word8 -- ^ Satellite is healthy? - , msgEphemerisDepBPrn :: Word8 + , msgEphemerisDepB_prn :: Word8 -- ^ PRN being tracked - , msgEphemerisDepBIode :: Word8 + , msgEphemerisDepB_iode :: Word8 -- ^ Issue of ephemeris data } deriving ( Show, Read, Eq ) instance Binary MsgEphemerisDepB where get = do - msgEphemerisDepBTgd <- getFloat64le - msgEphemerisDepBCRs <- getFloat64le - msgEphemerisDepBCRc <- getFloat64le - msgEphemerisDepBCUc <- getFloat64le - msgEphemerisDepBCUs <- getFloat64le - msgEphemerisDepBCIc <- getFloat64le - msgEphemerisDepBCIs <- getFloat64le - msgEphemerisDepBDn <- getFloat64le - msgEphemerisDepBM0 <- getFloat64le - msgEphemerisDepBEcc <- getFloat64le - msgEphemerisDepBSqrta <- getFloat64le - msgEphemerisDepBOmega0 <- getFloat64le - msgEphemerisDepBOmegadot <- getFloat64le - msgEphemerisDepBW <- getFloat64le - msgEphemerisDepBInc <- getFloat64le - msgEphemerisDepBIncDot <- getFloat64le - msgEphemerisDepBAf0 <- getFloat64le - msgEphemerisDepBAf1 <- getFloat64le - msgEphemerisDepBAf2 <- getFloat64le - msgEphemerisDepBToeTow <- getFloat64le - msgEphemerisDepBToeWn <- getWord16le - msgEphemerisDepBTocTow <- getFloat64le - msgEphemerisDepBTocWn <- getWord16le - msgEphemerisDepBValid <- getWord8 - msgEphemerisDepBHealthy <- getWord8 - msgEphemerisDepBPrn <- getWord8 - msgEphemerisDepBIode <- getWord8 + msgEphemerisDepB_tgd <- getFloat64le + msgEphemerisDepB_c_rs <- getFloat64le + msgEphemerisDepB_c_rc <- getFloat64le + msgEphemerisDepB_c_uc <- getFloat64le + msgEphemerisDepB_c_us <- getFloat64le + msgEphemerisDepB_c_ic <- getFloat64le + msgEphemerisDepB_c_is <- getFloat64le + msgEphemerisDepB_dn <- getFloat64le + msgEphemerisDepB_m0 <- getFloat64le + msgEphemerisDepB_ecc <- getFloat64le + msgEphemerisDepB_sqrta <- getFloat64le + msgEphemerisDepB_omega0 <- getFloat64le + msgEphemerisDepB_omegadot <- getFloat64le + msgEphemerisDepB_w <- getFloat64le + msgEphemerisDepB_inc <- getFloat64le + msgEphemerisDepB_inc_dot <- getFloat64le + msgEphemerisDepB_af0 <- getFloat64le + msgEphemerisDepB_af1 <- getFloat64le + msgEphemerisDepB_af2 <- getFloat64le + msgEphemerisDepB_toe_tow <- getFloat64le + msgEphemerisDepB_toe_wn <- getWord16le + msgEphemerisDepB_toc_tow <- getFloat64le + msgEphemerisDepB_toc_wn <- getWord16le + msgEphemerisDepB_valid <- getWord8 + msgEphemerisDepB_healthy <- getWord8 + msgEphemerisDepB_prn <- getWord8 + msgEphemerisDepB_iode <- getWord8 return MsgEphemerisDepB {..} put MsgEphemerisDepB {..} = do - putFloat64le msgEphemerisDepBTgd - putFloat64le msgEphemerisDepBCRs - putFloat64le msgEphemerisDepBCRc - putFloat64le msgEphemerisDepBCUc - putFloat64le msgEphemerisDepBCUs - putFloat64le msgEphemerisDepBCIc - putFloat64le msgEphemerisDepBCIs - putFloat64le msgEphemerisDepBDn - putFloat64le msgEphemerisDepBM0 - putFloat64le msgEphemerisDepBEcc - putFloat64le msgEphemerisDepBSqrta - putFloat64le msgEphemerisDepBOmega0 - putFloat64le msgEphemerisDepBOmegadot - putFloat64le msgEphemerisDepBW - putFloat64le msgEphemerisDepBInc - putFloat64le msgEphemerisDepBIncDot - putFloat64le msgEphemerisDepBAf0 - putFloat64le msgEphemerisDepBAf1 - putFloat64le msgEphemerisDepBAf2 - putFloat64le msgEphemerisDepBToeTow - putWord16le msgEphemerisDepBToeWn - putFloat64le msgEphemerisDepBTocTow - putWord16le msgEphemerisDepBTocWn - putWord8 msgEphemerisDepBValid - putWord8 msgEphemerisDepBHealthy - putWord8 msgEphemerisDepBPrn - putWord8 msgEphemerisDepBIode + putFloat64le msgEphemerisDepB_tgd + putFloat64le msgEphemerisDepB_c_rs + putFloat64le msgEphemerisDepB_c_rc + putFloat64le msgEphemerisDepB_c_uc + putFloat64le msgEphemerisDepB_c_us + putFloat64le msgEphemerisDepB_c_ic + putFloat64le msgEphemerisDepB_c_is + putFloat64le msgEphemerisDepB_dn + putFloat64le msgEphemerisDepB_m0 + putFloat64le msgEphemerisDepB_ecc + putFloat64le msgEphemerisDepB_sqrta + putFloat64le msgEphemerisDepB_omega0 + putFloat64le msgEphemerisDepB_omegadot + putFloat64le msgEphemerisDepB_w + putFloat64le msgEphemerisDepB_inc + putFloat64le msgEphemerisDepB_inc_dot + putFloat64le msgEphemerisDepB_af0 + putFloat64le msgEphemerisDepB_af1 + putFloat64le msgEphemerisDepB_af2 + putFloat64le msgEphemerisDepB_toe_tow + putWord16le msgEphemerisDepB_toe_wn + putFloat64le msgEphemerisDepB_toc_tow + putWord16le msgEphemerisDepB_toc_wn + putWord8 msgEphemerisDepB_valid + putWord8 msgEphemerisDepB_healthy + putWord8 msgEphemerisDepB_prn + putWord8 msgEphemerisDepB_iode +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgEphemerisDepB_" . stripPrefix "msgEphemerisDepB_"} + ''MsgEphemerisDepB) + -- | PackedObsContentDepA. -- -- Deprecated. data PackedObsContentDepA = PackedObsContentDepA - { packedObsContentDepAP :: Word32 + { packedObsContentDepA_P :: Word32 -- ^ Pseudorange observation - , packedObsContentDepAL :: CarrierPhase + , packedObsContentDepA_L :: CarrierPhase -- ^ Carrier phase observation - , packedObsContentDepACn0 :: Word8 + , packedObsContentDepA_cn0 :: Word8 -- ^ Carrier-to-Noise density - , packedObsContentDepALock :: Word16 + , packedObsContentDepA_lock :: Word16 -- ^ Lock indicator. This value changes whenever a satellite signal has lost -- and regained lock, indicating that the carrier phase ambiguity may have -- changed. - , packedObsContentDepAPrn :: Word8 + , packedObsContentDepA_prn :: Word8 -- ^ PRN-1 identifier of the satellite signal } deriving ( Show, Read, Eq ) instance Binary PackedObsContentDepA where get = do - packedObsContentDepAP <- getWord32le - packedObsContentDepAL <- get - packedObsContentDepACn0 <- getWord8 - packedObsContentDepALock <- getWord16le - packedObsContentDepAPrn <- getWord8 + packedObsContentDepA_P <- getWord32le + packedObsContentDepA_L <- get + packedObsContentDepA_cn0 <- getWord8 + packedObsContentDepA_lock <- getWord16le + packedObsContentDepA_prn <- getWord8 return PackedObsContentDepA {..} put PackedObsContentDepA {..} = do - putWord32le packedObsContentDepAP - put packedObsContentDepAL - putWord8 packedObsContentDepACn0 - putWord16le packedObsContentDepALock - putWord8 packedObsContentDepAPrn + putWord32le packedObsContentDepA_P + put packedObsContentDepA_L + putWord8 packedObsContentDepA_cn0 + putWord16le packedObsContentDepA_lock + putWord8 packedObsContentDepA_prn +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "packedObsContentDepA_" . stripPrefix "packedObsContentDepA_"} + ''PackedObsContentDepA) + msgObsDepA :: Word16 msgObsDepA = 0x0045 @@ -608,18 +641,21 @@ -- -- Deprecated. data MsgObsDepA = MsgObsDepA - { msgObsDepAHeader :: ObservationHeader + { msgObsDepA_header :: ObservationHeader -- ^ Header of a GPS observation message - , msgObsDepAObs :: [PackedObsContentDepA] + , msgObsDepA_obs :: [PackedObsContentDepA] -- ^ Pseudorange and carrier phase observation for a satellite being tracked. } deriving ( Show, Read, Eq ) instance Binary MsgObsDepA where get = do - msgObsDepAHeader <- get - msgObsDepAObs <- whileM (liftM not isEmpty) get + msgObsDepA_header <- get + msgObsDepA_obs <- whileM (liftM not isEmpty) get return MsgObsDepA {..} put MsgObsDepA {..} = do - put msgObsDepAHeader - mapM_ put msgObsDepAObs + put msgObsDepA_header + mapM_ put msgObsDepA_obs + +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgObsDepA_" . stripPrefix "msgObsDepA_"} + ''MsgObsDepA) diff --git a/src/SwiftNav/SBP/Piksi.hs b/src/SwiftNav/SBP/Piksi.hs --- a/src/SwiftNav/SBP/Piksi.hs +++ b/src/SwiftNav/SBP/Piksi.hs @@ -13,8 +13,10 @@ module SwiftNav.SBP.Piksi where +import BasicPrelude import Control.Monad import Control.Monad.Loops +import Data.Aeson.TH (deriveJSON, defaultOptions, fieldLabelModifier) import Data.Binary import Data.Binary.Get import Data.Binary.IEEE754 @@ -23,6 +25,7 @@ import Data.ByteString.Lazy hiding ( ByteString ) import Data.Int import Data.Word +import SwiftNav.SBP.Encoding msgAlmanac :: Word16 msgAlmanac = 0x0069 @@ -118,18 +121,21 @@ -- This message resets either the DGNSS Kalman filters or Integer Ambiguity -- Resolution (IAR) process. data MsgResetFilters = MsgResetFilters - { msgResetFiltersFilter :: Word8 + { msgResetFilters_filter :: Word8 -- ^ Filter flags } deriving ( Show, Read, Eq ) instance Binary MsgResetFilters where get = do - msgResetFiltersFilter <- getWord8 + msgResetFilters_filter <- getWord8 return MsgResetFilters {..} put MsgResetFilters {..} = do - putWord8 msgResetFiltersFilter + putWord8 msgResetFilters_filter +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgResetFilters_" . stripPrefix "msgResetFilters_"} + ''MsgResetFilters) + msgInitBase :: Word16 msgInitBase = 0x0023 @@ -158,64 +164,70 @@ -- (RTOS) thread usage statistics for the named thread. The reported percentage -- values require to be normalized. data MsgThreadState = MsgThreadState - { msgThreadStateName :: ByteString + { msgThreadState_name :: ByteString -- ^ Thread name (NULL terminated) - , msgThreadStateCpu :: Word16 + , msgThreadState_cpu :: Word16 -- ^ Percentage cpu use for this thread. Values range from 0 - 1000 and needs -- to be renormalized to 100 - , msgThreadStateStackFree :: Word32 + , msgThreadState_stack_free :: Word32 -- ^ Free stack space for this thread } deriving ( Show, Read, Eq ) instance Binary MsgThreadState where get = do - msgThreadStateName <- getByteString 20 - msgThreadStateCpu <- getWord16le - msgThreadStateStackFree <- getWord32le + msgThreadState_name <- getByteString 20 + msgThreadState_cpu <- getWord16le + msgThreadState_stack_free <- getWord32le return MsgThreadState {..} put MsgThreadState {..} = do - putByteString msgThreadStateName - putWord16le msgThreadStateCpu - putWord32le msgThreadStateStackFree + putByteString msgThreadState_name + putWord16le msgThreadState_cpu + putWord32le msgThreadState_stack_free +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgThreadState_" . stripPrefix "msgThreadState_"} + ''MsgThreadState) + -- | UARTChannel. -- -- Throughput, utilization, and error counts on the RX/TX buffers of this UART -- channel. The reported percentage values require to be normalized. data UARTChannel = UARTChannel - { uARTChannelTxThroughput :: Float + { uARTChannel_tx_throughput :: Float -- ^ UART transmit throughput - , uARTChannelRxThroughput :: Float + , uARTChannel_rx_throughput :: Float -- ^ UART receive throughput - , uARTChannelCrcErrorCount :: Word16 + , uARTChannel_crc_error_count :: Word16 -- ^ UART CRC error count - , uARTChannelIoErrorCount :: Word16 + , uARTChannel_io_error_count :: Word16 -- ^ UART IO error count - , uARTChannelTxBufferLevel :: Word8 + , uARTChannel_tx_buffer_level :: Word8 -- ^ UART transmit buffer percentage utilization (ranges from 0 - 255) - , uARTChannelRxBufferLevel :: Word8 + , uARTChannel_rx_buffer_level :: Word8 -- ^ UART receive buffer percentage utilization (ranges from 0 to 255) } deriving ( Show, Read, Eq ) instance Binary UARTChannel where get = do - uARTChannelTxThroughput <- getFloat32le - uARTChannelRxThroughput <- getFloat32le - uARTChannelCrcErrorCount <- getWord16le - uARTChannelIoErrorCount <- getWord16le - uARTChannelTxBufferLevel <- getWord8 - uARTChannelRxBufferLevel <- getWord8 + uARTChannel_tx_throughput <- getFloat32le + uARTChannel_rx_throughput <- getFloat32le + uARTChannel_crc_error_count <- getWord16le + uARTChannel_io_error_count <- getWord16le + uARTChannel_tx_buffer_level <- getWord8 + uARTChannel_rx_buffer_level <- getWord8 return UARTChannel {..} put UARTChannel {..} = do - putFloat32le uARTChannelTxThroughput - putFloat32le uARTChannelRxThroughput - putWord16le uARTChannelCrcErrorCount - putWord16le uARTChannelIoErrorCount - putWord8 uARTChannelTxBufferLevel - putWord8 uARTChannelRxBufferLevel + putFloat32le uARTChannel_tx_throughput + putFloat32le uARTChannel_rx_throughput + putWord16le uARTChannel_crc_error_count + putWord16le uARTChannel_io_error_count + putWord8 uARTChannel_tx_buffer_level + putWord8 uARTChannel_rx_buffer_level +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "uARTChannel_" . stripPrefix "uARTChannel_"} + ''UARTChannel) + -- | Latency. -- -- Statistics on the latency of observations received from the base station. As @@ -223,30 +235,33 @@ -- GPS time calculated locally by the receiver to give a precise measurement of -- the end-to-end communication latency in the system. data Latency = Latency - { latencyAvg :: Int32 + { latency_avg :: Int32 -- ^ Average latency - , latencyLmin :: Int32 + , latency_lmin :: Int32 -- ^ Minimum latency - , latencyLmax :: Int32 + , latency_lmax :: Int32 -- ^ Maximum latency - , latencyCurrent :: Int32 + , latency_current :: Int32 -- ^ Smoothed estimate of the current latency } deriving ( Show, Read, Eq ) instance Binary Latency where get = do - latencyAvg <- liftM fromIntegral getWord32le - latencyLmin <- liftM fromIntegral getWord32le - latencyLmax <- liftM fromIntegral getWord32le - latencyCurrent <- liftM fromIntegral getWord32le + latency_avg <- liftM fromIntegral getWord32le + latency_lmin <- liftM fromIntegral getWord32le + latency_lmax <- liftM fromIntegral getWord32le + latency_current <- liftM fromIntegral getWord32le return Latency {..} put Latency {..} = do - putWord32le $ fromIntegral latencyAvg - putWord32le $ fromIntegral latencyLmin - putWord32le $ fromIntegral latencyLmax - putWord32le $ fromIntegral latencyCurrent + putWord32le $ fromIntegral latency_avg + putWord32le $ fromIntegral latency_lmin + putWord32le $ fromIntegral latency_lmax + putWord32le $ fromIntegral latency_current +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "latency_" . stripPrefix "latency_"} + ''Latency) + msgUartState :: Word16 msgUartState = 0x0018 @@ -258,30 +273,33 @@ -- hosts, or other interfaces in future. The reported percentage values require -- to be normalized. data MsgUartState = MsgUartState - { msgUartStateUartA :: UARTChannel + { msgUartState_uart_a :: UARTChannel -- ^ State of UART A - , msgUartStateUartB :: UARTChannel + , msgUartState_uart_b :: UARTChannel -- ^ State of UART B - , msgUartStateUartFtdi :: UARTChannel + , msgUartState_uart_ftdi :: UARTChannel -- ^ State of UART FTDI (USB logger) - , msgUartStateLatency :: Latency + , msgUartState_latency :: Latency -- ^ UART communication latency } deriving ( Show, Read, Eq ) instance Binary MsgUartState where get = do - msgUartStateUartA <- get - msgUartStateUartB <- get - msgUartStateUartFtdi <- get - msgUartStateLatency <- get + msgUartState_uart_a <- get + msgUartState_uart_b <- get + msgUartState_uart_ftdi <- get + msgUartState_latency <- get return MsgUartState {..} put MsgUartState {..} = do - put msgUartStateUartA - put msgUartStateUartB - put msgUartStateUartFtdi - put msgUartStateLatency + put msgUartState_uart_a + put msgUartState_uart_b + put msgUartState_uart_ftdi + put msgUartState_latency +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgUartState_" . stripPrefix "msgUartState_"} + ''MsgUartState) + msgIarState :: Word16 msgIarState = 0x0019 @@ -291,18 +309,21 @@ -- process, which resolves unknown integer ambiguities from double-differenced -- carrier-phase measurements from satellite observations. data MsgIarState = MsgIarState - { msgIarStateNumHyps :: Word32 + { msgIarState_num_hyps :: Word32 -- ^ Number of integer ambiguity hypotheses remaining } deriving ( Show, Read, Eq ) instance Binary MsgIarState where get = do - msgIarStateNumHyps <- getWord32le + msgIarState_num_hyps <- getWord32le return MsgIarState {..} put MsgIarState {..} = do - putWord32le msgIarStateNumHyps + putWord32le msgIarState_num_hyps +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgIarState_" . stripPrefix "msgIarState_"} + ''MsgIarState) + msgMaskSatellite :: Word16 msgMaskSatellite = 0x001B @@ -311,18 +332,21 @@ -- This message allows setting a mask to prevent a particular satellite from -- being used in various Piksi subsystems. data MsgMaskSatellite = MsgMaskSatellite - { msgMaskSatelliteMask :: Word8 + { msgMaskSatellite_mask :: Word8 -- ^ Mask of systems that should ignore this satellite. - , msgMaskSatelliteSid :: Word32 + , msgMaskSatellite_sid :: Word32 -- ^ Signal identifier for which the mask is applied } deriving ( Show, Read, Eq ) instance Binary MsgMaskSatellite where get = do - msgMaskSatelliteMask <- getWord8 - msgMaskSatelliteSid <- getWord32le + msgMaskSatellite_mask <- getWord8 + msgMaskSatellite_sid <- getWord32le return MsgMaskSatellite {..} put MsgMaskSatellite {..} = do - putWord8 msgMaskSatelliteMask - putWord32le msgMaskSatelliteSid + putWord8 msgMaskSatellite_mask + putWord32le msgMaskSatellite_sid + +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgMaskSatellite_" . stripPrefix "msgMaskSatellite_"} + ''MsgMaskSatellite) diff --git a/src/SwiftNav/SBP/Settings.hs b/src/SwiftNav/SBP/Settings.hs --- a/src/SwiftNav/SBP/Settings.hs +++ b/src/SwiftNav/SBP/Settings.hs @@ -15,8 +15,10 @@ module SwiftNav.SBP.Settings where +import BasicPrelude import Control.Monad import Control.Monad.Loops +import Data.Aeson.TH (deriveJSON, defaultOptions, fieldLabelModifier) import Data.Binary import Data.Binary.Get import Data.Binary.IEEE754 @@ -25,6 +27,7 @@ import Data.ByteString.Lazy hiding ( ByteString ) import Data.Int import Data.Word +import SwiftNav.SBP.Encoding msgSettingsSave :: Word16 msgSettingsSave = 0x00A1 @@ -50,19 +53,22 @@ -- -- The setting message writes the device's configuration. data MsgSettingsWrite = MsgSettingsWrite - { msgSettingsWriteSetting :: ByteString + { msgSettingsWrite_setting :: ByteString -- ^ A NULL-terminated and delimited string with contents [SECTION_SETTING, -- SETTING, VALUE]. } deriving ( Show, Read, Eq ) instance Binary MsgSettingsWrite where get = do - msgSettingsWriteSetting <- liftM toStrict getRemainingLazyByteString + msgSettingsWrite_setting <- liftM toStrict getRemainingLazyByteString return MsgSettingsWrite {..} put MsgSettingsWrite {..} = do - putByteString msgSettingsWriteSetting + putByteString msgSettingsWrite_setting +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgSettingsWrite_" . stripPrefix "msgSettingsWrite_"} + ''MsgSettingsWrite) + msgSettingsReadReq :: Word16 msgSettingsReadReq = 0x00A4 @@ -70,19 +76,22 @@ -- -- The setting message reads the device's configuration. data MsgSettingsReadReq = MsgSettingsReadReq - { msgSettingsReadReqSetting :: ByteString + { msgSettingsReadReq_setting :: ByteString -- ^ A NULL-terminated and delimited string with contents [SECTION_SETTING, -- SETTING]. } deriving ( Show, Read, Eq ) instance Binary MsgSettingsReadReq where get = do - msgSettingsReadReqSetting <- liftM toStrict getRemainingLazyByteString + msgSettingsReadReq_setting <- liftM toStrict getRemainingLazyByteString return MsgSettingsReadReq {..} put MsgSettingsReadReq {..} = do - putByteString msgSettingsReadReqSetting + putByteString msgSettingsReadReq_setting +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgSettingsReadReq_" . stripPrefix "msgSettingsReadReq_"} + ''MsgSettingsReadReq) + msgSettingsReadResp :: Word16 msgSettingsReadResp = 0x00A5 @@ -90,19 +99,22 @@ -- -- The setting message reads the device's configuration. data MsgSettingsReadResp = MsgSettingsReadResp - { msgSettingsReadRespSetting :: ByteString + { msgSettingsReadResp_setting :: ByteString -- ^ A NULL-terminated and delimited string with contents [SECTION_SETTING, -- SETTING, VALUE]. } deriving ( Show, Read, Eq ) instance Binary MsgSettingsReadResp where get = do - msgSettingsReadRespSetting <- liftM toStrict getRemainingLazyByteString + msgSettingsReadResp_setting <- liftM toStrict getRemainingLazyByteString return MsgSettingsReadResp {..} put MsgSettingsReadResp {..} = do - putByteString msgSettingsReadRespSetting + putByteString msgSettingsReadResp_setting +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgSettingsReadResp_" . stripPrefix "msgSettingsReadResp_"} + ''MsgSettingsReadResp) + msgSettingsReadByIndexReq :: Word16 msgSettingsReadByIndexReq = 0x00A2 @@ -112,19 +124,22 @@ -- the setting at an index, returning a NULL-terminated and delimited string -- with contents [SECTION_SETTING, SETTING, VALUE]. data MsgSettingsReadByIndexReq = MsgSettingsReadByIndexReq - { msgSettingsReadByIndexReqIndex :: Word16 + { msgSettingsReadByIndexReq_index :: Word16 -- ^ An index into the device settings, with values ranging from 0 to -- length(settings) } deriving ( Show, Read, Eq ) instance Binary MsgSettingsReadByIndexReq where get = do - msgSettingsReadByIndexReqIndex <- getWord16le + msgSettingsReadByIndexReq_index <- getWord16le return MsgSettingsReadByIndexReq {..} put MsgSettingsReadByIndexReq {..} = do - putWord16le msgSettingsReadByIndexReqIndex + putWord16le msgSettingsReadByIndexReq_index +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgSettingsReadByIndexReq_" . stripPrefix "msgSettingsReadByIndexReq_"} + ''MsgSettingsReadByIndexReq) + msgSettingsReadByIndexResp :: Word16 msgSettingsReadByIndexResp = 0x00A7 @@ -134,23 +149,26 @@ -- the setting at an index, returning a NULL-terminated and delimited string -- with contents [SECTION_SETTING, SETTING, VALUE]. data MsgSettingsReadByIndexResp = MsgSettingsReadByIndexResp - { msgSettingsReadByIndexRespIndex :: Word16 + { msgSettingsReadByIndexResp_index :: Word16 -- ^ An index into the device settings, with values ranging from 0 to -- length(settings) - , msgSettingsReadByIndexRespSetting :: ByteString + , msgSettingsReadByIndexResp_setting :: ByteString -- ^ A NULL-terminated and delimited string with contents [SECTION_SETTING, -- SETTING, VALUE]. } deriving ( Show, Read, Eq ) instance Binary MsgSettingsReadByIndexResp where get = do - msgSettingsReadByIndexRespIndex <- getWord16le - msgSettingsReadByIndexRespSetting <- liftM toStrict getRemainingLazyByteString + msgSettingsReadByIndexResp_index <- getWord16le + msgSettingsReadByIndexResp_setting <- liftM toStrict getRemainingLazyByteString return MsgSettingsReadByIndexResp {..} put MsgSettingsReadByIndexResp {..} = do - putWord16le msgSettingsReadByIndexRespIndex - putByteString msgSettingsReadByIndexRespSetting + putWord16le msgSettingsReadByIndexResp_index + putByteString msgSettingsReadByIndexResp_setting + +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgSettingsReadByIndexResp_" . stripPrefix "msgSettingsReadByIndexResp_"} + ''MsgSettingsReadByIndexResp) msgSettingsReadByIndexDone :: Word16 msgSettingsReadByIndexDone = 0x00A6 diff --git a/src/SwiftNav/SBP/System.hs b/src/SwiftNav/SBP/System.hs --- a/src/SwiftNav/SBP/System.hs +++ b/src/SwiftNav/SBP/System.hs @@ -10,8 +10,10 @@ module SwiftNav.SBP.System where +import BasicPrelude import Control.Monad import Control.Monad.Loops +import Data.Aeson.TH (deriveJSON, defaultOptions, fieldLabelModifier) import Data.Binary import Data.Binary.Get import Data.Binary.IEEE754 @@ -20,6 +22,7 @@ import Data.ByteString.Lazy hiding ( ByteString ) import Data.Int import Data.Word +import SwiftNav.SBP.Encoding msgStartup :: Word16 msgStartup = 0xFF00 @@ -30,18 +33,21 @@ -- host or other attached devices that the system has started and is now ready -- to respond to commands or configuration requests. data MsgStartup = MsgStartup - { msgStartupReserved :: Word32 + { msgStartup_reserved :: Word32 -- ^ Reserved } deriving ( Show, Read, Eq ) instance Binary MsgStartup where get = do - msgStartupReserved <- getWord32le + msgStartup_reserved <- getWord32le return MsgStartup {..} put MsgStartup {..} = do - putWord32le msgStartupReserved + putWord32le msgStartup_reserved +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgStartup_" . stripPrefix "msgStartup_"} + ''MsgStartup) + msgHeartbeat :: Word16 msgHeartbeat = 0xFFFF @@ -55,14 +61,17 @@ -- indicate that an error has occurred in the system. To determine the source -- of the error, the remaining error flags should be inspected. data MsgHeartbeat = MsgHeartbeat - { msgHeartbeatFlags :: Word32 + { msgHeartbeat_flags :: Word32 -- ^ Status flags } deriving ( Show, Read, Eq ) instance Binary MsgHeartbeat where get = do - msgHeartbeatFlags <- getWord32le + msgHeartbeat_flags <- getWord32le return MsgHeartbeat {..} put MsgHeartbeat {..} = do - putWord32le msgHeartbeatFlags + putWord32le msgHeartbeat_flags + +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgHeartbeat_" . stripPrefix "msgHeartbeat_"} + ''MsgHeartbeat) diff --git a/src/SwiftNav/SBP/Tracking.hs b/src/SwiftNav/SBP/Tracking.hs --- a/src/SwiftNav/SBP/Tracking.hs +++ b/src/SwiftNav/SBP/Tracking.hs @@ -10,8 +10,10 @@ module SwiftNav.SBP.Tracking where +import BasicPrelude import Control.Monad import Control.Monad.Loops +import Data.Aeson.TH (deriveJSON, defaultOptions, fieldLabelModifier) import Data.Binary import Data.Binary.Get import Data.Binary.IEEE754 @@ -20,34 +22,38 @@ import Data.ByteString.Lazy hiding ( ByteString ) import Data.Int import Data.Word +import SwiftNav.SBP.Encoding -- | TrackingChannelState. -- -- Tracking channel state for a specific satellite PRN and measured signal -- power. data TrackingChannelState = TrackingChannelState - { trackingChannelStateState :: Word8 + { trackingChannelState_state :: Word8 -- ^ Status of tracking channel - , trackingChannelStateSid :: Word32 + , trackingChannelState_sid :: Word32 -- ^ Signal identifier being tracked - values 0x00 through 0x1F represent GPS -- PRNs 1 through 32 respectively (PRN-1 notation); other values reserved -- for future use - , trackingChannelStateCn0 :: Float + , trackingChannelState_cn0 :: Float -- ^ Carrier-to-noise density } deriving ( Show, Read, Eq ) instance Binary TrackingChannelState where get = do - trackingChannelStateState <- getWord8 - trackingChannelStateSid <- getWord32le - trackingChannelStateCn0 <- getFloat32le + trackingChannelState_state <- getWord8 + trackingChannelState_sid <- getWord32le + trackingChannelState_cn0 <- getFloat32le return TrackingChannelState {..} put TrackingChannelState {..} = do - putWord8 trackingChannelStateState - putWord32le trackingChannelStateSid - putFloat32le trackingChannelStateCn0 + putWord8 trackingChannelState_state + putWord32le trackingChannelState_sid + putFloat32le trackingChannelState_cn0 +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "trackingChannelState_" . stripPrefix "trackingChannelState_"} + ''TrackingChannelState) + msgTrackingState :: Word16 msgTrackingState = 0x0013 @@ -57,38 +63,44 @@ -- states. It reports status and snr power measurements for all tracked -- satellites. data MsgTrackingState = MsgTrackingState - { msgTrackingStateStates :: [TrackingChannelState] + { msgTrackingState_states :: [TrackingChannelState] -- ^ Satellite tracking channel state } deriving ( Show, Read, Eq ) instance Binary MsgTrackingState where get = do - msgTrackingStateStates <- whileM (liftM not isEmpty) get + msgTrackingState_states <- whileM (liftM not isEmpty) get return MsgTrackingState {..} put MsgTrackingState {..} = do - mapM_ put msgTrackingStateStates + mapM_ put msgTrackingState_states +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgTrackingState_" . stripPrefix "msgTrackingState_"} + ''MsgTrackingState) + -- | TrackingChannelCorrelation. -- -- Structure containing in-phase and quadrature correlation components. data TrackingChannelCorrelation = TrackingChannelCorrelation - { trackingChannelCorrelationI :: Int32 + { trackingChannelCorrelation_I :: Int32 -- ^ In-phase correlation - , trackingChannelCorrelationQ :: Int32 + , trackingChannelCorrelation_Q :: Int32 -- ^ Quadrature correlation } deriving ( Show, Read, Eq ) instance Binary TrackingChannelCorrelation where get = do - trackingChannelCorrelationI <- liftM fromIntegral getWord32le - trackingChannelCorrelationQ <- liftM fromIntegral getWord32le + trackingChannelCorrelation_I <- liftM fromIntegral getWord32le + trackingChannelCorrelation_Q <- liftM fromIntegral getWord32le return TrackingChannelCorrelation {..} put TrackingChannelCorrelation {..} = do - putWord32le $ fromIntegral trackingChannelCorrelationI - putWord32le $ fromIntegral trackingChannelCorrelationQ + putWord32le $ fromIntegral trackingChannelCorrelation_I + putWord32le $ fromIntegral trackingChannelCorrelation_Q +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "trackingChannelCorrelation_" . stripPrefix "trackingChannelCorrelation_"} + ''TrackingChannelCorrelation) + msgTrackingIq :: Word16 msgTrackingIq = 0x001C @@ -97,52 +109,58 @@ -- When enabled, a tracking channel can output the correlations at each update -- interval. data MsgTrackingIq = MsgTrackingIq - { msgTrackingIqChannel :: Word8 + { msgTrackingIq_channel :: Word8 -- ^ Tracking channel of origin - , msgTrackingIqSid :: Word32 + , msgTrackingIq_sid :: Word32 -- ^ Signal identifier being tracked - values 0x00 through 0x1F represent GPS -- PRNs 1 through 32 respectively (PRN-1 notation); other values reserved -- for future use - , msgTrackingIqCorrs :: [TrackingChannelCorrelation] + , msgTrackingIq_corrs :: [TrackingChannelCorrelation] -- ^ Early, Prompt and Late correlations } deriving ( Show, Read, Eq ) instance Binary MsgTrackingIq where get = do - msgTrackingIqChannel <- getWord8 - msgTrackingIqSid <- getWord32le - msgTrackingIqCorrs <- replicateM 3 get + msgTrackingIq_channel <- getWord8 + msgTrackingIq_sid <- getWord32le + msgTrackingIq_corrs <- replicateM 3 get return MsgTrackingIq {..} put MsgTrackingIq {..} = do - putWord8 msgTrackingIqChannel - putWord32le msgTrackingIqSid - mapM_ put msgTrackingIqCorrs + putWord8 msgTrackingIq_channel + putWord32le msgTrackingIq_sid + mapM_ put msgTrackingIq_corrs +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgTrackingIq_" . stripPrefix "msgTrackingIq_"} + ''MsgTrackingIq) + -- | TrackingChannelStateDepA. -- -- Deprecated. data TrackingChannelStateDepA = TrackingChannelStateDepA - { trackingChannelStateDepAState :: Word8 + { trackingChannelStateDepA_state :: Word8 -- ^ Status of tracking channel - , trackingChannelStateDepAPrn :: Word8 + , trackingChannelStateDepA_prn :: Word8 -- ^ PRN-1 being tracked - , trackingChannelStateDepACn0 :: Float + , trackingChannelStateDepA_cn0 :: Float -- ^ Carrier-to-noise density } deriving ( Show, Read, Eq ) instance Binary TrackingChannelStateDepA where get = do - trackingChannelStateDepAState <- getWord8 - trackingChannelStateDepAPrn <- getWord8 - trackingChannelStateDepACn0 <- getFloat32le + trackingChannelStateDepA_state <- getWord8 + trackingChannelStateDepA_prn <- getWord8 + trackingChannelStateDepA_cn0 <- getFloat32le return TrackingChannelStateDepA {..} put TrackingChannelStateDepA {..} = do - putWord8 trackingChannelStateDepAState - putWord8 trackingChannelStateDepAPrn - putFloat32le trackingChannelStateDepACn0 + putWord8 trackingChannelStateDepA_state + putWord8 trackingChannelStateDepA_prn + putFloat32le trackingChannelStateDepA_cn0 +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "trackingChannelStateDepA_" . stripPrefix "trackingChannelStateDepA_"} + ''TrackingChannelStateDepA) + msgTrackingStateDepA :: Word16 msgTrackingStateDepA = 0x0016 @@ -150,14 +168,17 @@ -- -- Deprecated. data MsgTrackingStateDepA = MsgTrackingStateDepA - { msgTrackingStateDepAStates :: [TrackingChannelStateDepA] + { msgTrackingStateDepA_states :: [TrackingChannelStateDepA] -- ^ Satellite tracking channel state } deriving ( Show, Read, Eq ) instance Binary MsgTrackingStateDepA where get = do - msgTrackingStateDepAStates <- whileM (liftM not isEmpty) get + msgTrackingStateDepA_states <- whileM (liftM not isEmpty) get return MsgTrackingStateDepA {..} put MsgTrackingStateDepA {..} = do - mapM_ put msgTrackingStateDepAStates + mapM_ put msgTrackingStateDepA_states + +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "msgTrackingStateDepA_" . stripPrefix "msgTrackingStateDepA_"} + ''MsgTrackingStateDepA) diff --git a/test/Test.hs b/test/Test.hs new file mode 100644 --- /dev/null +++ b/test/Test.hs @@ -0,0 +1,34 @@ +import BasicPrelude +import qualified Test.SwiftNav.CRC16 as CRC16 +import qualified Test.SwiftNav.SBP.Acquisition as Acquisition +import qualified Test.SwiftNav.SBP.Bootload as Bootload +import qualified Test.SwiftNav.SBP.Encoding as Encoding +import qualified Test.SwiftNav.SBP.ExtEvents as ExtEvents +import qualified Test.SwiftNav.SBP.Logging as Logging +import qualified Test.SwiftNav.SBP.Navigation as Navigation +import qualified Test.SwiftNav.SBP.Observation as Observation +import qualified Test.SwiftNav.SBP.Piksi as Piksi +import qualified Test.SwiftNav.SBP.System as System +import qualified Test.SwiftNav.SBP.Table as Table +import qualified Test.SwiftNav.SBP.Tracking as Tracking +import Test.Tasty + +tests :: TestTree +tests = + testGroup "Tests" + [ CRC16.tests + , Acquisition.tests + , Bootload.tests + , Encoding.tests + , ExtEvents.tests + , Logging.tests + , Navigation.tests + , Observation.tests + , Piksi.tests + , System.tests + , Table.tests + , Tracking.tests + ] + +main :: IO () +main = defaultMain tests diff --git a/test/Test/SwiftNav/CRC16.hs b/test/Test/SwiftNav/CRC16.hs new file mode 100644 --- /dev/null +++ b/test/Test/SwiftNav/CRC16.hs @@ -0,0 +1,23 @@ +module Test.SwiftNav.CRC16 + ( tests + ) where + +import BasicPrelude +import SwiftNav.CRC16 +import Test.Tasty +import Test.Tasty.HUnit + +testEmpty :: TestTree +testEmpty = testCase "Empty test" $ + crc16 "" @?= 0 + +testSimple :: TestTree +testSimple = testCase "Simple test" $ + crc16 "123456789" @?= 0x31c3 + +tests :: TestTree +tests = + testGroup "CRC6 tests" + [ testEmpty + , testSimple + ] diff --git a/test/Test/SwiftNav/SBP/Acquisition.hs b/test/Test/SwiftNav/SBP/Acquisition.hs new file mode 100644 --- /dev/null +++ b/test/Test/SwiftNav/SBP/Acquisition.hs @@ -0,0 +1,25 @@ +module Test.SwiftNav.SBP.Acquisition + ( tests + ) where + +import BasicPrelude +import SwiftNav.SBP.Acquisition +import Test.SwiftNav.SBP.Utils +import Test.Tasty +import Test.Tasty.HUnit + +testParse :: TestTree +testParse = + testGroup "Package tests" + [ testCase "Parsing tests" $ do + let filepath = "../spec/tests/yaml/swiftnav/sbp/test_acquisition.yaml" + moduleName = "sbp.acquisition" + val <- assertPackage filepath moduleName + assertBool "Fail" val + ] + +tests :: TestTree +tests = + testGroup "Acquisition Tests" + [ testParse + ] diff --git a/test/Test/SwiftNav/SBP/Bootload.hs b/test/Test/SwiftNav/SBP/Bootload.hs new file mode 100644 --- /dev/null +++ b/test/Test/SwiftNav/SBP/Bootload.hs @@ -0,0 +1,25 @@ +module Test.SwiftNav.SBP.Bootload + ( tests + ) where + +import BasicPrelude +import SwiftNav.SBP.Bootload +import Test.SwiftNav.SBP.Utils +import Test.Tasty +import Test.Tasty.HUnit + +testParse :: TestTree +testParse = + testGroup "Package tests" + [ testCase "Parsing tests" $ do + let filepath = "../spec/tests/yaml/swiftnav/sbp/test_bootload.yaml" + moduleName = "sbp.bootload" + val <- assertPackage filepath moduleName + assertBool "Fail" val + ] + +tests :: TestTree +tests = + testGroup "Bootload Tests" + [ testParse + ] diff --git a/test/Test/SwiftNav/SBP/Encoding.hs b/test/Test/SwiftNav/SBP/Encoding.hs new file mode 100644 --- /dev/null +++ b/test/Test/SwiftNav/SBP/Encoding.hs @@ -0,0 +1,36 @@ +module Test.SwiftNav.SBP.Encoding + ( tests + ) where + +import BasicPrelude +import Data.ByteString as BS +import qualified Data.Aeson as A +import SwiftNav.SBP.Encoding () +import Test.QuickCheck +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck as QC + +instance Arbitrary BS.ByteString where + arbitrary = BS.pack <$> arbitrary + shrink xs = BS.pack <$> shrink (BS.unpack xs) + +instance CoArbitrary BS.ByteString where + coarbitrary = coarbitrary . BS.unpack + +testParse :: TestTree +testParse = + testGroup "Empty Test" + [ testCase "Empty data" $ do + (A.decode . A.encode $ ("dddd" :: BS.ByteString)) @?= Just ["dddd" :: String] + ] + +testRoundtrip :: TestTree +testRoundtrip = QC.testProperty "Aeson" prop + where prop ws = (A.decode . A.encode $ (ws :: BS.ByteString)) === Just [ws] + +tests :: TestTree +tests = testGroup "Roundtrip JSON serialization" + [ testRoundtrip + , testParse + ] diff --git a/test/Test/SwiftNav/SBP/ExtEvents.hs b/test/Test/SwiftNav/SBP/ExtEvents.hs new file mode 100644 --- /dev/null +++ b/test/Test/SwiftNav/SBP/ExtEvents.hs @@ -0,0 +1,25 @@ +module Test.SwiftNav.SBP.ExtEvents + ( tests + ) where + +import BasicPrelude +import SwiftNav.SBP.ExtEvents +import Test.SwiftNav.SBP.Utils +import Test.Tasty +import Test.Tasty.HUnit + +testParse :: TestTree +testParse = + testGroup "Package tests" + [ testCase "Parsing tests" $ do + let filepath = "../spec/tests/yaml/swiftnav/sbp/test_ext_events.yaml" + moduleName = "sbp.ext_events" + val <- assertPackage filepath moduleName + assertBool "Fail" val + ] + +tests :: TestTree +tests = + testGroup "ExtEvents Tests" + [ testParse + ] diff --git a/test/Test/SwiftNav/SBP/Logging.hs b/test/Test/SwiftNav/SBP/Logging.hs new file mode 100644 --- /dev/null +++ b/test/Test/SwiftNav/SBP/Logging.hs @@ -0,0 +1,25 @@ +module Test.SwiftNav.SBP.Logging + ( tests + ) where + +import BasicPrelude +import SwiftNav.SBP.Logging +import Test.SwiftNav.SBP.Utils +import Test.Tasty +import Test.Tasty.HUnit + +testParse :: TestTree +testParse = + testGroup "Package tests" + [ testCase "Parsing tests" $ do + let filepath = "../spec/tests/yaml/swiftnav/sbp/test_logging.yaml" + moduleName = "sbp.logging" + val <- assertPackage filepath moduleName + assertBool "Fail" val + ] + +tests :: TestTree +tests = + testGroup "Logging Tests" + [ testParse + ] diff --git a/test/Test/SwiftNav/SBP/Navigation.hs b/test/Test/SwiftNav/SBP/Navigation.hs new file mode 100644 --- /dev/null +++ b/test/Test/SwiftNav/SBP/Navigation.hs @@ -0,0 +1,25 @@ +module Test.SwiftNav.SBP.Navigation + ( tests + ) where + +import BasicPrelude +import SwiftNav.SBP.Navigation +import Test.SwiftNav.SBP.Utils +import Test.Tasty +import Test.Tasty.HUnit + +testParse :: TestTree +testParse = + testGroup "Package tests" + [ testCase "Parsing tests" $ do + let filepath = "../spec/tests/yaml/swiftnav/sbp/test_navigation.yaml" + moduleName = "sbp.navigation" + val <- assertPackage filepath moduleName + assertBool "Fail" val + ] + +tests :: TestTree +tests = + testGroup "Navigation Tests" + [ testParse + ] diff --git a/test/Test/SwiftNav/SBP/Observation.hs b/test/Test/SwiftNav/SBP/Observation.hs new file mode 100644 --- /dev/null +++ b/test/Test/SwiftNav/SBP/Observation.hs @@ -0,0 +1,25 @@ +module Test.SwiftNav.SBP.Observation + ( tests + ) where + +import BasicPrelude +import SwiftNav.SBP.Observation +import Test.SwiftNav.SBP.Utils +import Test.Tasty +import Test.Tasty.HUnit + +testParse :: TestTree +testParse = + testGroup "Package tests" + [ testCase "Parsing tests" $ do + let filepath = "../spec/tests/yaml/swiftnav/sbp/test_observation.yaml" + moduleName = "sbp.observation" + val <- assertPackage filepath moduleName + assertBool "Fail" val + ] + +tests :: TestTree +tests = + testGroup "Observation Tests" + [ testParse + ] diff --git a/test/Test/SwiftNav/SBP/Piksi.hs b/test/Test/SwiftNav/SBP/Piksi.hs new file mode 100644 --- /dev/null +++ b/test/Test/SwiftNav/SBP/Piksi.hs @@ -0,0 +1,25 @@ +module Test.SwiftNav.SBP.Piksi + ( tests + ) where + +import BasicPrelude +import SwiftNav.SBP.Piksi +import Test.SwiftNav.SBP.Utils +import Test.Tasty +import Test.Tasty.HUnit + +testParse :: TestTree +testParse = + testGroup "Package tests" + [ testCase "Parsing tests" $ do + let filepath = "../spec/tests/yaml/swiftnav/sbp/test_piksi.yaml" + moduleName = "sbp.piksi" + val <- assertPackage filepath moduleName + assertBool "Fail" val + ] + +tests :: TestTree +tests = + testGroup "Piksi Tests" + [ testParse + ] diff --git a/test/Test/SwiftNav/SBP/System.hs b/test/Test/SwiftNav/SBP/System.hs new file mode 100644 --- /dev/null +++ b/test/Test/SwiftNav/SBP/System.hs @@ -0,0 +1,25 @@ +module Test.SwiftNav.SBP.System + ( tests + ) where + +import BasicPrelude +import SwiftNav.SBP.System +import Test.SwiftNav.SBP.Utils +import Test.Tasty +import Test.Tasty.HUnit + +testParse :: TestTree +testParse = + testGroup "Package tests" + [ testCase "Parsing tests" $ do + let filepath = "../spec/tests/yaml/swiftnav/sbp/test_system.yaml" + moduleName = "sbp.system" + val <- assertPackage filepath moduleName + assertBool "Fail" val + ] + +tests :: TestTree +tests = + testGroup "System Tests" + [ testParse + ] diff --git a/test/Test/SwiftNav/SBP/Table.hs b/test/Test/SwiftNav/SBP/Table.hs new file mode 100644 --- /dev/null +++ b/test/Test/SwiftNav/SBP/Table.hs @@ -0,0 +1,22 @@ +module Test.SwiftNav.SBP.Table + ( tests + ) where + +import BasicPrelude +import SwiftNav.SBP +import Test.SwiftNav.SBP.Utils +import Test.Tasty +import Test.Tasty.HUnit + +testParse :: TestTree +testParse = + testGroup "Empty Test" + [ testCase "Empty data" $ do + True @?= False + ] + +tests :: TestTree +tests = + testGroup "Table Tests" + [ testParse + ] diff --git a/test/Test/SwiftNav/SBP/Tracking.hs b/test/Test/SwiftNav/SBP/Tracking.hs new file mode 100644 --- /dev/null +++ b/test/Test/SwiftNav/SBP/Tracking.hs @@ -0,0 +1,25 @@ +module Test.SwiftNav.SBP.Tracking + ( tests + ) where + +import BasicPrelude +import SwiftNav.SBP.Tracking +import Test.SwiftNav.SBP.Utils +import Test.Tasty +import Test.Tasty.HUnit + +testParse :: TestTree +testParse = + testGroup "Package tests" + [ testCase "Parsing tests" $ do + let filepath = "../spec/tests/yaml/swiftnav/sbp/test_tracking.yaml" + moduleName = "sbp.tracking" + val <- assertPackage filepath moduleName + assertBool "Fail" val + ] + +tests :: TestTree +tests = + testGroup "Tracking Tests" + [ testParse + ] diff --git a/test/Test/SwiftNav/SBP/Utils.hs b/test/Test/SwiftNav/SBP/Utils.hs new file mode 100644 --- /dev/null +++ b/test/Test/SwiftNav/SBP/Utils.hs @@ -0,0 +1,84 @@ +-- | +-- Module: SwiftNav.SBP +-- Copyright: Copyright (C) 2015 Swift Navigation, Inc. +-- License: LGPL-3 +-- Maintainer: Mark Fine +-- Stability: experimental +-- Portability: portable +-- +-- A straightforward port of the testing harness stuff for libsbp's +-- Python client: +-- https://github.com/swift-nav/libsbp/blob/master/python/tests/sbp/utils.py. +-- Uses the spec'd out unit tests at +-- https://github.com/swift-nav/libsbp/tree/master/spec/yaml/swiftnav/sbp. + +module Test.SwiftNav.SBP.Utils + ( assertPackage + ) where + +import BasicPrelude +import Data.ByteString +import Data.Yaml.YamlLight + +-- -- | Assert that a proper SBP parsing from a raw package of data. +-- assertSBP :: undefined -- ^ SBP message parsed from unit test's raw packet +-- -> undefined -- ^ Unit test case parsed from YAML +-- -> Bool +-- assertSBP sbp testCase = undefined + +-- -- | Checks the field values of a parsed message for equality against +-- -- some ground truth value. +-- fieldEq :: undefined -- ^ Parsed field contents +-- -> undefined -- ^ Expected field contents +-- -> Bool +-- fieldEq p e = undefined + +-- -- | Asserts that the parsed payload of an SBP message has the +-- -- expected field values. +-- assertMsg :: undefined -- ^ Parsed SBP message +-- -> undefined -- ^ Unit test case for this message +-- -> Bool +-- assertMsg msg testCase = undefined + +-- -- | Asserts that a msg gets serialized back into binary with the +-- -- expected value. +-- assertMsgRoundtrip :: undefined +-- -> undefined +-- -> undefined +-- assertMsgRoundtrip msg rawPackage = undefined + +-- -- | Asserts that a msg gets serialized back into JSON with the +-- -- expected value, as well as gets serialized from JSON into an +-- -- expected object. +-- assertMsgRoundtripJson :: undefined +-- -> undefined +-- -> undefined +-- assertMsgRoundtripJson msg rawJSON = undefined + +-- -- | Asserts that a message materialized will get serialized into the +-- -- right JSON object. +-- assertMaterialization :: ByteString +-- -> undefined +-- -> undefined +-- -> undefined +-- assertMaterialization msg sbp rawJSON = undefined + +-- | Sanity check the package collection of tests before actually +-- running the tests. +assertSanePackage :: ByteString + -> ByteString + -> Bool +assertSanePackage pkgName pkg = undefined + +-- | Runs unit tests for message bindings by reading a YAML unit test +-- specification, parsing a raw packet for each test, and then +-- asserting that SBP messages and parsed payloads have their intended +-- values. +assertPackage :: String -- ^ Filepath to unit test specifications + -> ByteString -- ^ Name of package to test + -> IO Bool +assertPackage testFilename pkgName = do + pkg <- parseYamlFile testFilename + case pkg of + YMap x -> return True + _ -> return False