diff --git a/main/rtcm32json.hs b/main/rtcm32json.hs new file mode 100644 --- /dev/null +++ b/main/rtcm32json.hs @@ -0,0 +1,35 @@ +-- | +-- Module: Main +-- Copyright: Copyright (C) 2015 Swift Navigation, Inc. +-- License: LGPL-3 +-- Maintainer: Mark Fine +-- Stability: experimental +-- Portability: portable +-- +-- RTCM3 to JSON tool - reads RTCM3 binary from stdin and sends RTCM3 JSON +-- to stdout. + +import BasicPrelude +import Control.Monad.Trans.Resource +import Data.Aeson +import Data.Aeson.Encode +import Data.ByteString.Builder +import qualified Data.ByteString.Lazy as BL +import Data.Conduit +import Data.Conduit.Binary +import qualified Data.Conduit.List as CL +import Data.Conduit.Serialization.Binary +import Data.RTCM3 +import System.IO + +-- | Encode a RTCM3Msg to a line of JSON. +encodeLine :: RTCM3Msg -> ByteString +encodeLine v = BL.toStrict $ toLazyByteString $ encodeToBuilder (toJSON v) <> "\n" + +main :: IO () +main = + runResourceT $ + sourceHandle stdin =$= + conduitDecode =$= + CL.map encodeLine $$ + sinkHandle stdout diff --git a/rtcm.cabal b/rtcm.cabal --- a/rtcm.cabal +++ b/rtcm.cabal @@ -1,5 +1,5 @@ name: rtcm -version: 0.1.5 +version: 0.1.6 synopsis: RTCM Library. description: Haskell bindings for RTCM. homepage: http://github.com/swift-nav/librtcm @@ -27,19 +27,24 @@ , Data.RTCM3.Antennas , Data.RTCM3.Internal , Data.RTCM3.Observations + , Data.RTCM3.SSR , Data.RTCM3.System , Data.RTCM3.Types - other-modules: Data.RTCM3.Extras + other-modules: Data.RTCM3.Aeson + , Data.RTCM3.Extras , Data.RTCM3.TH ghc-options: -Wall - build-depends: array + build-depends: aeson + , array , base >= 4.7 && < 5 + , base64-bytestring , basic-prelude , binary , binary-bits , bytestring , lens , template-haskell + , text , word24 default-language: Haskell2010 default-extensions: NoImplicitPrelude @@ -47,6 +52,24 @@ RecordWildCards TemplateHaskell +executable rtcm32json + hs-source-dirs: main + main-is: rtcm32json.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall + build-depends: aeson + , base + , basic-prelude + , binary-conduit + , bytestring + , conduit + , conduit-combinators + , conduit-extra + , resourcet + , rtcm + default-language: Haskell2010 + default-extensions: NoImplicitPrelude + OverloadedStrings + test-suite test type: exitcode-stdio-1.0 hs-source-dirs: test @@ -55,6 +78,7 @@ , Test.Data.RTCM3.Antennas , Test.Data.RTCM3.Extras , Test.Data.RTCM3.Observations + , Test.Data.RTCM3.SSR , Test.Data.RTCM3.System , Test.Data.RTCM3.Test build-depends: base diff --git a/src/Data/RTCM3.hs b/src/Data/RTCM3.hs --- a/src/Data/RTCM3.hs +++ b/src/Data/RTCM3.hs @@ -12,16 +12,19 @@ ( RTCM3Msg (..) , module Data.RTCM3.Antennas , module Data.RTCM3.Observations + , module Data.RTCM3.SSR , module Data.RTCM3.System , module Data.RTCM3.Types ) where import BasicPrelude import Control.Lens +import Data.Aeson hiding (decode, decode') import Data.Binary import Data.ByteString.Lazy import Data.RTCM3.Antennas import Data.RTCM3.Observations +import Data.RTCM3.SSR import Data.RTCM3.System import Data.RTCM3.Types @@ -44,6 +47,10 @@ | RTCM3Msg1012 Msg1012 Msg | RTCM3Msg1013 Msg1013 Msg | RTCM3Msg1033 Msg1033 Msg + | RTCM3Msg1057 Msg1057 Msg + | RTCM3Msg1058 Msg1058 Msg + | RTCM3Msg1063 Msg1063 Msg + | RTCM3Msg1064 Msg1064 Msg | RTCM3Msg1230 Msg1230 Msg | RTCM3MsgUnknown Msg | RTCM3MsgBadCrc Msg @@ -72,6 +79,10 @@ | num == msg1012 = RTCM3Msg1012 (decode $ fromStrict _msgRTCM3Payload) m | num == msg1013 = RTCM3Msg1013 (decode $ fromStrict _msgRTCM3Payload) m | num == msg1033 = RTCM3Msg1033 (decode $ fromStrict _msgRTCM3Payload) m + | num == msg1057 = RTCM3Msg1057 (decode $ fromStrict _msgRTCM3Payload) m + | num == msg1058 = RTCM3Msg1058 (decode $ fromStrict _msgRTCM3Payload) m + | num == msg1063 = RTCM3Msg1063 (decode $ fromStrict _msgRTCM3Payload) m + | num == msg1064 = RTCM3Msg1064 (decode $ fromStrict _msgRTCM3Payload) m | num == msg1230 = RTCM3Msg1230 (decode $ fromStrict _msgRTCM3Payload) m | otherwise = RTCM3MsgUnknown m where crc = checkCrc _msgRTCM3Len _msgRTCM3Payload @@ -94,6 +105,10 @@ encode' (RTCM3Msg1012 _n m) = put m encode' (RTCM3Msg1013 _n m) = put m encode' (RTCM3Msg1033 _n m) = put m + encode' (RTCM3Msg1057 _n m) = put m + encode' (RTCM3Msg1058 _n m) = put m + encode' (RTCM3Msg1063 _n m) = put m + encode' (RTCM3Msg1064 _n m) = put m encode' (RTCM3Msg1230 _n m) = put m encode' (RTCM3MsgUnknown m) = put m encode' (RTCM3MsgBadCrc m) = put m @@ -113,7 +128,39 @@ msg f (RTCM3Msg1012 n m) = RTCM3Msg1012 n <$> f m msg f (RTCM3Msg1013 n m) = RTCM3Msg1013 n <$> f m msg f (RTCM3Msg1033 n m) = RTCM3Msg1033 n <$> f m + msg f (RTCM3Msg1057 n m) = RTCM3Msg1057 n <$> f m + msg f (RTCM3Msg1058 n m) = RTCM3Msg1058 n <$> f m + msg f (RTCM3Msg1063 n m) = RTCM3Msg1063 n <$> f m + msg f (RTCM3Msg1064 n m) = RTCM3Msg1064 n <$> f m msg f (RTCM3Msg1230 n m) = RTCM3Msg1230 n <$> f m msg f (RTCM3MsgUnknown m) = RTCM3MsgUnknown <$> f m msg f (RTCM3MsgBadCrc m) = RTCM3MsgBadCrc <$> f m +mergeValues :: Value -> Value -> Value +mergeValues (Object a) (Object b) = Object (a <> b) +mergeValues (Object a) _ = Object a +mergeValues _ (Object b) = Object b +mergeValues _ v = v + +instance ToJSON RTCM3Msg where + toJSON (RTCM3Msg1001 n m) = toJSON n `mergeValues` toJSON m + toJSON (RTCM3Msg1002 n m) = toJSON n `mergeValues` toJSON m + toJSON (RTCM3Msg1003 n m) = toJSON n `mergeValues` toJSON m + toJSON (RTCM3Msg1004 n m) = toJSON n `mergeValues` toJSON m + toJSON (RTCM3Msg1005 n m) = toJSON n `mergeValues` toJSON m + toJSON (RTCM3Msg1006 n m) = toJSON n `mergeValues` toJSON m + toJSON (RTCM3Msg1007 n m) = toJSON n `mergeValues` toJSON m + toJSON (RTCM3Msg1008 n m) = toJSON n `mergeValues` toJSON m + toJSON (RTCM3Msg1009 n m) = toJSON n `mergeValues` toJSON m + toJSON (RTCM3Msg1010 n m) = toJSON n `mergeValues` toJSON m + toJSON (RTCM3Msg1011 n m) = toJSON n `mergeValues` toJSON m + toJSON (RTCM3Msg1012 n m) = toJSON n `mergeValues` toJSON m + toJSON (RTCM3Msg1013 n m) = toJSON n `mergeValues` toJSON m + toJSON (RTCM3Msg1033 n m) = toJSON n `mergeValues` toJSON m + toJSON (RTCM3Msg1057 n m) = toJSON n `mergeValues` toJSON m + toJSON (RTCM3Msg1058 n m) = toJSON n `mergeValues` toJSON m + toJSON (RTCM3Msg1063 n m) = toJSON n `mergeValues` toJSON m + toJSON (RTCM3Msg1064 n m) = toJSON n `mergeValues` toJSON m + toJSON (RTCM3Msg1230 n m) = toJSON n `mergeValues` toJSON m + toJSON (RTCM3MsgUnknown m) = toJSON m + toJSON (RTCM3MsgBadCrc m) = toJSON m diff --git a/src/Data/RTCM3/Aeson.hs b/src/Data/RTCM3/Aeson.hs new file mode 100644 --- /dev/null +++ b/src/Data/RTCM3/Aeson.hs @@ -0,0 +1,36 @@ +{-# OPTIONS -fno-warn-orphans #-} +-- | +-- Module: Data.RTCM3.Extras +-- Copyright: Copyright (C) 2015 Swift Navigation, Inc. +-- License: LGPL-3 +-- Maintainer: Mark Fine +-- Stability: experimental +-- Portability: portable +-- +-- Extra stuff. + +module Data.RTCM3.Aeson where + +import BasicPrelude +import Data.Aeson +import Data.ByteString.Base64 as Base64 +import Data.Text.Encoding +import Data.Text.Encoding.Error +import Data.Word.Word24 + +-- 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 ByteString where + toJSON = toJSON . decodeUtf8With ignore . Base64.encode + +instance FromJSON ByteString where + parseJSON = withText "ByteString" (pure . Base64.decodeLenient . encodeUtf8) + +instance ToJSON Word24 where + toJSON = Number . fromIntegral + +instance FromJSON Word24 where + parseJSON = withScientific "Word24" (pure . truncate) diff --git a/src/Data/RTCM3/Antennas.hs b/src/Data/RTCM3/Antennas.hs --- a/src/Data/RTCM3/Antennas.hs +++ b/src/Data/RTCM3/Antennas.hs @@ -12,6 +12,7 @@ import BasicPrelude import Control.Lens +import Data.Aeson.TH import Data.Binary import Data.Binary.Bits import qualified Data.Binary.Bits.Get as B @@ -46,6 +47,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''AntennaReference) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_antennaReference_" . stripPrefix "_antennaReference_"} ''AntennaReference) instance BinaryBit AntennaReference where getBits _n = do @@ -88,6 +90,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''ExtAntennaReference) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_extAntennaReference_" . stripPrefix "_extAntennaReference_"} ''ExtAntennaReference) instance BinaryBit ExtAntennaReference where getBits _n = do @@ -114,6 +117,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''AntennaDescriptor) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_antennaDescriptor_" . stripPrefix "_antennaDescriptor_"} ''AntennaDescriptor) instance BinaryBit AntennaDescriptor where getBits _n = do @@ -142,6 +146,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''ExtAntennaDescriptor) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_extAntennaDescriptor_" . stripPrefix "_extAntennaDescriptor_"} ''ExtAntennaDescriptor) instance BinaryBit ExtAntennaDescriptor where getBits _n = do @@ -172,6 +177,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''ReceiverDescriptor) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_receiverDescriptor_" . stripPrefix "_receiverDescriptor_"} ''ReceiverDescriptor) instance BinaryBit ReceiverDescriptor where getBits _n = do @@ -203,6 +209,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''Msg1005) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_msg1005_" . stripPrefix "_msg1005_"} ''Msg1005) instance Binary Msg1005 where get = B.runBitGet $ do @@ -228,6 +235,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''Msg1006) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_msg1006_" . stripPrefix "_msg1006_"} ''Msg1006) instance Binary Msg1006 where get = B.runBitGet $ do @@ -253,6 +261,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''Msg1007) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_msg1007_" . stripPrefix "_msg1007_"} ''Msg1007) instance Binary Msg1007 where get = B.runBitGet $ do @@ -278,6 +287,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''Msg1008) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_msg1008_" . stripPrefix "_msg1008_"} ''Msg1008) instance Binary Msg1008 where get = B.runBitGet $ do @@ -309,6 +319,7 @@ } deriving ( Show, Read, Eq) $(makeLenses ''Msg1033) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_msg1033_" . stripPrefix "_msg1033_"} ''Msg1033) instance Binary Msg1033 where get = B.runBitGet $ do diff --git a/src/Data/RTCM3/Observations.hs b/src/Data/RTCM3/Observations.hs --- a/src/Data/RTCM3/Observations.hs +++ b/src/Data/RTCM3/Observations.hs @@ -12,6 +12,7 @@ import BasicPrelude import Control.Lens +import Data.Aeson.TH import Data.Binary import Data.Binary.Bits import qualified Data.Binary.Bits.Get as B @@ -41,6 +42,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''GpsObservationHeader) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_gpsObservationHeader_" . stripPrefix "_gpsObservationHeader_"} ''GpsObservationHeader) instance BinaryBit GpsObservationHeader where getBits _n = do @@ -77,6 +79,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''GpsL1Observation) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_gpsL1Observation_" . stripPrefix "_gpsL1Observation_"} ''GpsL1Observation) instance BinaryBit GpsL1Observation where getBits _n = do @@ -103,6 +106,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''GpsL1ExtObservation) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_gpsL1ExtObservation_" . stripPrefix "_gpsL1ExtObservation_"} ''GpsL1ExtObservation) instance BinaryBit GpsL1ExtObservation where getBits _n = do @@ -129,6 +133,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''GpsL2Observation) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_gpsL2Observation_" . stripPrefix "_gpsL2Observation_"} ''GpsL2Observation) instance BinaryBit GpsL2Observation where getBits _n = do @@ -153,6 +158,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''GpsL2ExtObservation) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_gpsL2ExtObservation_" . stripPrefix "_gpsL2ExtObservation_"} ''GpsL2ExtObservation) instance BinaryBit GpsL2ExtObservation where getBits _n = do @@ -183,6 +189,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''GlonassObservationHeader) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_glonassObservationHeader_" . stripPrefix "_glonassObservationHeader_"} ''GlonassObservationHeader) instance BinaryBit GlonassObservationHeader where getBits _n = do @@ -221,6 +228,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''GlonassL1Observation) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_glonassL1Observation_" . stripPrefix "_glonassL1Observation_"} ''GlonassL1Observation) instance BinaryBit GlonassL1Observation where getBits _n = do @@ -249,6 +257,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''GlonassL1ExtObservation) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_glonassL1ExtObservation_" . stripPrefix "_glonassL1ExtObservation_"} ''GlonassL1ExtObservation) instance BinaryBit GlonassL1ExtObservation where getBits _n = do @@ -275,6 +284,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''GlonassL2Observation) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_glonassL2Observation_" . stripPrefix "_glonassL2Observation_"} ''GlonassL2Observation) instance BinaryBit GlonassL2Observation where getBits _n = do @@ -299,6 +309,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''GlonassL2ExtObservation) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_glonassL2ExtObservation_" . stripPrefix "_glonassL2ExtObservation_"} ''GlonassL2ExtObservation) instance BinaryBit GlonassL2ExtObservation where getBits _n = do @@ -331,6 +342,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''GlonassBias) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_glonassBias_" . stripPrefix "_glonassBias_"} ''GlonassBias) instance BinaryBit GlonassBias where getBits _n = do @@ -368,6 +380,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''Observation1001) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_observation1001_" . stripPrefix "_observation1001_"} ''Observation1001) instance BinaryBit Observation1001 where getBits n = do @@ -390,6 +403,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''Msg1001) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_msg1001_" . stripPrefix "_msg1001_"} ''Msg1001) instance Binary Msg1001 where get = B.runBitGet $ do @@ -419,6 +433,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''Observation1002) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_observation1002_" . stripPrefix "_observation1002_"} ''Observation1002) instance BinaryBit Observation1002 where getBits n = do @@ -443,6 +458,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''Msg1002) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_msg1002_" . stripPrefix "_msg1002_"} ''Msg1002) instance Binary Msg1002 where get = B.runBitGet $ do @@ -472,6 +488,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''Observation1003) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_observation1003_" . stripPrefix "_observation1003_"} ''Observation1003) instance BinaryBit Observation1003 where getBits n = do @@ -496,6 +513,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''Msg1003) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_msg1003_" . stripPrefix "_msg1003_"} ''Msg1003) instance Binary Msg1003 where get = B.runBitGet $ do @@ -529,6 +547,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''Observation1004) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_observation1004_" . stripPrefix "_observation1004_"} ''Observation1004) instance BinaryBit Observation1004 where getBits n = do @@ -557,6 +576,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''Msg1004) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_msg1004_" . stripPrefix "_msg1004_"} ''Msg1004) instance Binary Msg1004 where get = B.runBitGet $ do @@ -584,6 +604,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''Observation1009) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_observation1009_" . stripPrefix "_observation1009_"} ''Observation1009) instance BinaryBit Observation1009 where getBits n = do @@ -606,6 +627,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''Msg1009) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_msg1009_" . stripPrefix "_msg1009_"} ''Msg1009) instance Binary Msg1009 where get = B.runBitGet $ do @@ -635,6 +657,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''Observation1010) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_observation1010_" . stripPrefix "_observation1010_"} ''Observation1010) instance BinaryBit Observation1010 where getBits n = do @@ -659,6 +682,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''Msg1010) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_msg1010_" . stripPrefix "_msg1010_"} ''Msg1010) instance Binary Msg1010 where get = B.runBitGet $ do @@ -688,6 +712,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''Observation1011) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_observation1011_" . stripPrefix "_observation1011_"} ''Observation1011) instance BinaryBit Observation1011 where getBits n = do @@ -712,6 +737,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''Msg1011) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_msg1011_" . stripPrefix "_msg1011_"} ''Msg1011) instance Binary Msg1011 where get = B.runBitGet $ do @@ -745,6 +771,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''Observation1012) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_observation1012_" . stripPrefix "_observation1012_"} ''Observation1012) instance BinaryBit Observation1012 where getBits n = do @@ -773,6 +800,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''Msg1012) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_msg1012_" . stripPrefix "_msg1012_"} ''Msg1012) instance Binary Msg1012 where get = B.runBitGet $ do @@ -798,6 +826,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''Msg1230) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_msg1230_" . stripPrefix "_msg1230_"} ''Msg1230) instance Binary Msg1230 where get = B.runBitGet $ do diff --git a/src/Data/RTCM3/SSR.hs b/src/Data/RTCM3/SSR.hs new file mode 100644 --- /dev/null +++ b/src/Data/RTCM3/SSR.hs @@ -0,0 +1,485 @@ +-- | +-- Module: Data.RTCM3.SSR +-- Copyright: Copyright (C) 2015 Swift Navigation, Inc. +-- License: LGPL-3 +-- Maintainer: Mark Fine +-- Stability: experimental +-- Portability: portable +-- +-- RTCMv3 messages for State Space Representation parameters. + +module Data.RTCM3.SSR where + +import BasicPrelude +import Control.Lens +import Data.Aeson.TH +import Data.Binary +import Data.Binary.Bits +import qualified Data.Binary.Bits.Get as B +import qualified Data.Binary.Bits.Put as B +import Data.RTCM3.Extras +import Data.RTCM3.TH + +-- | GpsOrbitCorrectionHeader. +-- +-- GPS orbit correction header. +data GpsOrbitCorrectionHeader = GpsOrbitCorrectionHeader + { _gpsOrbitCorrectionHeader_num :: Word16 + -- ^ Message number. + , _gpsOrbitCorrectionHeader_epochs :: Word32 + -- ^ GPS epoch time. + , _gpsOrbitCorrectionHeader_updateInterval :: Word8 + -- ^ SSR update interval. + , _gpsOrbitCorrectionHeader_multiple :: Bool + -- ^ Multiple message indicator. + , _gpsOrbitCorrectionHeader_datum :: Bool + -- ^ Satellite reference datum. + , _gpsOrbitCorrectionHeader_iod :: Word8 + -- ^ IOD SSR. + , _gpsOrbitCorrectionHeader_provider :: Word16 + -- ^ SSR provider id. + , _gpsOrbitCorrectionHeader_solution :: Word8 + -- ^ SSR solution id. + , _gpsOrbitCorrectionHeader_n :: Word8 + -- ^ Number of satellites. + } deriving ( Show, Read, Eq ) + +$(makeLenses ''GpsOrbitCorrectionHeader) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_gpsOrbitCorrectionHeader_" . stripPrefix "_gpsOrbitCorrectionHeader_"} ''GpsOrbitCorrectionHeader) + +instance BinaryBit GpsOrbitCorrectionHeader where + getBits _n = do + _gpsOrbitCorrectionHeader_num <- B.getWord16be 12 + _gpsOrbitCorrectionHeader_epochs <- B.getWord32be 20 + _gpsOrbitCorrectionHeader_updateInterval <- B.getWord8 4 + _gpsOrbitCorrectionHeader_multiple <- B.getBool + _gpsOrbitCorrectionHeader_datum <- B.getBool + _gpsOrbitCorrectionHeader_iod <- B.getWord8 4 + _gpsOrbitCorrectionHeader_provider <- B.getWord16be 16 + _gpsOrbitCorrectionHeader_solution <- B.getWord8 4 + _gpsOrbitCorrectionHeader_n <- B.getWord8 6 + return GpsOrbitCorrectionHeader {..} + + putBits _n GpsOrbitCorrectionHeader {..} = do + B.putWord16be 12 _gpsOrbitCorrectionHeader_num + B.putWord32be 20 _gpsOrbitCorrectionHeader_epochs + B.putWord8 4 _gpsOrbitCorrectionHeader_updateInterval + B.putBool _gpsOrbitCorrectionHeader_multiple + B.putBool _gpsOrbitCorrectionHeader_datum + B.putWord8 4 _gpsOrbitCorrectionHeader_iod + B.putWord16be 16 _gpsOrbitCorrectionHeader_provider + B.putWord8 4 _gpsOrbitCorrectionHeader_solution + B.putWord8 6 _gpsOrbitCorrectionHeader_n + +-- | GpsOrbitCorrectionMessage. +-- +-- GPS orbit correction message. +data GpsOrbitCorrection = GpsOrbitCorrection + { _gpsOrbitCorrection_sat :: Word8 + -- ^ GPS satellite id. + , _gpsOrbitCorrection_iode :: Word8 + -- ^ GPS IODE. + , _gpsOrbitCorrection_deltaRadial :: Int32 + -- ^ Delta Radial. + , _gpsOrbitCorrection_deltaAlongTrack :: Int32 + -- ^ Delta Along-Track. + , _gpsOrbitCorrection_deltaCrossTrack :: Int32 + -- ^ Delta Cross-Track. + , _gpsOrbitCorrection_dotDeltaRadial :: Int32 + -- ^ Dot Delta Radial. + , _gpsOrbitCorrection_dotDeltaAlongTrack :: Int32 + -- ^ Dot Delta Along-Track. + , _gpsOrbitCorrection_dotDeltaCrossTrack :: Int32 + -- ^ Dot Delta Cross-Track. + } deriving ( Show, Read, Eq ) + +$(makeLenses ''GpsOrbitCorrection) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_gpsOrbitCorrection_" . stripPrefix "_gpsOrbitCorrection_"} ''GpsOrbitCorrection) + +instance BinaryBit GpsOrbitCorrection where + getBits _n = do + _gpsOrbitCorrection_sat <- B.getWord8 6 + _gpsOrbitCorrection_iode <- B.getWord8 8 + _gpsOrbitCorrection_deltaRadial <- getInt32be 22 + _gpsOrbitCorrection_deltaAlongTrack <- getInt32be 20 + _gpsOrbitCorrection_deltaCrossTrack <- getInt32be 20 + _gpsOrbitCorrection_dotDeltaRadial <- getInt32be 21 + _gpsOrbitCorrection_dotDeltaAlongTrack <- getInt32be 19 + _gpsOrbitCorrection_dotDeltaCrossTrack <- getInt32be 19 + return GpsOrbitCorrection {..} + + putBits _n GpsOrbitCorrection {..} = do + B.putWord8 6 _gpsOrbitCorrection_sat + B.putWord8 8 _gpsOrbitCorrection_iode + putInt32be 22 _gpsOrbitCorrection_deltaRadial + putInt32be 20 _gpsOrbitCorrection_deltaAlongTrack + putInt32be 20 _gpsOrbitCorrection_deltaCrossTrack + putInt32be 21 _gpsOrbitCorrection_dotDeltaRadial + putInt32be 19 _gpsOrbitCorrection_dotDeltaAlongTrack + putInt32be 19 _gpsOrbitCorrection_dotDeltaCrossTrack + +-- | GpsClockCorrectionHeader. +-- +-- GPS clock correction message. +data GpsClockCorrectionHeader = GpsClockCorrectionHeader + { _gpsClockCorrectionHeader_num :: Word16 + -- ^ Message number. + , _gpsClockCorrectionHeader_epochs :: Word32 + -- ^ GPS epoch time. + , _gpsClockCorrectionHeader_updateInterval :: Word8 + -- ^ SSR update interval. + , _gpsClockCorrectionHeader_multiple :: Bool + -- ^ Multiple message indicator. + , _gpsClockCorrectionHeader_iod :: Word8 + -- ^ IOD SSR. + , _gpsClockCorrectionHeader_provider :: Word16 + -- ^ SSR provider id. + , _gpsClockCorrectionHeader_solution :: Word8 + -- ^ SSR solution id. + , _gpsClockCorrectionHeader_n :: Word8 + -- ^ Number of satellites. + } deriving ( Show, Read, Eq ) + +$(makeLenses ''GpsClockCorrectionHeader) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_gpsClockCorrectionHeader_" . stripPrefix "_gpsClockCorrectionHeader_"} ''GpsClockCorrectionHeader) + +instance BinaryBit GpsClockCorrectionHeader where + getBits _n = do + _gpsClockCorrectionHeader_num <- B.getWord16be 12 + _gpsClockCorrectionHeader_epochs <- B.getWord32be 20 + _gpsClockCorrectionHeader_updateInterval <- B.getWord8 4 + _gpsClockCorrectionHeader_multiple <- B.getBool + _gpsClockCorrectionHeader_iod <- B.getWord8 4 + _gpsClockCorrectionHeader_provider <- B.getWord16be 16 + _gpsClockCorrectionHeader_solution <- B.getWord8 4 + _gpsClockCorrectionHeader_n <- B.getWord8 6 + return GpsClockCorrectionHeader {..} + + putBits _n GpsClockCorrectionHeader {..} = do + B.putWord16be 12 _gpsClockCorrectionHeader_num + B.putWord32be 20 _gpsClockCorrectionHeader_epochs + B.putWord8 4 _gpsClockCorrectionHeader_updateInterval + B.putBool _gpsClockCorrectionHeader_multiple + B.putWord8 4 _gpsClockCorrectionHeader_iod + B.putWord16be 16 _gpsClockCorrectionHeader_provider + B.putWord8 4 _gpsClockCorrectionHeader_solution + B.putWord8 6 _gpsClockCorrectionHeader_n + +-- | GpsClockCorrectionMessage. +-- +-- GPS clock correction message. +data GpsClockCorrection = GpsClockCorrection + { _gpsClockCorrection_sat :: Word8 + -- ^ GPS satellite id. + , _gpsClockCorrection_deltaClockC0 :: Int32 + -- ^ Delta clock C0. + , _gpsClockCorrection_deltaClockC1 :: Int32 + -- ^ Delta clock C1. + , _gpsClockCorrection_deltaClockC2 :: Int32 + -- ^ Delta clock C2. + } deriving ( Show, Read, Eq ) + +$(makeLenses ''GpsClockCorrection) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_gpsClockCorrection_" . stripPrefix "_gpsClockCorrection_"} ''GpsClockCorrection) + +instance BinaryBit GpsClockCorrection where + getBits _n = do + _gpsClockCorrection_sat <- B.getWord8 6 + _gpsClockCorrection_deltaClockC0 <- getInt32be 22 + _gpsClockCorrection_deltaClockC1 <- getInt32be 21 + _gpsClockCorrection_deltaClockC2 <- getInt32be 27 + return GpsClockCorrection {..} + + putBits _n GpsClockCorrection {..} = do + B.putWord8 6 _gpsClockCorrection_sat + putInt32be 22 _gpsClockCorrection_deltaClockC0 + putInt32be 21 _gpsClockCorrection_deltaClockC1 + putInt32be 27 _gpsClockCorrection_deltaClockC2 + +-- | GlonassOrbitCorrectionHeader. +-- +-- GLONASS orbit correction header. +data GlonassOrbitCorrectionHeader = GlonassOrbitCorrectionHeader + { _glonassOrbitCorrectionHeader_num :: Word16 + -- ^ Message number. + , _glonassOrbitCorrectionHeader_epochs :: Word32 + -- ^ GLONASS epoch time. + , _glonassOrbitCorrectionHeader_updateInterval :: Word8 + -- ^ SSR update interval. + , _glonassOrbitCorrectionHeader_multiple :: Bool + -- ^ Multiple message indicator. + , _glonassOrbitCorrectionHeader_datum :: Bool + -- ^ Satellite reference datum. + , _glonassOrbitCorrectionHeader_iod :: Word8 + -- ^ IOD SSR. + , _glonassOrbitCorrectionHeader_provider :: Word16 + -- ^ SSR provider id. + , _glonassOrbitCorrectionHeader_solution :: Word8 + -- ^ SSR solution id. + , _glonassOrbitCorrectionHeader_n :: Word8 + -- ^ Number of satellites. + } deriving ( Show, Read, Eq ) + +$(makeLenses ''GlonassOrbitCorrectionHeader) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_glonassOrbitCorrectionHeader_" . stripPrefix "_glonassOrbitCorrectionHeader_"} ''GlonassOrbitCorrectionHeader) + +instance BinaryBit GlonassOrbitCorrectionHeader where + getBits _n = do + _glonassOrbitCorrectionHeader_num <- B.getWord16be 12 + _glonassOrbitCorrectionHeader_epochs <- B.getWord32be 17 + _glonassOrbitCorrectionHeader_updateInterval <- B.getWord8 4 + _glonassOrbitCorrectionHeader_multiple <- B.getBool + _glonassOrbitCorrectionHeader_datum <- B.getBool + _glonassOrbitCorrectionHeader_iod <- B.getWord8 4 + _glonassOrbitCorrectionHeader_provider <- B.getWord16be 16 + _glonassOrbitCorrectionHeader_solution <- B.getWord8 4 + _glonassOrbitCorrectionHeader_n <- B.getWord8 6 + return GlonassOrbitCorrectionHeader {..} + + putBits _n GlonassOrbitCorrectionHeader {..} = do + B.putWord16be 12 _glonassOrbitCorrectionHeader_num + B.putWord32be 17 _glonassOrbitCorrectionHeader_epochs + B.putWord8 4 _glonassOrbitCorrectionHeader_updateInterval + B.putBool _glonassOrbitCorrectionHeader_multiple + B.putBool _glonassOrbitCorrectionHeader_datum + B.putWord8 4 _glonassOrbitCorrectionHeader_iod + B.putWord16be 16 _glonassOrbitCorrectionHeader_provider + B.putWord8 4 _glonassOrbitCorrectionHeader_solution + B.putWord8 6 _glonassOrbitCorrectionHeader_n + +-- | GlonassOrbitCorrectionMessage. +-- +-- GLONASS orbit correction message. +data GlonassOrbitCorrection = GlonassOrbitCorrection + { _glonassOrbitCorrection_sat :: Word8 + -- ^ GLONASS satellite id. + , _glonassOrbitCorrection_iode :: Word8 + -- ^ GLONASS IODE. + , _glonassOrbitCorrection_deltaRadial :: Int32 + -- ^ Delta Radial. + , _glonassOrbitCorrection_deltaAlongTrack :: Int32 + -- ^ Delta Along-Track. + , _glonassOrbitCorrection_deltaCrossTrack :: Int32 + -- ^ Delta Cross-Track. + , _glonassOrbitCorrection_dotDeltaRadial :: Int32 + -- ^ Dot Delta Radial. + , _glonassOrbitCorrection_dotDeltaAlongTrack :: Int32 + -- ^ Dot Delta Along-Track. + , _glonassOrbitCorrection_dotDeltaCrossTrack :: Int32 + -- ^ Dot Delta Cross-Track. + } deriving ( Show, Read, Eq ) + +$(makeLenses ''GlonassOrbitCorrection) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_glonassOrbitCorrection_" . stripPrefix "_glonassOrbitCorrection_"} ''GlonassOrbitCorrection) + +instance BinaryBit GlonassOrbitCorrection where + getBits _n = do + _glonassOrbitCorrection_sat <- B.getWord8 5 + _glonassOrbitCorrection_iode <- B.getWord8 8 + _glonassOrbitCorrection_deltaRadial <- getInt32be 22 + _glonassOrbitCorrection_deltaAlongTrack <- getInt32be 20 + _glonassOrbitCorrection_deltaCrossTrack <- getInt32be 20 + _glonassOrbitCorrection_dotDeltaRadial <- getInt32be 21 + _glonassOrbitCorrection_dotDeltaAlongTrack <- getInt32be 19 + _glonassOrbitCorrection_dotDeltaCrossTrack <- getInt32be 19 + return GlonassOrbitCorrection {..} + + putBits _n GlonassOrbitCorrection {..} = do + B.putWord8 5 _glonassOrbitCorrection_sat + B.putWord8 8 _glonassOrbitCorrection_iode + putInt32be 22 _glonassOrbitCorrection_deltaRadial + putInt32be 20 _glonassOrbitCorrection_deltaAlongTrack + putInt32be 20 _glonassOrbitCorrection_deltaCrossTrack + putInt32be 21 _glonassOrbitCorrection_dotDeltaRadial + putInt32be 19 _glonassOrbitCorrection_dotDeltaAlongTrack + putInt32be 19 _glonassOrbitCorrection_dotDeltaCrossTrack + +-- | GlonassClockCorrectionHeader. +-- +-- GLONASS clock correction message. +data GlonassClockCorrectionHeader = GlonassClockCorrectionHeader + { _glonassClockCorrectionHeader_num :: Word16 + -- ^ Message number. + , _glonassClockCorrectionHeader_epochs :: Word32 + -- ^ GLONASS epoch time. + , _glonassClockCorrectionHeader_updateInterval :: Word8 + -- ^ SSR update interval. + , _glonassClockCorrectionHeader_multiple :: Bool + -- ^ Multiple message indicator. + , _glonassClockCorrectionHeader_iod :: Word8 + -- ^ IOD SSR. + , _glonassClockCorrectionHeader_provider :: Word16 + -- ^ SSR provider id. + , _glonassClockCorrectionHeader_solution :: Word8 + -- ^ SSR solution id. + , _glonassClockCorrectionHeader_n :: Word8 + -- ^ Number of satellites. + } deriving ( Show, Read, Eq ) + +$(makeLenses ''GlonassClockCorrectionHeader) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_glonassClockCorrectionHeader_" . stripPrefix "_glonassClockCorrectionHeader_"} ''GlonassClockCorrectionHeader) + +instance BinaryBit GlonassClockCorrectionHeader where + getBits _n = do + _glonassClockCorrectionHeader_num <- B.getWord16be 12 + _glonassClockCorrectionHeader_epochs <- B.getWord32be 17 + _glonassClockCorrectionHeader_updateInterval <- B.getWord8 4 + _glonassClockCorrectionHeader_multiple <- B.getBool + _glonassClockCorrectionHeader_iod <- B.getWord8 4 + _glonassClockCorrectionHeader_provider <- B.getWord16be 16 + _glonassClockCorrectionHeader_solution <- B.getWord8 4 + _glonassClockCorrectionHeader_n <- B.getWord8 6 + return GlonassClockCorrectionHeader {..} + + putBits _n GlonassClockCorrectionHeader {..} = do + B.putWord16be 12 _glonassClockCorrectionHeader_num + B.putWord32be 17 _glonassClockCorrectionHeader_epochs + B.putWord8 4 _glonassClockCorrectionHeader_updateInterval + B.putBool _glonassClockCorrectionHeader_multiple + B.putWord8 4 _glonassClockCorrectionHeader_iod + B.putWord16be 16 _glonassClockCorrectionHeader_provider + B.putWord8 4 _glonassClockCorrectionHeader_solution + B.putWord8 6 _glonassClockCorrectionHeader_n + +-- | GlonassClockCorrectionMessage. +-- +-- GLONASS clock correction message. +data GlonassClockCorrection = GlonassClockCorrection + { _glonassClockCorrection_sat :: Word8 + -- ^ GLONASS satellite id. + , _glonassClockCorrection_deltaClockC0 :: Int32 + -- ^ Delta clock C0. + , _glonassClockCorrection_deltaClockC1 :: Int32 + -- ^ Delta clock C1. + , _glonassClockCorrection_deltaClockC2 :: Int32 + -- ^ Delta clock C2. + } deriving ( Show, Read, Eq ) + +$(makeLenses ''GlonassClockCorrection) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_glonassClockCorrection_" . stripPrefix "_glonassClockCorrection_"} ''GlonassClockCorrection) + +instance BinaryBit GlonassClockCorrection where + getBits _n = do + _glonassClockCorrection_sat <- B.getWord8 5 + _glonassClockCorrection_deltaClockC0 <- getInt32be 22 + _glonassClockCorrection_deltaClockC1 <- getInt32be 21 + _glonassClockCorrection_deltaClockC2 <- getInt32be 27 + return GlonassClockCorrection {..} + + putBits _n GlonassClockCorrection {..} = do + B.putWord8 5 _glonassClockCorrection_sat + putInt32be 22 _glonassClockCorrection_deltaClockC0 + putInt32be 21 _glonassClockCorrection_deltaClockC1 + putInt32be 27 _glonassClockCorrection_deltaClockC2 + +msg1057 :: Word16 +msg1057 = 1057 + +-- | Msg 1057. +-- +-- RTCMv3 message 1057. +data Msg1057 = Msg1057 + { _msg1057_header :: GpsOrbitCorrectionHeader + -- ^ GPS orbit correction header. + , _msg1057_corrections :: [GpsOrbitCorrection] + -- ^ GPS orbit corrections. + } deriving ( Show, Read, Eq ) + +$(makeLenses ''Msg1057) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_msg1057_" . stripPrefix "_msg1057_"} ''Msg1057) + +instance Binary Msg1057 where + get = B.runBitGet $ do + _msg1057_header <- getBits 0 + _msg1057_corrections <- replicateM (fromIntegral $ _msg1057_header ^. gpsOrbitCorrectionHeader_n) $ getBits 0 + return Msg1057 {..} + + put Msg1057 {..} = B.runBitPut $ do + putBits 0 _msg1057_header + forM_ _msg1057_corrections $ putBits 0 + +$(deriveRTCM3 ''Msg1057) + +msg1058 :: Word16 +msg1058 = 1058 + +-- | Msg 1058. +-- +-- RTCMv3 message 1058. +data Msg1058 = Msg1058 + { _msg1058_header :: GpsClockCorrectionHeader + -- ^ GPS clock correction header. + , _msg1058_corrections :: [GpsClockCorrection] + -- ^ GPS clock corrections. + } deriving ( Show, Read, Eq ) + +$(makeLenses ''Msg1058) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_msg1058_" . stripPrefix "_msg1058_"} ''Msg1058) + +instance Binary Msg1058 where + get = B.runBitGet $ do + _msg1058_header <- getBits 0 + _msg1058_corrections <- replicateM (fromIntegral $ _msg1058_header ^. gpsClockCorrectionHeader_n) $ getBits 0 + return Msg1058 {..} + + put Msg1058 {..} = B.runBitPut $ do + putBits 0 _msg1058_header + forM_ _msg1058_corrections $ putBits 0 + +$(deriveRTCM3 ''Msg1058) + +msg1063 :: Word16 +msg1063 = 1063 + +-- | Msg 1063. +-- +-- RTCMv3 message 1063. +data Msg1063 = Msg1063 + { _msg1063_header :: GlonassOrbitCorrectionHeader + -- ^ GLONASS orbit correction header. + , _msg1063_corrections :: [GlonassOrbitCorrection] + -- ^ GLONASS orbit corrections. + } deriving ( Show, Read, Eq ) + +$(makeLenses ''Msg1063) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_msg1063_" . stripPrefix "_msg1063_"} ''Msg1063) + +instance Binary Msg1063 where + get = B.runBitGet $ do + _msg1063_header <- getBits 0 + _msg1063_corrections <- replicateM (fromIntegral $ _msg1063_header ^. glonassOrbitCorrectionHeader_n) $ getBits 0 + return Msg1063 {..} + + put Msg1063 {..} = B.runBitPut $ do + putBits 0 _msg1063_header + forM_ _msg1063_corrections $ putBits 0 + +$(deriveRTCM3 ''Msg1063) + +msg1064 :: Word16 +msg1064 = 1064 + +-- | Msg 1064. +-- +-- RTCMv3 message 1064. +data Msg1064 = Msg1064 + { _msg1064_header :: GlonassClockCorrectionHeader + -- ^ GLONASS clock correction header. + , _msg1064_corrections :: [GlonassClockCorrection] + -- ^ GLONASS clock corrections. + } deriving ( Show, Read, Eq ) + +$(makeLenses ''Msg1064) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_msg1064_" . stripPrefix "_msg1064_"} ''Msg1064) + +instance Binary Msg1064 where + get = B.runBitGet $ do + _msg1064_header <- getBits 0 + _msg1064_corrections <- replicateM (fromIntegral $ _msg1064_header ^. glonassClockCorrectionHeader_n) $ getBits 0 + return Msg1064 {..} + + put Msg1064 {..} = B.runBitPut $ do + putBits 0 _msg1064_header + forM_ _msg1064_corrections $ putBits 0 + +$(deriveRTCM3 ''Msg1064) diff --git a/src/Data/RTCM3/System.hs b/src/Data/RTCM3/System.hs --- a/src/Data/RTCM3/System.hs +++ b/src/Data/RTCM3/System.hs @@ -12,6 +12,7 @@ import BasicPrelude import Control.Lens +import Data.Aeson.TH import Data.Binary import Data.Binary.Bits import qualified Data.Binary.Bits.Get as B @@ -37,6 +38,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''MessageHeader) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_messageHeader_" . stripPrefix "_messageHeader_"} ''MessageHeader) instance BinaryBit MessageHeader where getBits _n = do @@ -69,6 +71,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''Message) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_message_" . stripPrefix "_message_"} ''Message) instance BinaryBit Message where getBits _n = do @@ -96,6 +99,7 @@ } deriving ( Show, Read, Eq ) $(makeLenses ''Msg1013) +$(deriveJSON defaultOptions {fieldLabelModifier = fromMaybe "_msg1013_" . stripPrefix "_msg1013_"} ''Msg1013) instance Binary Msg1013 where get = B.runBitGet $ do diff --git a/src/Data/RTCM3/Types.hs b/src/Data/RTCM3/Types.hs --- a/src/Data/RTCM3/Types.hs +++ b/src/Data/RTCM3/Types.hs @@ -12,7 +12,8 @@ module Data.RTCM3.Types where import BasicPrelude -import Control.Lens +import Control.Lens hiding ((.=)) +import Data.Aeson import Data.Binary import qualified Data.Binary.Bits.Get as B import Data.Binary.Get @@ -20,6 +21,7 @@ import Data.ByteString.Builder import Data.ByteString.Lazy hiding ( ByteString ) import Data.CRC24Q +import Data.RTCM3.Aeson () import Data.RTCM3.Extras import Data.Word.Word24 @@ -33,6 +35,13 @@ } deriving ( Show, Read, Eq ) $(makeClassy ''Msg) + +instance ToJSON Msg where + toJSON Msg {..} = object + [ "len" .= _msgRTCM3Len + , "payload" .= _msgRTCM3Payload + , "crc" .= _msgRTCM3Crc + ] instance Binary Msg where get = do diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -11,6 +11,7 @@ import qualified Test.Data.RTCM3.Antennas as Antennas import qualified Test.Data.RTCM3.Extras as Extras import qualified Test.Data.RTCM3.Observations as Observations +import qualified Test.Data.RTCM3.SSR as SSR import qualified Test.Data.RTCM3.System as System import Test.Tasty @@ -21,6 +22,7 @@ , Antennas.tests , Extras.tests , Observations.tests + , SSR.tests , System.tests ] diff --git a/test/Test/Data/RTCM3/SSR.hs b/test/Test/Data/RTCM3/SSR.hs new file mode 100644 --- /dev/null +++ b/test/Test/Data/RTCM3/SSR.hs @@ -0,0 +1,164 @@ +{-# OPTIONS -fno-warn-orphans #-} + +-- | +-- Module: Test.Data.RTCM3.SSR +-- Copyright: (c) 2015 Mark Fine +-- License: BSD3 +-- Maintainer: Mark Fine +-- +-- Test SSR module for RTCM3. + +module Test.Data.RTCM3.SSR + ( tests + ) where + +import BasicPrelude +import Control.Lens +import Data.Binary +import Data.RTCM3 +import Test.Data.RTCM3.Test +import Test.Tasty +import Test.Tasty.QuickCheck + +instance Arbitrary GpsOrbitCorrectionHeader where + arbitrary = do + _gpsOrbitCorrectionHeader_num <- arbitraryWord 12 + _gpsOrbitCorrectionHeader_epochs <- arbitraryWord 20 + _gpsOrbitCorrectionHeader_updateInterval <- arbitraryWord 4 + _gpsOrbitCorrectionHeader_multiple <- arbitrary + _gpsOrbitCorrectionHeader_datum <- arbitrary + _gpsOrbitCorrectionHeader_iod <- arbitraryWord 4 + _gpsOrbitCorrectionHeader_provider <- arbitraryWord 16 + _gpsOrbitCorrectionHeader_solution <- arbitraryWord 4 + _gpsOrbitCorrectionHeader_n <- arbitraryWord 6 + return GpsOrbitCorrectionHeader {..} + +instance Arbitrary GpsOrbitCorrection where + arbitrary = do + _gpsOrbitCorrection_sat <- arbitraryWord 6 + _gpsOrbitCorrection_iode <- arbitraryWord 8 + _gpsOrbitCorrection_deltaRadial <- arbitraryInt 22 + _gpsOrbitCorrection_deltaAlongTrack <- arbitraryInt 20 + _gpsOrbitCorrection_deltaCrossTrack <- arbitraryInt 20 + _gpsOrbitCorrection_dotDeltaRadial <- arbitraryInt 21 + _gpsOrbitCorrection_dotDeltaAlongTrack <- arbitraryInt 19 + _gpsOrbitCorrection_dotDeltaCrossTrack <- arbitraryInt 19 + return GpsOrbitCorrection {..} + +instance Arbitrary GpsClockCorrectionHeader where + arbitrary = do + _gpsClockCorrectionHeader_num <- arbitraryWord 12 + _gpsClockCorrectionHeader_epochs <- arbitraryWord 20 + _gpsClockCorrectionHeader_updateInterval <- arbitraryWord 4 + _gpsClockCorrectionHeader_multiple <- arbitrary + _gpsClockCorrectionHeader_iod <- arbitraryWord 4 + _gpsClockCorrectionHeader_provider <- arbitraryWord 16 + _gpsClockCorrectionHeader_solution <- arbitraryWord 4 + _gpsClockCorrectionHeader_n <- arbitraryWord 6 + return GpsClockCorrectionHeader {..} + +instance Arbitrary GpsClockCorrection where + arbitrary = do + _gpsClockCorrection_sat <- arbitraryWord 6 + _gpsClockCorrection_deltaClockC0 <- arbitraryInt 22 + _gpsClockCorrection_deltaClockC1 <- arbitraryInt 21 + _gpsClockCorrection_deltaClockC2 <- arbitraryInt 27 + return GpsClockCorrection {..} + +instance Arbitrary GlonassOrbitCorrectionHeader where + arbitrary = do + _glonassOrbitCorrectionHeader_num <- arbitraryWord 12 + _glonassOrbitCorrectionHeader_epochs <- arbitraryWord 17 + _glonassOrbitCorrectionHeader_updateInterval <- arbitraryWord 4 + _glonassOrbitCorrectionHeader_multiple <- arbitrary + _glonassOrbitCorrectionHeader_datum <- arbitrary + _glonassOrbitCorrectionHeader_iod <- arbitraryWord 4 + _glonassOrbitCorrectionHeader_provider <- arbitraryWord 16 + _glonassOrbitCorrectionHeader_solution <- arbitraryWord 4 + _glonassOrbitCorrectionHeader_n <- arbitraryWord 6 + return GlonassOrbitCorrectionHeader {..} + +instance Arbitrary GlonassOrbitCorrection where + arbitrary = do + _glonassOrbitCorrection_sat <- arbitraryWord 5 + _glonassOrbitCorrection_iode <- arbitraryWord 8 + _glonassOrbitCorrection_deltaRadial <- arbitraryInt 22 + _glonassOrbitCorrection_deltaAlongTrack <- arbitraryInt 20 + _glonassOrbitCorrection_deltaCrossTrack <- arbitraryInt 20 + _glonassOrbitCorrection_dotDeltaRadial <- arbitraryInt 21 + _glonassOrbitCorrection_dotDeltaAlongTrack <- arbitraryInt 19 + _glonassOrbitCorrection_dotDeltaCrossTrack <- arbitraryInt 19 + return GlonassOrbitCorrection {..} + +instance Arbitrary GlonassClockCorrectionHeader where + arbitrary = do + _glonassClockCorrectionHeader_num <- arbitraryWord 12 + _glonassClockCorrectionHeader_epochs <- arbitraryWord 17 + _glonassClockCorrectionHeader_updateInterval <- arbitraryWord 4 + _glonassClockCorrectionHeader_multiple <- arbitrary + _glonassClockCorrectionHeader_iod <- arbitraryWord 4 + _glonassClockCorrectionHeader_provider <- arbitraryWord 16 + _glonassClockCorrectionHeader_solution <- arbitraryWord 4 + _glonassClockCorrectionHeader_n <- arbitraryWord 6 + return GlonassClockCorrectionHeader {..} + +instance Arbitrary GlonassClockCorrection where + arbitrary = do + _glonassClockCorrection_sat <- arbitraryWord 5 + _glonassClockCorrection_deltaClockC0 <- arbitraryInt 22 + _glonassClockCorrection_deltaClockC1 <- arbitraryInt 21 + _glonassClockCorrection_deltaClockC2 <- arbitraryInt 27 + return GlonassClockCorrection {..} + +instance Arbitrary Msg1057 where + arbitrary = do + _msg1057_header <- arbitrary + _msg1057_corrections <- replicateM (fromIntegral $ _msg1057_header ^. gpsOrbitCorrectionHeader_n) $ arbitrary + return Msg1057 {..} + +instance Arbitrary Msg1058 where + arbitrary = do + _msg1058_header <- arbitrary + _msg1058_corrections <- replicateM (fromIntegral $ _msg1058_header ^. gpsClockCorrectionHeader_n) $ arbitrary + return Msg1058 {..} + +instance Arbitrary Msg1063 where + arbitrary = do + _msg1063_header <- arbitrary + _msg1063_corrections <- replicateM (fromIntegral $ _msg1063_header ^. glonassOrbitCorrectionHeader_n) $ arbitrary + return Msg1063 {..} + +instance Arbitrary Msg1064 where + arbitrary = do + _msg1064_header <- arbitrary + _msg1064_corrections <- replicateM (fromIntegral $ _msg1064_header ^. glonassClockCorrectionHeader_n) $ arbitrary + return Msg1064 {..} + +testMsg1057 :: TestTree +testMsg1057 = + testProperty "Roundtrip Msg1057" $ \m -> + (decode $ encode m) == (m :: Msg1057) + +testMsg1058 :: TestTree +testMsg1058 = + testProperty "Roundtrip Msg1058" $ \m -> + (decode $ encode m) == (m :: Msg1058) + +testMsg1063 :: TestTree +testMsg1063 = + testProperty "Roundtrip Msg1063" $ \m -> + (decode $ encode m) == (m :: Msg1063) + +testMsg1064 :: TestTree +testMsg1064 = + testProperty "Roundtrip Msg1064" $ \m -> + (decode $ encode m) == (m :: Msg1064) + +tests :: TestTree +tests = + testGroup "SSR tests" + [ testMsg1057 + , testMsg1058 + , testMsg1063 + , testMsg1064 + ]