diff --git a/bench/Bench.hs b/bench/Bench.hs deleted file mode 100644 --- a/bench/Bench.hs +++ /dev/null @@ -1,7 +0,0 @@ -import BasicPrelude -import Criterion.Main - -main :: IO () -main = defaultMain - [ - ] diff --git a/rtcm.cabal b/rtcm.cabal --- a/rtcm.cabal +++ b/rtcm.cabal @@ -1,5 +1,5 @@ name: rtcm -version: 0.1.3 +version: 0.1.4 synopsis: RTCM Library. description: Haskell bindings for RTCM. homepage: http://github.com/swift-nav/librtcm @@ -27,6 +27,7 @@ , Data.RTCM3.Antennas , Data.RTCM3.Internal , Data.RTCM3.Observations + , Data.RTCM3.System , Data.RTCM3.Types other-modules: Data.RTCM3.Extras , Data.RTCM3.TH @@ -51,27 +52,25 @@ hs-source-dirs: test main-is: Test.hs other-modules: Test.Data.CRC24Q + , Test.Data.RTCM3.Antennas , Test.Data.RTCM3.Extras + , Test.Data.RTCM3.Observations + , Test.Data.RTCM3.System + , Test.Data.RTCM3.Test build-depends: base , basic-prelude + , binary + , binary-bits + , bytestring + , lens + , random + , rtcm , tasty , tasty-hunit - , rtcm - ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall - default-language: Haskell2010 - default-extensions: NoImplicitPrelude - OverloadedStrings - -benchmark bench - type: exitcode-stdio-1.0 - hs-source-dirs: bench - main-is: Bench.hs - build-depends: base - , basic-prelude - , criterion - , rtcm + , tasty-quickcheck + , word24 ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall default-language: Haskell2010 default-extensions: NoImplicitPrelude OverloadedStrings - + RecordWildCards diff --git a/src/Data/RTCM3.hs b/src/Data/RTCM3.hs --- a/src/Data/RTCM3.hs +++ b/src/Data/RTCM3.hs @@ -12,6 +12,7 @@ ( RTCM3Msg (..) , module Data.RTCM3.Antennas , module Data.RTCM3.Observations + , module Data.RTCM3.System , module Data.RTCM3.Types ) where @@ -20,6 +21,7 @@ import Data.ByteString.Lazy import Data.RTCM3.Antennas import Data.RTCM3.Observations +import Data.RTCM3.System import Data.RTCM3.Types -- | An RTCM message ADT composed of all defined RTCM messages. @@ -35,6 +37,13 @@ | RTCM3Msg1006 Msg1006 Msg | RTCM3Msg1007 Msg1007 Msg | RTCM3Msg1008 Msg1008 Msg + | RTCM3Msg1009 Msg1009 Msg + | RTCM3Msg1010 Msg1010 Msg + | RTCM3Msg1011 Msg1011 Msg + | RTCM3Msg1012 Msg1012 Msg + | RTCM3Msg1013 Msg1013 Msg + | RTCM3Msg1033 Msg1033 Msg + | RTCM3Msg1230 Msg1230 Msg | RTCM3MsgUnknown Word16 Msg | RTCM3MsgBadCrc Msg deriving ( Show, Read, Eq ) @@ -55,6 +64,13 @@ | num == msg1006 = RTCM3Msg1006 (decode $ fromStrict _msgRTCM3Payload) rtcm3 | num == msg1007 = RTCM3Msg1007 (decode $ fromStrict _msgRTCM3Payload) rtcm3 | num == msg1008 = RTCM3Msg1008 (decode $ fromStrict _msgRTCM3Payload) rtcm3 + | num == msg1009 = RTCM3Msg1009 (decode $ fromStrict _msgRTCM3Payload) rtcm3 + | num == msg1010 = RTCM3Msg1010 (decode $ fromStrict _msgRTCM3Payload) rtcm3 + | num == msg1011 = RTCM3Msg1011 (decode $ fromStrict _msgRTCM3Payload) rtcm3 + | num == msg1012 = RTCM3Msg1012 (decode $ fromStrict _msgRTCM3Payload) rtcm3 + | num == msg1013 = RTCM3Msg1013 (decode $ fromStrict _msgRTCM3Payload) rtcm3 + | num == msg1033 = RTCM3Msg1033 (decode $ fromStrict _msgRTCM3Payload) rtcm3 + | num == msg1230 = RTCM3Msg1230 (decode $ fromStrict _msgRTCM3Payload) rtcm3 | otherwise = RTCM3MsgUnknown num rtcm3 where num = checkNum _msgRTCM3Payload @@ -69,5 +85,12 @@ encode' (RTCM3Msg1006 _msg rtcm3) = put rtcm3 encode' (RTCM3Msg1007 _msg rtcm3) = put rtcm3 encode' (RTCM3Msg1008 _msg rtcm3) = put rtcm3 + encode' (RTCM3Msg1009 _msg rtcm3) = put rtcm3 + encode' (RTCM3Msg1010 _msg rtcm3) = put rtcm3 + encode' (RTCM3Msg1011 _msg rtcm3) = put rtcm3 + encode' (RTCM3Msg1012 _msg rtcm3) = put rtcm3 + encode' (RTCM3Msg1013 _msg rtcm3) = put rtcm3 + encode' (RTCM3Msg1033 _msg rtcm3) = put rtcm3 + encode' (RTCM3Msg1230 _msg rtcm3) = put rtcm3 encode' (RTCM3MsgUnknown _num rtcm3) = put rtcm3 encode' (RTCM3MsgBadCrc rtcm3) = put rtcm3 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 @@ -23,25 +23,25 @@ -- -- Stationary antenna reference point information. data AntennaReference = AntennaReference - { _antennaReference_num :: Word16 + { _antennaReference_num :: Word16 -- ^ Message number. - , _antennaReference_station :: Word16 + , _antennaReference_station :: Word16 -- ^ Reference station id. - , _antennaReference_gps :: Bool + , _antennaReference_gps :: Bool -- ^ GPS indicator. - , _antennaReference_glonass :: Bool + , _antennaReference_glonass :: Bool -- ^ GLONASS indicator. - , _antennaReference_galileo :: Bool - -- ^ Galileo indicator. - , _antennaReference_computed :: Bool + , _antennaReference_computed :: Bool -- ^ Reference-station non-physical indicator. - , _antennaReference_ecef_x :: Int64 + , _antennaReference_ecef_x :: Int64 -- ^ Antenna reference point ECEF-X. - , _antennaReference_oscillator :: Bool + , _antennaReference_oscillator :: Bool -- ^ Single receiver oscillator indicator. - , _antennaReference_ecef_y :: Int64 + , _antennaReference_ecef_y :: Int64 -- ^ Antenna reference point ECEF-Y. - , _antennaReference_ecef_z :: Int64 + , _antennaReference_quarterCycle :: Word8 + -- ^ Quarter cycle indicator. + , _antennaReference_ecef_z :: Int64 -- ^ Antenna reference point ECEF-Z. } deriving ( Show, Read, Eq ) @@ -49,19 +49,19 @@ instance BinaryBit AntennaReference where getBits _n = do - _antennaReference_num <- B.getWord16be 12 - _antennaReference_station <- B.getWord16be 12 - _reserved <- B.getWord8 6 - _antennaReference_gps <- B.getBool - _antennaReference_glonass <- B.getBool - _antennaReference_galileo <- B.getBool - _antennaReference_computed <- B.getBool - _antennaReference_ecef_x <- getInt64be 38 - _antennaReference_oscillator <- B.getBool - _reserved <- B.getBool - _antennaReference_ecef_y <- getInt64be 38 - _reserved <- B.getWord8 2 - _antennaReference_ecef_z <- getInt64be 38 + _antennaReference_num <- B.getWord16be 12 + _antennaReference_station <- B.getWord16be 12 + _reserved <- B.getWord8 6 + _antennaReference_gps <- B.getBool + _antennaReference_glonass <- B.getBool + _reserved <- B.getBool + _antennaReference_computed <- B.getBool + _antennaReference_ecef_x <- getInt64be 38 + _antennaReference_oscillator <- B.getBool + _reserved <- B.getBool + _antennaReference_ecef_y <- getInt64be 38 + _antennaReference_quarterCycle <- B.getWord8 2 + _antennaReference_ecef_z <- getInt64be 38 return AntennaReference {..} putBits _n AntennaReference {..} = do @@ -70,12 +70,13 @@ B.putWord8 6 0 B.putBool _antennaReference_gps B.putBool _antennaReference_glonass - B.putBool _antennaReference_galileo + B.putBool False B.putBool _antennaReference_computed putInt64be 38 _antennaReference_ecef_x + B.putBool _antennaReference_oscillator B.putBool False putInt64be 38 _antennaReference_ecef_y - B.putWord8 2 0 + B.putWord8 2 _antennaReference_quarterCycle putInt64be 38 _antennaReference_ecef_z -- | ExtAntennaReference. @@ -152,6 +153,44 @@ B.putWord8 8 _extAntennaDescriptor_n forM_ _extAntennaDescriptor_serialNumbers $ B.putWord8 8 +-- | ReceiverDescriptor. +-- +-- Receiver description information. +data ReceiverDescriptor = ReceiverDescriptor + { _receiverDescriptor_n :: Word8 + -- ^ Number of receiver descriptors. + , _receiverDescriptor_descriptors :: [Word8] + -- ^ Receiver descriptors. + , _receiverDescriptor_m :: Word8 + -- ^ Number of firmware versions. + , _receiverDescriptor_firmwareVersions :: [Word8] + -- ^ Firmware versions. + , _receiverDescriptor_l :: Word8 + -- ^ Number of serial numbers. + , _receiverDescriptor_serialNumbers :: [Word8] + -- ^ Serial numbers. + } deriving ( Show, Read, Eq ) + +$(makeLenses ''ReceiverDescriptor) + +instance BinaryBit ReceiverDescriptor where + getBits _n = do + _receiverDescriptor_n <- B.getWord8 8 + _receiverDescriptor_descriptors <- replicateM (fromIntegral _receiverDescriptor_n) $ B.getWord8 8 + _receiverDescriptor_m <- B.getWord8 8 + _receiverDescriptor_firmwareVersions <- replicateM (fromIntegral _receiverDescriptor_m) $ B.getWord8 8 + _receiverDescriptor_l <- B.getWord8 8 + _receiverDescriptor_serialNumbers <- replicateM (fromIntegral _receiverDescriptor_l) $ B.getWord8 8 + return ReceiverDescriptor {..} + + putBits _n ReceiverDescriptor {..} = do + B.putWord8 8 _receiverDescriptor_n + forM_ _receiverDescriptor_descriptors $ B.putWord8 8 + B.putWord8 8 _receiverDescriptor_m + forM_ _receiverDescriptor_firmwareVersions $ B.putWord8 8 + B.putWord8 8 _receiverDescriptor_l + forM_ _receiverDescriptor_serialNumbers $ B.putWord8 8 + msg1005 :: Word16 msg1005 = 1005 @@ -253,3 +292,37 @@ putBits 0 _msg1008_extDescriptor $(deriveRTCM3 ''Msg1008) + +msg1033 :: Word16 +msg1033 = 1033 + +-- | Msg1033. +-- +-- RTCMv3 message 1033. +data Msg1033 = Msg1033 + { _msg1033_antennaDescriptor :: AntennaDescriptor + -- ^ Antenna descriptor. + , _msg1033_antennaExtDescriptor :: ExtAntennaDescriptor + -- ^ Antenna extended descriptor. + , _msg1033_receiverDescriptor :: ReceiverDescriptor + -- ^ Antenna descriptor. + } deriving ( Show, Read, Eq) + +$(makeLenses ''Msg1033) + +instance Binary Msg1033 where + get = B.runBitGet $ do + _msg1033_antennaDescriptor <- getBits 0 + -- ^ Antenna descriptor. + _msg1033_antennaExtDescriptor <- getBits 0 + -- ^ Antenna extended descriptor. + _msg1033_receiverDescriptor <- getBits 0 + -- ^ Receiver descriptor. + return Msg1033 {..} + + put Msg1033 {..} = B.runBitPut $ do + putBits 0 _msg1033_antennaDescriptor + putBits 0 _msg1033_antennaExtDescriptor + putBits 0 _msg1033_receiverDescriptor + +$(deriveRTCM3 ''Msg1033) 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 @@ -57,7 +57,6 @@ B.putWord16be 12 _gpsObservationHeader_num B.putWord16be 12 _gpsObservationHeader_station B.putWord32be 30 _gpsObservationHeader_tow - B.putWord32be 30 _gpsObservationHeader_tow B.putBool _gpsObservationHeader_synchronous B.putWord8 5 _gpsObservationHeader_n B.putBool _gpsObservationHeader_smoothing @@ -140,10 +139,10 @@ return GpsL2Observation {..} putBits _n GpsL2Observation {..} = do - B.putWord8 2 _gpsL2Observation_code - putInt16be 14 _gpsL2Observation_pseudorangeDifference - putInt32be 20 _gpsL2Observation_carrierMinusCode - B.putWord8 7 _gpsL2Observation_lockTime + B.putWord8 2 _gpsL2Observation_code + putInt16be 14 _gpsL2Observation_pseudorangeDifference + putInt32be 20 _gpsL2Observation_carrierMinusCode + B.putWord8 7 _gpsL2Observation_lockTime -- | GpsL2ExtObservation. -- @@ -163,6 +162,198 @@ putBits _n GpsL2ExtObservation {..} = B.putWord8 8 _gpsL2ExtObservation_cnr +-- | GlonassObservationHeader. +-- +-- GLONASS RTK observation header. +data GlonassObservationHeader = GlonassObservationHeader + { _glonassObservationHeader_num :: Word16 + -- ^ Message number. + , _glonassObservationHeader_station :: Word16 + -- ^ Reference station id. + , _glonassObservationHeader_epoch :: Word32 + -- ^ GLONASS epoch time. + , _glonassObservationHeader_synchronous :: Bool + -- ^ Synchronous GNSS flag. + , _glonassObservationHeader_n :: Word8 + -- ^ Number of GLONASS satellite observations. + , _glonassObservationHeader_smoothing :: Bool + -- ^ GLONASS divergence-free smoothing indicator. + , _glonassObservationHeader_smoothingInterval :: Word8 + -- ^ GLONASS smoothing interval. + } deriving ( Show, Read, Eq ) + +$(makeLenses ''GlonassObservationHeader) + +instance BinaryBit GlonassObservationHeader where + getBits _n = do + _glonassObservationHeader_num <- B.getWord16be 12 + _glonassObservationHeader_station <- B.getWord16be 12 + _glonassObservationHeader_epoch <- B.getWord32be 27 + _glonassObservationHeader_synchronous <- B.getBool + _glonassObservationHeader_n <- B.getWord8 5 + _glonassObservationHeader_smoothing <- B.getBool + _glonassObservationHeader_smoothingInterval <- B.getWord8 3 + return GlonassObservationHeader {..} + + putBits _n GlonassObservationHeader {..} = do + B.putWord16be 12 _glonassObservationHeader_num + B.putWord16be 12 _glonassObservationHeader_station + B.putWord32be 27 _glonassObservationHeader_epoch + B.putBool _glonassObservationHeader_synchronous + B.putWord8 5 _glonassObservationHeader_n + B.putBool _glonassObservationHeader_smoothing + B.putWord8 3 _glonassObservationHeader_smoothingInterval + +-- | GlonassL1Observation. +-- +-- GLONASS RTK L1 observation. +data GlonassL1Observation = GlonassL1Observation + { _glonassL1Observation_code :: Bool + -- ^ GLONASS L1 code indicator. + , _glonassL1Observation_frequency :: Word8 + -- ^ GLONASS satellite frequency channel number. + , _glonassL1Observation_pseudorange :: Word32 + -- ^ GLONASS L1 pseudorange. + , _glonassL1Observation_carrierMinusCode :: Int32 + -- ^ GLONASS L1 phaserange - pseudorange. + , _glonassL1Observation_lockTime :: Word8 + -- ^ GLONASS L1 lock time indicator. + } deriving ( Show, Read, Eq ) + +$(makeLenses ''GlonassL1Observation) + +instance BinaryBit GlonassL1Observation where + getBits _n = do + _glonassL1Observation_code <- B.getBool + _glonassL1Observation_frequency <- B.getWord8 5 + _glonassL1Observation_pseudorange <- B.getWord32be 25 + _glonassL1Observation_carrierMinusCode <- getInt32be 20 + _glonassL1Observation_lockTime <- B.getWord8 7 + return GlonassL1Observation {..} + + putBits _n GlonassL1Observation {..} = do + B.putBool _glonassL1Observation_code + B.putWord8 5 _glonassL1Observation_frequency + B.putWord32be 25 _glonassL1Observation_pseudorange + putInt32be 20 _glonassL1Observation_carrierMinusCode + B.putWord8 7 _glonassL1Observation_lockTime + +-- | GlonassL1ExtObservation. +-- +-- GLONASS RTK L1 extended observation. +data GlonassL1ExtObservation = GlonassL1ExtObservation + { _glonassL1ExtObservation_ambiguity :: Word8 + -- ^ GLONASS L1 pseudorange ambiguity. + , _glonassL1ExtObservation_cnr :: Word8 + -- ^ GLONASS L1 carrier-to-noise ratio. + } deriving ( Show, Read, Eq ) + +$(makeLenses ''GlonassL1ExtObservation) + +instance BinaryBit GlonassL1ExtObservation where + getBits _n = do + _glonassL1ExtObservation_ambiguity <- B.getWord8 7 + _glonassL1ExtObservation_cnr <- B.getWord8 8 + return GlonassL1ExtObservation {..} + + putBits _n GlonassL1ExtObservation {..} = do + B.putWord8 7 _glonassL1ExtObservation_ambiguity + B.putWord8 8 _glonassL1ExtObservation_cnr + +-- | GlonassL2Observation. +-- +-- GLONASS RTK L2 observation. +data GlonassL2Observation = GlonassL2Observation + { _glonassL2Observation_code :: Word8 + -- ^ GLONASS L2 code indicator. + , _glonassL2Observation_pseudorangeDifference :: Int16 + -- ^ GLONASS L2-L1 pseudorange difference. + , _glonassL2Observation_carrierMinusCode :: Int32 + -- ^ GLONASS L2 phaserange - L1 pseudorange. + , _glonassL2Observation_lockTime :: Word8 + -- ^ GLONASS L2 lock time indicator. + } deriving ( Show, Read, Eq ) + +$(makeLenses ''GlonassL2Observation) + +instance BinaryBit GlonassL2Observation where + getBits _n = do + _glonassL2Observation_code <- B.getWord8 2 + _glonassL2Observation_pseudorangeDifference <- getInt16be 14 + _glonassL2Observation_carrierMinusCode <- getInt32be 20 + _glonassL2Observation_lockTime <- B.getWord8 7 + return GlonassL2Observation {..} + + putBits _n GlonassL2Observation {..} = do + B.putWord8 2 _glonassL2Observation_code + putInt16be 14 _glonassL2Observation_pseudorangeDifference + putInt32be 20 _glonassL2Observation_carrierMinusCode + B.putWord8 7 _glonassL2Observation_lockTime + +-- | GlonassL2ExtObservation. +-- +-- GLONASS RTK L2 extended observation. +data GlonassL2ExtObservation = GlonassL2ExtObservation + { _glonassL2ExtObservation_cnr :: Word8 + -- ^ GLONASS L2 carrier-to-noise ratio. + } deriving ( Show, Read, Eq ) + +$(makeLenses ''GlonassL2ExtObservation) + +instance BinaryBit GlonassL2ExtObservation where + getBits _n = do + _glonassL2ExtObservation_cnr <- B.getWord8 8 + return GlonassL2ExtObservation {..} + + putBits _n GlonassL2ExtObservation {..} = + B.putWord8 8 _glonassL2ExtObservation_cnr + +-- | GlonassBias. +-- +-- GLONASS bias information. +data GlonassBias = GlonassBias + { _glonassBias_num :: Word16 + -- ^ Message number. + , _glonassBias_station :: Word16 + -- ^ Reference station id. + , _glonassBias_bias :: Bool + -- ^ GLONASS Code-Phase bias indicator. + , _glonassBias_mask :: Word8 + -- ^ GLONASS FDMA signals mask. + , _glonassBias_l1ca :: Word16 + -- ^ GLONASS L1 C/A code-phase bias. + , _glonassBias_l1p :: Word16 + -- ^ GLONASS L1 P code-phase bias. + , _glonassBias_l2ca :: Word16 + -- ^ GLONASS L2 C/A code-phase bias. + , _glonassBias_l2p :: Word16 + -- ^ GLONASS L2 P code-phase bias. + } deriving ( Show, Read, Eq ) + +$(makeLenses ''GlonassBias) + +instance BinaryBit GlonassBias where + getBits _n = do + _glonassBias_num <- B.getWord16be 12 + _glonassBias_station <- B.getWord16be 12 + _glonassBias_bias <- B.getBool + _glonassBias_mask <- B.getWord8 4 + _glonassBias_l1ca <- B.getWord16be 16 + _glonassBias_l1p <- B.getWord16be 16 + _glonassBias_l2ca <- B.getWord16be 16 + _glonassBias_l2p <- B.getWord16be 16 + return GlonassBias {..} + + putBits _n GlonassBias {..} = do + B.putWord16be 12 _glonassBias_num + B.putWord16be 12 _glonassBias_station + B.putBool _glonassBias_bias + B.putWord8 4 _glonassBias_mask + B.putWord16be 16 _glonassBias_l1ca + B.putWord16be 16 _glonassBias_l1p + B.putWord16be 16 _glonassBias_l2ca + B.putWord16be 16 _glonassBias_l2p + msg1001 :: Word16 msg1001 = 1001 @@ -378,3 +569,242 @@ forM_ _msg1004_observations $ putBits 0 $(deriveRTCM3 ''Msg1004) + +msg1009 :: Word16 +msg1009 = 1009 + +-- | Observation1009. +-- +-- GLONASS RTK L1 observation for message 1009. +data Observation1009 = Observation1009 + { _observation1009_sat :: Word8 + -- ^ GLONASS satellite id. + , _observation1009_l1 :: GlonassL1Observation + -- ^ GLONASS RTK L1 observation. + } deriving ( Show, Read, Eq ) + +$(makeLenses ''Observation1009) + +instance BinaryBit Observation1009 where + getBits n = do + _observation1009_sat <- B.getWord8 6 + _observation1009_l1 <- getBits n + return Observation1009 {..} + + putBits n Observation1009 {..} = do + B.putWord8 6 _observation1009_sat + putBits n _observation1009_l1 + +-- | Msg1009. +-- +-- RTCMv3 message 1009. +data Msg1009 = Msg1009 + { _msg1009_header :: GlonassObservationHeader + -- ^ GLONASS observation header. + , _msg1009_observations :: [Observation1009] + -- ^ GLONASS RTK L1 observations. + } deriving ( Show, Read, Eq ) + +$(makeLenses ''Msg1009) + +instance Binary Msg1009 where + get = B.runBitGet $ do + _msg1009_header <- getBits 0 + _msg1009_observations <- replicateM (fromIntegral $ _msg1009_header ^. glonassObservationHeader_n) $ getBits 0 + return Msg1009 {..} + + put Msg1009 {..} = B.runBitPut $ do + putBits 0 _msg1009_header + forM_ _msg1009_observations $ putBits 0 + +$(deriveRTCM3 ''Msg1009) + +msg1010 :: Word16 +msg1010 = 1010 + +-- | Observation1010. +-- +-- GLONASS RTK L1 extended observation for message 1010. +data Observation1010 = Observation1010 + { _observation1010_sat :: Word8 + -- ^ GLONASS satellite id. + , _observation1010_l1 :: GlonassL1Observation + -- ^ GLONASS RTK L1 observation. + , _observation1010_l1e :: GlonassL1ExtObservation + -- ^ GLONASS RTK L1 extended observation. + } deriving ( Show, Read, Eq ) + +$(makeLenses ''Observation1010) + +instance BinaryBit Observation1010 where + getBits n = do + _observation1010_sat <- B.getWord8 6 + _observation1010_l1 <- getBits n + _observation1010_l1e <- getBits n + return Observation1010 {..} + + putBits n Observation1010 {..} = do + B.putWord8 6 _observation1010_sat + putBits n _observation1010_l1 + putBits n _observation1010_l1e + +-- | Msg1010. +-- +-- RTCMv3 message 1010. +data Msg1010 = Msg1010 + { _msg1010_header :: GlonassObservationHeader + -- ^ GLONASS observation header. + , _msg1010_observations :: [Observation1010] + -- ^ GLONASS RTK L1 extended observations. + } deriving ( Show, Read, Eq ) + +$(makeLenses ''Msg1010) + +instance Binary Msg1010 where + get = B.runBitGet $ do + _msg1010_header <- getBits 0 + _msg1010_observations <- replicateM (fromIntegral $ _msg1010_header ^. glonassObservationHeader_n) $ getBits 0 + return Msg1010 {..} + + put Msg1010 {..} = B.runBitPut $ do + putBits 0 _msg1010_header + forM_ _msg1010_observations $ putBits 0 + +$(deriveRTCM3 ''Msg1010) + +msg1011 :: Word16 +msg1011 = 1011 + +-- | Observation1011. +-- +-- GLONASS RTK L1, L2 observation for message 1011. +data Observation1011 = Observation1011 + { _observation1011_sat :: Word8 + -- ^ GLONASS satellite id. + , _observation1011_l1 :: GlonassL1Observation + -- ^ GLONASS RTK L1 observation. + , _observation1011_l2 :: GlonassL2Observation + -- ^ GLONASS RTK L2 observation. + } deriving ( Show, Read, Eq ) + +$(makeLenses ''Observation1011) + +instance BinaryBit Observation1011 where + getBits n = do + _observation1011_sat <- B.getWord8 6 + _observation1011_l1 <- getBits n + _observation1011_l2 <- getBits n + return Observation1011 {..} + + putBits n Observation1011 {..} = do + B.putWord8 6 _observation1011_sat + putBits n _observation1011_l1 + putBits n _observation1011_l2 + +-- | Msg1011. +-- +-- RTCMv3 message 1011. +data Msg1011 = Msg1011 + { _msg1011_header :: GlonassObservationHeader + -- ^ GLONASS observation header. + , _msg1011_observations :: [Observation1011] + -- ^ GLONASS RTK L1, L2 observations. + } deriving ( Show, Read, Eq ) + +$(makeLenses ''Msg1011) + +instance Binary Msg1011 where + get = B.runBitGet $ do + _msg1011_header <- getBits 0 + _msg1011_observations <- replicateM (fromIntegral $ _msg1011_header ^. glonassObservationHeader_n) $ getBits 0 + return Msg1011 {..} + + put Msg1011 {..} = B.runBitPut $ do + putBits 0 _msg1011_header + forM_ _msg1011_observations $ putBits 0 + +$(deriveRTCM3 ''Msg1011) + +msg1012 :: Word16 +msg1012 = 1012 + +-- | Observation1012. +-- +-- GLONASS RTK L1, L2 extended observation for message 1012. +data Observation1012 = Observation1012 + { _observation1012_sat :: Word8 + -- ^ GLONASS satellite id. + , _observation1012_l1 :: GlonassL1Observation + -- ^ GLONASS RTK L1 observation. + , _observation1012_l1e :: GlonassL1ExtObservation + -- ^ GLONASS RTK L1 extended observation. + , _observation1012_l2 :: GlonassL2Observation + -- ^ GLONASS RTK L2 observation. + , _observation1012_l2e :: GlonassL2ExtObservation + -- ^ GLONASS RTK L2 extended observation. + } deriving ( Show, Read, Eq ) + +$(makeLenses ''Observation1012) + +instance BinaryBit Observation1012 where + getBits n = do + _observation1012_sat <- B.getWord8 6 + _observation1012_l1 <- getBits n + _observation1012_l1e <- getBits n + _observation1012_l2 <- getBits n + _observation1012_l2e <- getBits n + return Observation1012 {..} + + putBits n Observation1012 {..} = do + B.putWord8 6 _observation1012_sat + putBits n _observation1012_l1 + putBits n _observation1012_l1e + putBits n _observation1012_l2 + putBits n _observation1012_l2e + +-- | Msg1012. +-- +-- RTCMv3 message 1012. +data Msg1012 = Msg1012 + { _msg1012_header :: GlonassObservationHeader + -- ^ GLONASS observation header. + , _msg1012_observations :: [Observation1012] + -- ^ GLONASS RTK L1, L2 extended observations. + } deriving ( Show, Read, Eq ) + +$(makeLenses ''Msg1012) + +instance Binary Msg1012 where + get = B.runBitGet $ do + _msg1012_header <- getBits 0 + _msg1012_observations <- replicateM (fromIntegral $ _msg1012_header ^. glonassObservationHeader_n) $ getBits 0 + return Msg1012 {..} + + put Msg1012 {..} = B.runBitPut $ do + putBits 0 _msg1012_header + forM_ _msg1012_observations $ putBits 0 + +$(deriveRTCM3 ''Msg1012) + +msg1230 :: Word16 +msg1230 = 1230 + +-- | Msg1230. +-- +-- RTCMv3 message 1230. +data Msg1230 = Msg1230 + { _msg1230_bias :: GlonassBias + -- ^ GLONASS bias. + } deriving ( Show, Read, Eq ) + +$(makeLenses ''Msg1230) + +instance Binary Msg1230 where + get = B.runBitGet $ do + _msg1230_bias <- getBits 0 + return Msg1230 {..} + + put Msg1230 {..} = B.runBitPut $ do + putBits 0 _msg1230_bias + +$(deriveRTCM3 ''Msg1230) diff --git a/src/Data/RTCM3/System.hs b/src/Data/RTCM3/System.hs new file mode 100644 --- /dev/null +++ b/src/Data/RTCM3/System.hs @@ -0,0 +1,110 @@ +-- | +-- Module: Data.RTCM3.System +-- Copyright: Copyright (C) 2015 Swift Navigation, Inc. +-- License: LGPL-3 +-- Maintainer: Mark Fine +-- Stability: experimental +-- Portability: portable +-- +-- RTCMv3 System. + +module Data.RTCM3.System where + +import BasicPrelude +import Control.Lens +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.TH + +-- | MessageHeader +-- +-- Messages and system parameters header. +data MessageHeader = MessageHeader + { _messageHeader_num :: Word16 + -- ^ Message number. + , _messageHeader_station :: Word16 + -- ^ Reference station id. + , _messageHeader_mjd :: Word16 + -- ^ Modified Julian Day Number. + , _messageHeader_seconds :: Word32 + -- ^ Seconds of Day. + , _messageHeader_n :: Word8 + -- ^ Number of messages. + , _messageHeader_leapSeconds :: Word8 + -- ^ Leap Seconds. + } deriving ( Show, Read, Eq ) + +$(makeLenses ''MessageHeader) + +instance BinaryBit MessageHeader where + getBits _n = do + _messageHeader_num <- B.getWord16be 12 + _messageHeader_station <- B.getWord16be 12 + _messageHeader_mjd <- B.getWord16be 16 + _messageHeader_seconds <- B.getWord32be 17 + _messageHeader_n <- B.getWord8 5 + _messageHeader_leapSeconds <- B.getWord8 8 + return MessageHeader {..} + + putBits _n MessageHeader {..} = do + B.putWord16be 12 _messageHeader_num + B.putWord16be 12 _messageHeader_station + B.putWord16be 16 _messageHeader_mjd + B.putWord32be 17 _messageHeader_seconds + B.putWord8 5 _messageHeader_n + B.putWord8 8 _messageHeader_leapSeconds + +-- | Message +-- +-- Transmitted message. +data Message = Message + { _message_num :: Word16 + -- ^ Message number. + , _message_synchronous :: Bool + -- ^ Synchronous flag. + , _message_interval :: Word16 + -- ^ Transmission interval. + } deriving ( Show, Read, Eq ) + +$(makeLenses ''Message) + +instance BinaryBit Message where + getBits _n = do + _message_num <- B.getWord16be 12 + _message_synchronous <- B.getBool + _message_interval <- B.getWord16be 16 + return Message {..} + + putBits _n Message {..} = do + B.putWord16be 12 _message_num + B.putBool _message_synchronous + B.putWord16be 16 _message_interval + +msg1013 :: Word16 +msg1013 = 1013 + +-- | Msg1013. +-- +-- RTCMv3 message 1013. +data Msg1013 = Msg1013 + { _msg1013_header :: MessageHeader + -- ^ Messages header. + , _msg1013_messages :: [Message] + -- ^ Messages. + } deriving ( Show, Read, Eq ) + +$(makeLenses ''Msg1013) + +instance Binary Msg1013 where + get = B.runBitGet $ do + _msg1013_header <- getBits 0 + _msg1013_messages <- replicateM (fromIntegral $ _msg1013_header ^. messageHeader_n) $ getBits 0 + return Msg1013 {..} + + put Msg1013 {..} = B.runBitPut $ do + putBits 0 _msg1013_header + forM_ _msg1013_messages $ putBits 0 + +$(deriveRTCM3 ''Msg1013) diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -1,13 +1,27 @@ +-- | +-- Module: Test +-- Copyright: (c) 2015 Mark Fine +-- License: BSD3 +-- Maintainer: Mark Fine +-- +-- Test module for RTCM3. + import BasicPrelude -import qualified Test.Data.CRC24Q as CRC24Q -import qualified Test.Data.RTCM3.Extras as Extras +import qualified Test.Data.CRC24Q as CRC24Q +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.System as System import Test.Tasty tests :: TestTree tests = testGroup "Tests" [ CRC24Q.tests + , Antennas.tests , Extras.tests + , Observations.tests + , System.tests ] main :: IO () diff --git a/test/Test/Data/CRC24Q.hs b/test/Test/Data/CRC24Q.hs --- a/test/Test/Data/CRC24Q.hs +++ b/test/Test/Data/CRC24Q.hs @@ -1,3 +1,11 @@ +-- | +-- Module: Test.Data.CRC24Q +-- Copyright: (c) 2015 Mark Fine +-- License: BSD3 +-- Maintainer: Mark Fine +-- +-- Test module for CRC24Q. + module Test.Data.CRC24Q ( tests ) where diff --git a/test/Test/Data/RTCM3/Antennas.hs b/test/Test/Data/RTCM3/Antennas.hs new file mode 100644 --- /dev/null +++ b/test/Test/Data/RTCM3/Antennas.hs @@ -0,0 +1,114 @@ +{-# OPTIONS -fno-warn-orphans #-} + +-- | +-- Module: Test.Data.RTCM3.Antennas +-- Copyright: (c) 2015 Mark Fine +-- License: BSD3 +-- Maintainer: Mark Fine +-- +-- Test Antennas module for RTCM3. + +module Test.Data.RTCM3.Antennas + ( tests + ) where + +import BasicPrelude +import Data.Binary +import Data.RTCM3 +import Test.Data.RTCM3.Test +import Test.Tasty +import Test.Tasty.QuickCheck + +instance Arbitrary AntennaReference where + arbitrary = do + _antennaReference_num <- arbitraryWord 12 + _antennaReference_station <- arbitraryWord 12 + _antennaReference_gps <- arbitrary + _antennaReference_glonass <- arbitrary + _antennaReference_computed <- arbitrary + _antennaReference_ecef_x <- arbitraryInt 38 + _antennaReference_oscillator <- arbitrary + _antennaReference_ecef_y <- arbitraryInt 38 + _antennaReference_quarterCycle <- arbitraryWord 2 + _antennaReference_ecef_z <- arbitraryInt 38 + return AntennaReference {..} + +instance Arbitrary ExtAntennaReference where + arbitrary = do + _extAntennaReference_height <- arbitraryWord 16 + return ExtAntennaReference {..} + +instance Arbitrary AntennaDescriptor where + arbitrary = do + _antennaDescriptor_num <- arbitraryWord 12 + _antennaDescriptor_station <- arbitraryWord 12 + _antennaDescriptor_n <- arbitraryWord 8 + _antennaDescriptor_descriptors <- replicateM (fromIntegral _antennaDescriptor_n) $ arbitraryWord 8 + _antennaDescriptor_setup <- arbitraryWord 8 + return AntennaDescriptor {..} + +instance Arbitrary ExtAntennaDescriptor where + arbitrary = do + _extAntennaDescriptor_n <- arbitraryWord 8 + _extAntennaDescriptor_serialNumbers <- replicateM (fromIntegral _extAntennaDescriptor_n) $ arbitraryWord 8 + return ExtAntennaDescriptor {..} + +instance Arbitrary ReceiverDescriptor where + arbitrary = do + _receiverDescriptor_n <- arbitraryWord 8 + _receiverDescriptor_descriptors <- replicateM (fromIntegral _receiverDescriptor_n) $ arbitraryWord 8 + _receiverDescriptor_m <- arbitraryWord 8 + _receiverDescriptor_firmwareVersions <- replicateM (fromIntegral _receiverDescriptor_m) $ arbitraryWord 8 + _receiverDescriptor_l <- arbitraryWord 8 + _receiverDescriptor_serialNumbers <- replicateM (fromIntegral _receiverDescriptor_l) $ arbitraryWord 8 + return ReceiverDescriptor {..} + +instance Arbitrary Msg1005 where + arbitrary = Msg1005 <$> arbitrary + +instance Arbitrary Msg1006 where + arbitrary = Msg1006 <$> arbitrary <*> arbitrary + +instance Arbitrary Msg1007 where + arbitrary = Msg1007 <$> arbitrary + +instance Arbitrary Msg1008 where + arbitrary = Msg1008 <$> arbitrary <*> arbitrary + +instance Arbitrary Msg1033 where + arbitrary = Msg1033 <$> arbitrary <*> arbitrary <*> arbitrary + +testMsg1005 :: TestTree +testMsg1005 = + testProperty "Roundtrip Msg1005" $ \msg -> + (decode $ encode msg) == (msg :: Msg1005) + +testMsg1006 :: TestTree +testMsg1006 = + testProperty "Roundtrip Msg1006" $ \msg -> + (decode $ encode msg) == (msg :: Msg1006) + +testMsg1007 :: TestTree +testMsg1007 = + testProperty "Roundtrip Msg1007" $ \msg -> + (decode $ encode msg) == (msg :: Msg1007) + +testMsg1008 :: TestTree +testMsg1008 = + testProperty "Roundtrip Msg1008" $ \msg -> + (decode $ encode msg) == (msg :: Msg1008) + +testMsg1033 :: TestTree +testMsg1033 = + testProperty "Roundtrip Msg1033" $ \msg -> + (decode $ encode msg) == (msg :: Msg1033) + +tests :: TestTree +tests = + testGroup "Antennas tests" + [ testMsg1005 + , testMsg1006 + , testMsg1007 + , testMsg1008 + , testMsg1033 + ] diff --git a/test/Test/Data/RTCM3/Extras.hs b/test/Test/Data/RTCM3/Extras.hs --- a/test/Test/Data/RTCM3/Extras.hs +++ b/test/Test/Data/RTCM3/Extras.hs @@ -1,11 +1,99 @@ +{-# OPTIONS -fno-warn-orphans #-} +{-# LANGUAGE FlexibleInstances #-} + +-- | +-- Module: Test.Data.RTCM3.Extras +-- Copyright: (c) 2015 Mark Fine +-- License: BSD3 +-- Maintainer: Mark Fine +-- +-- Test Extras module for RTCM3. + module Test.Data.RTCM3.Extras ( tests ) where -import Test.Tasty +import BasicPrelude hiding (ByteString) +import Data.Binary +import qualified Data.Binary.Bits.Get as B +import qualified Data.Binary.Bits.Put as B +import Data.Binary.Get +import Data.Binary.Put +import Data.Bits +import Data.ByteString.Lazy +import Data.Int +import Data.RTCM3.Internal +import Data.Word.Word24 +import Test.Data.RTCM3.Test +import Test.Tasty +import Test.Tasty.QuickCheck +import System.Random +data TestInt a = TestInt Int a deriving ( Show, Read, Eq ) + +arbitraryTestInt :: (Integral a, Bits a, Random a) => Int -> Gen (TestInt a) +arbitraryTestInt b = do + n <- choose (1, b-1) + i <- arbitraryInt n + return $ TestInt n i + +instance Arbitrary (TestInt Int8) where + arbitrary = arbitraryTestInt 8 + +instance Arbitrary (TestInt Int16) where + arbitrary = arbitraryTestInt 16 + +instance Arbitrary (TestInt Int32) where + arbitrary = arbitraryTestInt 32 + +instance Arbitrary (TestInt Int64) where + arbitrary = arbitraryTestInt 64 + +instance Binary Word24 where + get = getWord24be + put = putWord24be + +instance Arbitrary Word24 where + arbitrary = arbitrarySizedBoundedIntegral + shrink = shrinkIntegral + +decodeBits :: B.BitGet a -> ByteString -> a +decodeBits = runGet . B.runBitGet + +encodeBits :: B.BitPut () -> ByteString +encodeBits = runPut . B.runBitPut + +testInt8 :: TestTree +testInt8 = + testProperty "Roundtrip Int8" $ \(TestInt n i) -> + (decodeBits (getInt8 n) $ encodeBits (putInt8 n i)) == (i :: Int8) + +testInt16be :: TestTree +testInt16be = + testProperty "Roundtrip Int16" $ \(TestInt n i) -> + (decodeBits (getInt16be n) $ encodeBits (putInt16be n i)) == (i :: Int16) + +testInt32be :: TestTree +testInt32be = + testProperty "Roundtrip Int32" $ \(TestInt n i) -> + (decodeBits (getInt32be n) $ encodeBits (putInt32be n i)) == (i :: Int32) + +testInt64be :: TestTree +testInt64be = + testProperty "Roundtrip Int64be" $ \(TestInt n i) -> + (decodeBits (getInt64be n) $ encodeBits (putInt64be n i)) == (i :: Int64) + +testWord24be :: TestTree +testWord24be = + testProperty "Roundtrip Word24be" $ \i -> + (decode $ encode i) === (i :: Word24) + tests :: TestTree tests = testGroup "Extras tests" - [ + [ testInt8 + , testInt16be + , testInt32be + , testInt64be + , testWord24be ] diff --git a/test/Test/Data/RTCM3/Observations.hs b/test/Test/Data/RTCM3/Observations.hs new file mode 100644 --- /dev/null +++ b/test/Test/Data/RTCM3/Observations.hs @@ -0,0 +1,244 @@ +{-# OPTIONS -fno-warn-orphans #-} + +-- | +-- Module: Test.Data.RTCM3.Observations +-- Copyright: (c) 2015 Mark Fine +-- License: BSD3 +-- Maintainer: Mark Fine +-- +-- Test Observations module for RTCM3. + +module Test.Data.RTCM3.Observations + ( 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 GpsObservationHeader where + arbitrary = do + _gpsObservationHeader_num <- arbitraryWord 12 + _gpsObservationHeader_station <- arbitraryWord 12 + _gpsObservationHeader_tow <- arbitraryWord 30 + _gpsObservationHeader_synchronous <- arbitrary + _gpsObservationHeader_n <- arbitraryWord 5 + _gpsObservationHeader_smoothing <- arbitrary + _gpsObservationHeader_smoothingInterval <- arbitraryWord 3 + return GpsObservationHeader {..} + +instance Arbitrary GpsL1Observation where + arbitrary = do + _gpsL1Observation_code <- arbitrary + _gpsL1Observation_pseudorange <- arbitraryWord 24 + _gpsL1Observation_carrierMinusCode <- arbitraryInt 20 + _gpsL1Observation_lockTime <- arbitraryWord 7 + return GpsL1Observation {..} + +instance Arbitrary GpsL1ExtObservation where + arbitrary = do + _gpsL1ExtObservation_ambiguity <- arbitraryWord 8 + _gpsL1ExtObservation_cnr <- arbitraryWord 8 + return GpsL1ExtObservation {..} + +instance Arbitrary GpsL2Observation where + arbitrary = do + _gpsL2Observation_code <- arbitraryWord 2 + _gpsL2Observation_pseudorangeDifference <- arbitraryInt 14 + _gpsL2Observation_carrierMinusCode <- arbitraryInt 20 + _gpsL2Observation_lockTime <- arbitraryWord 7 + return GpsL2Observation {..} + +instance Arbitrary GpsL2ExtObservation where + arbitrary = do + _gpsL2ExtObservation_cnr <- arbitraryWord 8 + return GpsL2ExtObservation {..} + +instance Arbitrary GlonassObservationHeader where + arbitrary = do + _glonassObservationHeader_num <- arbitraryWord 12 + _glonassObservationHeader_station <- arbitraryWord 12 + _glonassObservationHeader_epoch <- arbitraryWord 27 + _glonassObservationHeader_synchronous <- arbitrary + _glonassObservationHeader_n <- arbitraryWord 5 + _glonassObservationHeader_smoothing <- arbitrary + _glonassObservationHeader_smoothingInterval <- arbitraryWord 3 + return GlonassObservationHeader {..} + +instance Arbitrary GlonassL1Observation where + arbitrary = do + _glonassL1Observation_code <- arbitrary + _glonassL1Observation_frequency <- arbitraryWord 5 + _glonassL1Observation_pseudorange <- arbitraryWord 25 + _glonassL1Observation_carrierMinusCode <- arbitraryInt 20 + _glonassL1Observation_lockTime <- arbitraryWord 7 + return GlonassL1Observation {..} + +instance Arbitrary GlonassL1ExtObservation where + arbitrary = do + _glonassL1ExtObservation_ambiguity <- arbitraryWord 7 + _glonassL1ExtObservation_cnr <- arbitraryWord 8 + return GlonassL1ExtObservation {..} + +instance Arbitrary GlonassL2Observation where + arbitrary = do + _glonassL2Observation_code <- arbitraryWord 2 + _glonassL2Observation_pseudorangeDifference <- arbitraryInt 14 + _glonassL2Observation_carrierMinusCode <- arbitraryInt 20 + _glonassL2Observation_lockTime <- arbitraryWord 7 + return GlonassL2Observation {..} + +instance Arbitrary GlonassL2ExtObservation where + arbitrary = do + _glonassL2ExtObservation_cnr <- arbitraryWord 8 + return GlonassL2ExtObservation {..} + +instance Arbitrary GlonassBias where + arbitrary = do + _glonassBias_num <- arbitraryWord 12 + _glonassBias_station <- arbitraryWord 12 + _glonassBias_bias <- arbitrary + _glonassBias_mask <- arbitraryWord 4 + _glonassBias_l1ca <- arbitraryWord 16 + _glonassBias_l1p <- arbitraryWord 16 + _glonassBias_l2ca <- arbitraryWord 16 + _glonassBias_l2p <- arbitraryWord 16 + return GlonassBias {..} + +instance Arbitrary Observation1001 where + arbitrary = Observation1001 <$> arbitraryWord 6 <*> arbitrary + +instance Arbitrary Msg1001 where + arbitrary = do + _msg1001_header <- arbitrary + _msg1001_observations <- replicateM (fromIntegral $ _msg1001_header ^. gpsObservationHeader_n) $ arbitrary + return Msg1001 {..} + +instance Arbitrary Observation1002 where + arbitrary = Observation1002 <$> arbitraryWord 6 <*> arbitrary <*> arbitrary + +instance Arbitrary Msg1002 where + arbitrary = do + _msg1002_header <- arbitrary + _msg1002_observations <- replicateM (fromIntegral $ _msg1002_header ^. gpsObservationHeader_n) $ arbitrary + return Msg1002 {..} + +instance Arbitrary Observation1003 where + arbitrary = Observation1003 <$> arbitraryWord 6 <*> arbitrary <*> arbitrary + +instance Arbitrary Msg1003 where + arbitrary = do + _msg1003_header <- arbitrary + _msg1003_observations <- replicateM (fromIntegral $ _msg1003_header ^. gpsObservationHeader_n) $ arbitrary + return Msg1003 {..} + +instance Arbitrary Observation1004 where + arbitrary = Observation1004 <$> arbitraryWord 6 <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + +instance Arbitrary Msg1004 where + arbitrary = do + _msg1004_header <- arbitrary + _msg1004_observations <- replicateM (fromIntegral $ _msg1004_header ^. gpsObservationHeader_n) $ arbitrary + return Msg1004 {..} + +instance Arbitrary Observation1009 where + arbitrary = Observation1009 <$> arbitraryWord 6 <*> arbitrary + +instance Arbitrary Msg1009 where + arbitrary = do + _msg1009_header <- arbitrary + _msg1009_observations <- replicateM (fromIntegral $ _msg1009_header ^. glonassObservationHeader_n) $ arbitrary + return Msg1009 {..} + +instance Arbitrary Observation1010 where + arbitrary = Observation1010 <$> arbitraryWord 6 <*> arbitrary <*> arbitrary + +instance Arbitrary Msg1010 where + arbitrary = do + _msg1010_header <- arbitrary + _msg1010_observations <- replicateM (fromIntegral $ _msg1010_header ^. glonassObservationHeader_n) $ arbitrary + return Msg1010 {..} + +instance Arbitrary Observation1011 where + arbitrary = Observation1011 <$> arbitraryWord 6 <*> arbitrary <*> arbitrary + +instance Arbitrary Msg1011 where + arbitrary = do + _msg1011_header <- arbitrary + _msg1011_observations <- replicateM (fromIntegral $ _msg1011_header ^. glonassObservationHeader_n) $ arbitrary + return Msg1011 {..} + +instance Arbitrary Observation1012 where + arbitrary = Observation1012 <$> arbitraryWord 6 <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + +instance Arbitrary Msg1012 where + arbitrary = do + _msg1012_header <- arbitrary + _msg1012_observations <- replicateM (fromIntegral $ _msg1012_header ^. glonassObservationHeader_n) $ arbitrary + return Msg1012 {..} + +instance Arbitrary Msg1230 where + arbitrary = Msg1230 <$> arbitrary + +testMsg1001 :: TestTree +testMsg1001 = + testProperty "Roundtrip Msg1001" $ \msg -> + (decode $ encode msg) == (msg :: Msg1001) + +testMsg1002 :: TestTree +testMsg1002 = + testProperty "Roundtrip Msg1002" $ \msg -> + (decode $ encode msg) == (msg :: Msg1002) + +testMsg1003 :: TestTree +testMsg1003 = + testProperty "Roundtrip Msg1003" $ \msg -> + (decode $ encode msg) == (msg :: Msg1003) + +testMsg1004 :: TestTree +testMsg1004 = + testProperty "Roundtrip Msg1004" $ \msg -> + (decode $ encode msg) == (msg :: Msg1004) + +testMsg1009 :: TestTree +testMsg1009 = + testProperty "Roundtrip Msg1009" $ \msg -> + (decode $ encode msg) == (msg :: Msg1009) + +testMsg1010 :: TestTree +testMsg1010 = + testProperty "Roundtrip Msg1010" $ \msg -> + (decode $ encode msg) == (msg :: Msg1010) + +testMsg1011 :: TestTree +testMsg1011 = + testProperty "Roundtrip Msg1011" $ \msg -> + (decode $ encode msg) == (msg :: Msg1011) + +testMsg1012 :: TestTree +testMsg1012 = + testProperty "Roundtrip Msg1012" $ \msg -> + (decode $ encode msg) == (msg :: Msg1012) + +testMsg1230 :: TestTree +testMsg1230 = + testProperty "Roundtrip Msg1230" $ \msg -> + (decode $ encode msg) == (msg :: Msg1230) + +tests :: TestTree +tests = + testGroup "Observations tests" + [ testMsg1001 + , testMsg1002 + , testMsg1003 + , testMsg1004 + , testMsg1009 + , testMsg1010 + , testMsg1011 + , testMsg1012 + , testMsg1230 + ] diff --git a/test/Test/Data/RTCM3/System.hs b/test/Test/Data/RTCM3/System.hs new file mode 100644 --- /dev/null +++ b/test/Test/Data/RTCM3/System.hs @@ -0,0 +1,55 @@ +{-# OPTIONS -fno-warn-orphans #-} + +-- | +-- Module: Test.Data.RTCM3.System +-- Copyright: (c) 2015 Mark Fine +-- License: BSD3 +-- Maintainer: Mark Fine +-- +-- Test System module for RTCM3. + +module Test.Data.RTCM3.System + ( 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 MessageHeader where + arbitrary = do + _messageHeader_num <- arbitraryWord 12 + _messageHeader_station <- arbitraryWord 12 + _messageHeader_mjd <- arbitraryWord 16 + _messageHeader_seconds <- arbitraryWord 17 + _messageHeader_n <- arbitraryWord 5 + _messageHeader_leapSeconds <- arbitraryWord 8 + return MessageHeader {..} + +instance Arbitrary Message where + arbitrary = do + _message_num <- arbitraryWord 12 + _message_synchronous <- arbitrary + _message_interval <- arbitraryWord 16 + return Message {..} + +instance Arbitrary Msg1013 where + arbitrary = do + header <- arbitrary + messages <- replicateM (fromIntegral $ header ^. messageHeader_n) arbitrary + return $ Msg1013 header messages + +testMsg1013 :: TestTree +testMsg1013 = + testProperty "Roundtrip Msg1013" $ \msg -> + (decode $ encode msg) == (msg :: Msg1013) + +tests :: TestTree +tests = + testGroup "System tests" + [ testMsg1013 + ] diff --git a/test/Test/Data/RTCM3/Test.hs b/test/Test/Data/RTCM3/Test.hs new file mode 100644 --- /dev/null +++ b/test/Test/Data/RTCM3/Test.hs @@ -0,0 +1,24 @@ +-- | +-- Module: Test.Data.RTCM3.Test +-- Copyright: (c) 2015 Mark Fine +-- License: BSD3 +-- Maintainer: Mark Fine +-- +-- Test module for RTCM3. + +module Test.Data.RTCM3.Test where + +import BasicPrelude +import Data.Bits +import Test.Tasty.QuickCheck +import System.Random + +arbitraryWord :: (Integral a, Bits a, Random a) => Int -> Gen a +arbitraryWord b = do + let m = (1 `shiftL` b) - 1 + choose (0, m) + +arbitraryInt :: (Integral a, Bits a, Random a) => Int -> Gen a +arbitraryInt b = do + let m = (1 `shiftL` (b - 1)) - 1 + choose (-m, m)