diff --git a/main/json2rtcm3.hs b/main/json2rtcm3.hs new file mode 100644 --- /dev/null +++ b/main/json2rtcm3.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module: Main +-- Copyright: Copyright (C) 2015 Swift Navigation, Inc. +-- License: LGPL-3 +-- Maintainer: Swift Navigation +-- Stability: experimental +-- Portability: portable +-- +-- JSON to RTCM3 tool - reads RTCM3 JSON from stdin and sends RTCM3 binary +-- to stdout. + +import BasicPrelude hiding (lines, mapMaybe) +import Control.Monad.Trans.Resource +import Data.Aeson +import Data.Conduit +import Data.Conduit.Binary +import Data.Conduit.List +import Data.Conduit.Serialization.Binary +import Data.RTCM3 +import System.IO + +-- | Decode a line of JSON to RTCM3. +decodeLine :: ByteString -> Maybe RTCM3Msg +decodeLine = decodeStrict + +main :: IO () +main = + runResourceT $ + sourceHandle stdin =$= + lines =$= + mapMaybe decodeLine =$= + conduitEncode $$ + sinkHandle stdout diff --git a/main/rtcm32json.hs b/main/rtcm32json.hs --- a/main/rtcm32json.hs +++ b/main/rtcm32json.hs @@ -12,26 +12,25 @@ -- 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 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 - +import BasicPrelude hiding (map) +import Control.Monad.Trans.Resource +import Data.Aeson +import Data.ByteString.Lazy hiding (ByteString, map) +import Data.Conduit +import Data.Conduit.Binary +import Data.Conduit.List +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 $ encode v <> "\n" +encodeLine v = toStrict $ encode v <> "\n" main :: IO () main = runResourceT $ sourceHandle stdin =$= conduitDecode =$= - CL.map encodeLine $$ + map encodeLine $$ sinkHandle stdout diff --git a/rtcm.cabal b/rtcm.cabal --- a/rtcm.cabal +++ b/rtcm.cabal @@ -1,6 +1,6 @@ name: rtcm -version: 0.1.12 -cabal-version: >=1.10 +version: 0.2.1 +cabal-version: >=1.22 build-type: Simple license: BSD3 copyright: Copyright (C) 2015-2017 Swift Navigation, Inc. @@ -31,22 +31,22 @@ Data.RTCM3.System Data.RTCM3.Types build-depends: - aeson >=0.11.3.0, - array >=0.5.1.0, + aeson >=1.0.2.1, + array >=0.5.1.1, base >=4.8 && <5, base64-bytestring >=1.0.0.1, - basic-prelude >=0.5.2, - binary >=0.7.5.0, + basic-prelude >=0.6.1.1, + binary >=0.8.3.0, binary-bits >=0.5, - bytestring >=0.10.6.0, - lens >=4.13, - template-haskell >=2.10.0.0, - text >=1.2.2.2, + bytestring >=0.10.8.1, + lens >=4.15.1, + lens-aeson >=1.0.1, + template-haskell >=2.11.1.0, + text >=1.2.2.1, word24 >=2.0.1 default-language: Haskell2010 hs-source-dirs: src other-modules: - Data.RTCM3.Aeson Data.RTCM3.Extras Data.RTCM3.TH ghc-options: -Wall @@ -54,32 +54,47 @@ executable rtcm32json main-is: rtcm32json.hs build-depends: - aeson >=0.11.3.0, - base >=4.8.2.0, - basic-prelude >=0.5.2, + aeson >=1.0.2.1, + base >=4.9.1.0, + basic-prelude >=0.6.1.1, binary-conduit >=1.2.4.1, - bytestring >=0.10.6.0, - conduit >=1.2.10, - conduit-combinators >=1.0.8.3, + bytestring >=0.10.8.1, + conduit >=1.2.11, + conduit-combinators >=1.1.1, conduit-extra >=1.1.16, resourcet >=1.1.9, - rtcm >=0.1.12 + rtcm default-language: Haskell2010 hs-source-dirs: main ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall +executable json2rtcm3 + main-is: json2rtcm3.hs + build-depends: + aeson >=1.0.2.1, + base >=4.9.1.0, + basic-prelude >=0.6.1.1, + binary-conduit >=1.2.4.1, + conduit >=1.2.11, + conduit-extra >=1.1.16, + resourcet >=1.1.9, + rtcm + default-language: Haskell2010 + hs-source-dirs: main + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall + test-suite test type: exitcode-stdio-1.0 main-is: Test.hs build-depends: - base >=4.8.2.0, - basic-prelude >=0.5.2, - binary >=0.7.5.0, + base >=4.9.1.0, + basic-prelude >=0.6.1.1, + binary >=0.8.3.0, binary-bits >=0.5, - bytestring >=0.10.6.0, - lens >=4.13, + bytestring >=0.10.8.1, + lens >=4.15.1, random >=1.1, - rtcm >=0.1.12, + rtcm, tasty >=0.11.2.1, tasty-hunit >=0.9.2, tasty-quickcheck >=0.8.4, diff --git a/src/Data/RTCM3.hs b/src/Data/RTCM3.hs --- a/src/Data/RTCM3.hs +++ b/src/Data/RTCM3.hs @@ -20,7 +20,8 @@ import BasicPrelude import Control.Lens hiding ((.=)) -import Data.Aeson hiding (decode, decode') +import Data.Aeson hiding (decode) +import Data.Aeson.Lens import Data.Binary import Data.ByteString.Lazy import Data.RTCM3.Antennas as Export @@ -66,63 +67,63 @@ instance Binary RTCM3Msg where get = do preamble <- getWord8 - if preamble /= msgRTCM3Preamble then get else do - decode' <$> get where - decode' m@Msg {..} + if preamble /= msgRTCM3Preamble then get else + decoder <$> get where + decoder m@Msg {..} | crc /= _msgRTCM3Crc = RTCM3MsgBadCrc m | 0 == _msgRTCM3Len = RTCM3MsgEmpty m - | num == msg1001 = RTCM3Msg1001 (decode $ fromStrict _msgRTCM3Payload) m - | num == msg1002 = RTCM3Msg1002 (decode $ fromStrict _msgRTCM3Payload) m - | num == msg1003 = RTCM3Msg1003 (decode $ fromStrict _msgRTCM3Payload) m - | num == msg1004 = RTCM3Msg1004 (decode $ fromStrict _msgRTCM3Payload) m - | num == msg1005 = RTCM3Msg1005 (decode $ fromStrict _msgRTCM3Payload) m - | num == msg1006 = RTCM3Msg1006 (decode $ fromStrict _msgRTCM3Payload) m - | num == msg1007 = RTCM3Msg1007 (decode $ fromStrict _msgRTCM3Payload) m - | num == msg1008 = RTCM3Msg1008 (decode $ fromStrict _msgRTCM3Payload) m - | num == msg1009 = RTCM3Msg1009 (decode $ fromStrict _msgRTCM3Payload) m - | num == msg1010 = RTCM3Msg1010 (decode $ fromStrict _msgRTCM3Payload) m - | num == msg1011 = RTCM3Msg1011 (decode $ fromStrict _msgRTCM3Payload) m - | num == msg1012 = RTCM3Msg1012 (decode $ fromStrict _msgRTCM3Payload) m - | num == msg1013 = RTCM3Msg1013 (decode $ fromStrict _msgRTCM3Payload) m - | num == msg1019 = RTCM3Msg1019 (decode $ fromStrict _msgRTCM3Payload) m - | num == msg1020 = RTCM3Msg1020 (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 + | num == msg1001 = RTCM3Msg1001 (decode $ fromStrict $ unBytes _msgRTCM3Payload) m + | num == msg1002 = RTCM3Msg1002 (decode $ fromStrict $ unBytes _msgRTCM3Payload) m + | num == msg1003 = RTCM3Msg1003 (decode $ fromStrict $ unBytes _msgRTCM3Payload) m + | num == msg1004 = RTCM3Msg1004 (decode $ fromStrict $ unBytes _msgRTCM3Payload) m + | num == msg1005 = RTCM3Msg1005 (decode $ fromStrict $ unBytes _msgRTCM3Payload) m + | num == msg1006 = RTCM3Msg1006 (decode $ fromStrict $ unBytes _msgRTCM3Payload) m + | num == msg1007 = RTCM3Msg1007 (decode $ fromStrict $ unBytes _msgRTCM3Payload) m + | num == msg1008 = RTCM3Msg1008 (decode $ fromStrict $ unBytes _msgRTCM3Payload) m + | num == msg1009 = RTCM3Msg1009 (decode $ fromStrict $ unBytes _msgRTCM3Payload) m + | num == msg1010 = RTCM3Msg1010 (decode $ fromStrict $ unBytes _msgRTCM3Payload) m + | num == msg1011 = RTCM3Msg1011 (decode $ fromStrict $ unBytes _msgRTCM3Payload) m + | num == msg1012 = RTCM3Msg1012 (decode $ fromStrict $ unBytes _msgRTCM3Payload) m + | num == msg1013 = RTCM3Msg1013 (decode $ fromStrict $ unBytes _msgRTCM3Payload) m + | num == msg1019 = RTCM3Msg1019 (decode $ fromStrict $ unBytes _msgRTCM3Payload) m + | num == msg1020 = RTCM3Msg1020 (decode $ fromStrict $ unBytes _msgRTCM3Payload) m + | num == msg1033 = RTCM3Msg1033 (decode $ fromStrict $ unBytes _msgRTCM3Payload) m + | num == msg1057 = RTCM3Msg1057 (decode $ fromStrict $ unBytes _msgRTCM3Payload) m + | num == msg1058 = RTCM3Msg1058 (decode $ fromStrict $ unBytes _msgRTCM3Payload) m + | num == msg1063 = RTCM3Msg1063 (decode $ fromStrict $ unBytes _msgRTCM3Payload) m + | num == msg1064 = RTCM3Msg1064 (decode $ fromStrict $ unBytes _msgRTCM3Payload) m + | num == msg1230 = RTCM3Msg1230 (decode $ fromStrict $ unBytes _msgRTCM3Payload) m | otherwise = RTCM3MsgUnknown num m where - crc = checkCrc _msgRTCM3Len _msgRTCM3Payload - num = checkNum _msgRTCM3Payload + crc = checkCrc _msgRTCM3Len $ unBytes _msgRTCM3Payload + num = checkNum $ unBytes _msgRTCM3Payload put rm = do putWord8 msgRTCM3Preamble - encode' rm where - encode' (RTCM3Msg1001 _n m) = put m - encode' (RTCM3Msg1002 _n m) = put m - encode' (RTCM3Msg1003 _n m) = put m - encode' (RTCM3Msg1004 _n m) = put m - encode' (RTCM3Msg1005 _n m) = put m - encode' (RTCM3Msg1006 _n m) = put m - encode' (RTCM3Msg1007 _n m) = put m - encode' (RTCM3Msg1008 _n m) = put m - encode' (RTCM3Msg1009 _n m) = put m - encode' (RTCM3Msg1010 _n m) = put m - encode' (RTCM3Msg1011 _n m) = put m - encode' (RTCM3Msg1012 _n m) = put m - encode' (RTCM3Msg1013 _n m) = put m - encode' (RTCM3Msg1019 _n m) = put m - encode' (RTCM3Msg1020 _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 _n m) = put m - encode' (RTCM3MsgBadCrc m) = put m - encode' (RTCM3MsgEmpty m) = put m + encoder rm where + encoder (RTCM3Msg1001 _n m) = put m + encoder (RTCM3Msg1002 _n m) = put m + encoder (RTCM3Msg1003 _n m) = put m + encoder (RTCM3Msg1004 _n m) = put m + encoder (RTCM3Msg1005 _n m) = put m + encoder (RTCM3Msg1006 _n m) = put m + encoder (RTCM3Msg1007 _n m) = put m + encoder (RTCM3Msg1008 _n m) = put m + encoder (RTCM3Msg1009 _n m) = put m + encoder (RTCM3Msg1010 _n m) = put m + encoder (RTCM3Msg1011 _n m) = put m + encoder (RTCM3Msg1012 _n m) = put m + encoder (RTCM3Msg1013 _n m) = put m + encoder (RTCM3Msg1019 _n m) = put m + encoder (RTCM3Msg1020 _n m) = put m + encoder (RTCM3Msg1033 _n m) = put m + encoder (RTCM3Msg1057 _n m) = put m + encoder (RTCM3Msg1058 _n m) = put m + encoder (RTCM3Msg1063 _n m) = put m + encoder (RTCM3Msg1064 _n m) = put m + encoder (RTCM3Msg1230 _n m) = put m + encoder (RTCM3MsgUnknown _n m) = put m + encoder (RTCM3MsgBadCrc m) = put m + encoder (RTCM3MsgEmpty m) = put m instance HasMsg RTCM3Msg where msg f (RTCM3Msg1001 n m) = RTCM3Msg1001 n <$> f m @@ -150,34 +151,63 @@ msg f (RTCM3MsgBadCrc m) = RTCM3MsgBadCrc <$> f m msg f (RTCM3MsgEmpty m) = RTCM3MsgEmpty <$> 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 +(<<>>) :: Value -> Value -> Value +(<<>>) a b = fromMaybe Null $ do + c <- preview _Object a + d <- preview _Object b + return $ review _Object $ c <> d 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 (RTCM3Msg1019 n m) = toJSON n `mergeValues` toJSON m - toJSON (RTCM3Msg1020 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 n m) = object [ "num" .= n ] `mergeValues` toJSON m + toJSON (RTCM3Msg1001 n m) = toJSON n <<>> toJSON m + toJSON (RTCM3Msg1002 n m) = toJSON n <<>> toJSON m + toJSON (RTCM3Msg1003 n m) = toJSON n <<>> toJSON m + toJSON (RTCM3Msg1004 n m) = toJSON n <<>> toJSON m + toJSON (RTCM3Msg1005 n m) = toJSON n <<>> toJSON m + toJSON (RTCM3Msg1006 n m) = toJSON n <<>> toJSON m + toJSON (RTCM3Msg1007 n m) = toJSON n <<>> toJSON m + toJSON (RTCM3Msg1008 n m) = toJSON n <<>> toJSON m + toJSON (RTCM3Msg1009 n m) = toJSON n <<>> toJSON m + toJSON (RTCM3Msg1010 n m) = toJSON n <<>> toJSON m + toJSON (RTCM3Msg1011 n m) = toJSON n <<>> toJSON m + toJSON (RTCM3Msg1012 n m) = toJSON n <<>> toJSON m + toJSON (RTCM3Msg1013 n m) = toJSON n <<>> toJSON m + toJSON (RTCM3Msg1019 n m) = toJSON n <<>> toJSON m + toJSON (RTCM3Msg1020 n m) = toJSON n <<>> toJSON m + toJSON (RTCM3Msg1033 n m) = toJSON n <<>> toJSON m + toJSON (RTCM3Msg1057 n m) = toJSON n <<>> toJSON m + toJSON (RTCM3Msg1058 n m) = toJSON n <<>> toJSON m + toJSON (RTCM3Msg1063 n m) = toJSON n <<>> toJSON m + toJSON (RTCM3Msg1064 n m) = toJSON n <<>> toJSON m + toJSON (RTCM3Msg1230 n m) = toJSON n <<>> toJSON m + toJSON (RTCM3MsgUnknown n m) = object [ "num" .= n ] <<>> toJSON m toJSON (RTCM3MsgBadCrc m) = toJSON m toJSON (RTCM3MsgEmpty m) = toJSON m + +instance FromJSON RTCM3Msg where + parseJSON obj@(Object o) = do + payload <- o .: "payload" + decoder (checkNum $ unBytes payload) payload where + decoder num payload + | num == msg1001 = RTCM3Msg1001 <$> pure (decode $ fromStrict $ unBytes payload) <*> parseJSON obj + | num == msg1002 = RTCM3Msg1002 <$> pure (decode $ fromStrict $ unBytes payload) <*> parseJSON obj + | num == msg1003 = RTCM3Msg1003 <$> pure (decode $ fromStrict $ unBytes payload) <*> parseJSON obj + | num == msg1004 = RTCM3Msg1004 <$> pure (decode $ fromStrict $ unBytes payload) <*> parseJSON obj + | num == msg1005 = RTCM3Msg1005 <$> pure (decode $ fromStrict $ unBytes payload) <*> parseJSON obj + | num == msg1006 = RTCM3Msg1006 <$> pure (decode $ fromStrict $ unBytes payload) <*> parseJSON obj + | num == msg1007 = RTCM3Msg1007 <$> pure (decode $ fromStrict $ unBytes payload) <*> parseJSON obj + | num == msg1008 = RTCM3Msg1008 <$> pure (decode $ fromStrict $ unBytes payload) <*> parseJSON obj + | num == msg1009 = RTCM3Msg1009 <$> pure (decode $ fromStrict $ unBytes payload) <*> parseJSON obj + | num == msg1010 = RTCM3Msg1010 <$> pure (decode $ fromStrict $ unBytes payload) <*> parseJSON obj + | num == msg1011 = RTCM3Msg1011 <$> pure (decode $ fromStrict $ unBytes payload) <*> parseJSON obj + | num == msg1012 = RTCM3Msg1012 <$> pure (decode $ fromStrict $ unBytes payload) <*> parseJSON obj + | num == msg1013 = RTCM3Msg1013 <$> pure (decode $ fromStrict $ unBytes payload) <*> parseJSON obj + | num == msg1019 = RTCM3Msg1019 <$> pure (decode $ fromStrict $ unBytes payload) <*> parseJSON obj + | num == msg1020 = RTCM3Msg1020 <$> pure (decode $ fromStrict $ unBytes payload) <*> parseJSON obj + | num == msg1033 = RTCM3Msg1033 <$> pure (decode $ fromStrict $ unBytes payload) <*> parseJSON obj + | num == msg1057 = RTCM3Msg1057 <$> pure (decode $ fromStrict $ unBytes payload) <*> parseJSON obj + | num == msg1058 = RTCM3Msg1058 <$> pure (decode $ fromStrict $ unBytes payload) <*> parseJSON obj + | num == msg1063 = RTCM3Msg1063 <$> pure (decode $ fromStrict $ unBytes payload) <*> parseJSON obj + | num == msg1064 = RTCM3Msg1064 <$> pure (decode $ fromStrict $ unBytes payload) <*> parseJSON obj + | num == msg1230 = RTCM3Msg1230 <$> pure (decode $ fromStrict $ unBytes payload) <*> parseJSON obj + | otherwise = RTCM3MsgUnknown <$> pure num <*> parseJSON obj + parseJSON _ = mzero diff --git a/src/Data/RTCM3/Aeson.hs b/src/Data/RTCM3/Aeson.hs deleted file mode 100644 --- a/src/Data/RTCM3/Aeson.hs +++ /dev/null @@ -1,38 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} - -{-# OPTIONS -fno-warn-orphans #-} --- | --- Module: Data.RTCM3.Extras --- Copyright: Copyright (C) 2015 Swift Navigation, Inc. --- License: LGPL-3 --- Maintainer: Swift Navigation --- 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 @@ -24,6 +24,8 @@ import Data.RTCM3.Extras import Data.RTCM3.TH +{-# ANN module ("HLint: ignore Use camelCase"::String) #-} + -- | AntennaReference. -- -- Stationary antenna reference point information. @@ -88,7 +90,7 @@ -- | ExtAntennaReference. -- -- Extended stationary antenna reference point information. -data ExtAntennaReference = ExtAntennaReference +newtype ExtAntennaReference = ExtAntennaReference { _extAntennaReference_height :: Word16 -- ^ Antenna height. } deriving ( Show, Read, Eq ) @@ -207,7 +209,7 @@ -- | Msg1005. -- -- RTCMv3 message 1005. -data Msg1005 = Msg1005 +newtype Msg1005 = Msg1005 { _msg1005_reference :: AntennaReference -- ^ Antenna reference. } deriving ( Show, Read, Eq ) @@ -259,7 +261,7 @@ -- | Msg1007. -- -- RTCMv3 message 1007. -data Msg1007 = Msg1007 +newtype Msg1007 = Msg1007 { _msg1007_descriptor :: AntennaDescriptor -- ^ Antenna descriptor. } deriving ( Show, Read, Eq ) diff --git a/src/Data/RTCM3/Ephemerides.hs b/src/Data/RTCM3/Ephemerides.hs --- a/src/Data/RTCM3/Ephemerides.hs +++ b/src/Data/RTCM3/Ephemerides.hs @@ -25,6 +25,8 @@ import Data.RTCM3.Extras import Data.RTCM3.TH +{-# ANN module ("HLint: ignore Use camelCase"::String) #-} + -- | GpsEphemerisHeader. -- -- GPS and Glonass Ephemeris header. 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 @@ -26,6 +26,8 @@ import Data.RTCM3.Extras import Data.RTCM3.TH +{-# ANN module ("HLint: ignore Use camelCase"::String) #-} + -- | GpsObservationHeader. -- -- GPS RTK observation header. @@ -157,7 +159,7 @@ -- | GpsL2ExtObservation. -- -- GPS RTK L2 extended observation. -data GpsL2ExtObservation = GpsL2ExtObservation +newtype GpsL2ExtObservation = GpsL2ExtObservation { _gpsL2ExtObservation_cnr :: Word8 -- ^ GPS L2 carrier-to-noise ratio. } deriving ( Show, Read, Eq ) @@ -308,7 +310,7 @@ -- | GlonassL2ExtObservation. -- -- GLONASS RTK L2 extended observation. -data GlonassL2ExtObservation = GlonassL2ExtObservation +newtype GlonassL2ExtObservation = GlonassL2ExtObservation { _glonassL2ExtObservation_cnr :: Word8 -- ^ GLONASS L2 carrier-to-noise ratio. } deriving ( Show, Read, Eq ) @@ -825,7 +827,7 @@ -- | Msg1230. -- -- RTCMv3 message 1230. -data Msg1230 = Msg1230 +newtype Msg1230 = Msg1230 { _msg1230_bias :: GlonassBias -- ^ GLONASS bias. } deriving ( Show, Read, Eq ) @@ -838,7 +840,7 @@ _msg1230_bias <- getBits 0 return Msg1230 {..} - put Msg1230 {..} = B.runBitPut $ do + put Msg1230 {..} = B.runBitPut $ putBits 0 _msg1230_bias $(deriveRTCM3 ''Msg1230) diff --git a/src/Data/RTCM3/SSR.hs b/src/Data/RTCM3/SSR.hs --- a/src/Data/RTCM3/SSR.hs +++ b/src/Data/RTCM3/SSR.hs @@ -24,6 +24,8 @@ import Data.RTCM3.Extras import Data.RTCM3.TH +{-# ANN module ("HLint: ignore Use camelCase"::String) #-} + -- | GpsOrbitCorrectionHeader. -- -- GPS orbit correction header. 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 @@ -23,6 +23,8 @@ import qualified Data.Binary.Bits.Put as B import Data.RTCM3.TH +{-# ANN module ("HLint: ignore Use camelCase"::String) #-} + -- | MessageHeader -- -- Messages and system parameters header. diff --git a/src/Data/RTCM3/TH.hs b/src/Data/RTCM3/TH.hs --- a/src/Data/RTCM3/TH.hs +++ b/src/Data/RTCM3/TH.hs @@ -25,7 +25,7 @@ deriveRTCM3 :: Name -> Q [Dec] deriveRTCM3 name = [d|instance ToRTCM3 $(conT name) where - toRTCM3 n = Msg len pay crc where + toRTCM3 n = Msg len (Bytes pay) crc where pay = toStrict $ encode n len = fromIntegral $ length pay crc = checkCrc len pay 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 @@ -1,3 +1,4 @@ +{-# OPTIONS -fno-warn-orphans #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -17,30 +18,42 @@ module Data.RTCM3.Types where import BasicPrelude -import Control.Lens hiding ((.=)) +import Control.Lens hiding ((.=)) import Data.Aeson import Data.Binary -import qualified Data.Binary.Bits.Get as B +import qualified Data.Binary.Bits.Get as B import Data.Binary.Get import Data.Binary.Put +import Data.ByteString.Base64 as Base64 import Data.ByteString.Builder -import Data.ByteString.Lazy hiding (ByteString) +import Data.ByteString.Lazy hiding (ByteString) import Data.CRC24Q -import Data.RTCM3.Aeson () import Data.RTCM3.Extras +import Data.Text.Encoding +import Data.Text.Encoding.Error import Data.Word.Word24 msgRTCM3Preamble :: Word8 msgRTCM3Preamble = 0xD3 +newtype Bytes = Bytes + { unBytes :: ByteString + } deriving ( Show, Read, Eq ) + data Msg = Msg - { _msgRTCM3Len :: Word16 - , _msgRTCM3Payload :: !ByteString - , _msgRTCM3Crc :: Word24 + { _msgRTCM3Len :: !Word16 + , _msgRTCM3Payload :: !Bytes + , _msgRTCM3Crc :: !Word24 } deriving ( Show, Read, Eq ) $(makeClassy ''Msg) +instance ToJSON Bytes where + toJSON = toJSON . decodeUtf8With ignore . Base64.encode . unBytes + +instance ToJSON Word24 where + toJSON = Number . fromIntegral + instance ToJSON Msg where toJSON Msg {..} = object [ "len" .= _msgRTCM3Len @@ -48,17 +61,30 @@ , "crc" .= _msgRTCM3Crc ] +instance FromJSON Bytes where + parseJSON = withText "ByteString" (pure . Bytes . Base64.decodeLenient . encodeUtf8) + +instance FromJSON Word24 where + parseJSON = withScientific "Word24" (pure . truncate) + +instance FromJSON Msg where + parseJSON (Object v) = + Msg <$> v .: "len" + <*> v .: "payload" + <*> v .: "crc" + parseJSON _ = mzero + instance Binary Msg where get = do _msgRTCM3Len <- getWord16be - _msgRTCM3Payload <- getByteString $ fromIntegral _msgRTCM3Len + _msgRTCM3Payload <- fmap Bytes $ getByteString $ fromIntegral _msgRTCM3Len _msgRTCM3Crc <- getWord24be return Msg {..} put Msg {..} = do - putWord16be _msgRTCM3Len - putByteString _msgRTCM3Payload - putWord24be _msgRTCM3Crc + putWord16be _msgRTCM3Len + putByteString $ unBytes _msgRTCM3Payload + putWord24be _msgRTCM3Crc checkCrc :: Word16 -> ByteString -> Word24 checkCrc len payload = @@ -73,7 +99,7 @@ B.getWord16be 12 msgRTCM3Num :: HasMsg m => m -> Word16 -msgRTCM3Num = checkNum . (^. msgRTCM3Payload) +msgRTCM3Num = checkNum . unBytes . (^. msgRTCM3Payload) class Binary a => ToRTCM3 a where toRTCM3 :: a -> Msg