Skip to content

Commit

Permalink
[ESD-1238] Do not call nullary constructors in Haskell ToJSON (#680)
Browse files Browse the repository at this point in the history 
* Do not call nullary constructors in Haskell ToJSON

* Add lambda for sorting

* Regenerate Msg.hs
  • Loading branch information
@pmiettinen
pmiettinen authored Apr 15, 2019
1 parent 4428b71 commit db0f4e9
Show file tree
Hide file tree
Showing 3 changed files with 26 additions and 22 deletions.
6 changes: 3 additions & 3 deletions generator/sbpg/targets/haskell.py
View file
Original file line number Diff line number Diff line change
Expand Up @@ -209,16 +209,16 @@ def render_sbp(output_dir, package_specs):
modules.append(full_module_name)
for m in package_spec.definitions:
if m.static and m.sbp_id:
msgs.append(to_data(m.identifier))
msgs.append(m)
destination_filename = "%s/src/SwiftNav/SBP.hs" % output_dir
py_template = JENV.get_template(SBP_TEMPLATE_NAME)
with open(destination_filename, 'w') as f:
f.write(py_template.render(modules=sorted(modules),
pkgs=package_specs,
msgs=sorted(msgs)))
msgs=sorted(msgs, key=lambda m:to_data(m.identifier))))
destination_filename = "%s/src/SwiftNav/SBP/Msg.hs" % output_dir
py_template = JENV.get_template(MESSAGE_TEMPLATE_NAME)
with open(destination_filename, 'w') as f:
f.write(py_template.render(modules=sorted(modules),
pkgs=package_specs,
msgs=sorted(msgs)))
msgs=sorted(msgs, key=lambda m:to_data(m.identifier))))
18 changes: 11 additions & 7 deletions generator/sbpg/targets/resources/SbpMessageTemplate.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -36,9 +36,9 @@ import SwiftNav.SBP.Types
-- Includes SBPMsgUnknown for valid SBP messages with undefined message
-- types and SBPMsgBadCRC for SBP messages with invalid CRC checksums.
data SBPMsg =
SBP(((m))) (((m))) Msg
SBP(((m.identifier | hs_to_data))) (((m.identifier | hs_to_data))) Msg
((*- else *))
| SBP(((m))) (((m))) Msg
| SBP(((m.identifier | hs_to_data))) (((m.identifier | hs_to_data))) Msg
((*- endif *))
((*- if loop.last *))
| SBPMsgBadCrc Msg
Expand All @@ -57,15 +57,15 @@ instance Binary SBPMsg where
decoder m@Msg {..}
| checkCrc m /= _msgSBPCrc = SBPMsgBadCrc m
((*- for m in msgs *))
| _msgSBPType == (((m | hs_to_global))) = SBP(((m))) (decode (fromStrict (unBytes _msgSBPPayload))) m
| _msgSBPType == (((m.identifier | hs_to_global))) = SBP(((m.identifier | hs_to_data))) (decode (fromStrict (unBytes _msgSBPPayload))) m
((*- endfor *))
| otherwise = SBPMsgUnknown m

put sm = do
putWord8 msgSBPPreamble
encoder sm where
((*- for m in msgs *))
encoder (SBP(((m))) _ m) = put m
encoder (SBP(((m.identifier | hs_to_data))) _ m) = put m
((*- endfor *))
encoder (SBPMsgUnknown m) = put m
encoder (SBPMsgBadCrc m) = put m
Expand All @@ -77,7 +77,7 @@ instance FromJSON SBPMsg where
decoder msgType payload where
decoder msgType payload
((*- for m in msgs *))
| msgType == (((m | hs_to_global))) = SBP(((m))) <$> pure (decode (fromStrict (unBytes payload))) <*> parseJSON obj
| msgType == (((m.identifier | hs_to_global))) = SBP(((m.identifier | hs_to_data))) <$> pure (decode (fromStrict (unBytes payload))) <*> parseJSON obj
((*- endfor *))
| otherwise = SBPMsgUnknown <$> parseJSON obj
parseJSON _ = mzero
Expand All @@ -90,14 +90,18 @@ instance FromJSON SBPMsg where

instance ToJSON SBPMsg where
((*- for m in msgs *))
toJSON (SBP(((m))) n m) = toJSON n <<>> toJSON m
((*- if m.fields *))
toJSON (SBP(((m.identifier | hs_to_data))) n m) = toJSON n <<>> toJSON m
((*- else *))
toJSON (SBP(((m.identifier | hs_to_data))) _ m) = toJSON m
((*- endif *))
((*- endfor *))
toJSON (SBPMsgBadCrc m) = toJSON m
toJSON (SBPMsgUnknown m) = toJSON m

instance HasMsg SBPMsg where
((*- for m in msgs *))
msg f (SBP(((m))) n m) = SBP(((m))) n <$> f m
msg f (SBP(((m.identifier | hs_to_data))) n m) = SBP(((m.identifier | hs_to_data))) n <$> f m
((*- endfor *))
msg f (SBPMsgUnknown m) = SBPMsgUnknown <$> f m
msg f (SBPMsgBadCrc m) = SBPMsgBadCrc <$> f m
24 changes: 12 additions & 12 deletions haskell/src/SwiftNav/SBP/Msg.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -766,7 +766,7 @@ instance ToJSON SBPMsg where
toJSON (SBPMsgAcqSvProfile n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgAcqSvProfileDep n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgAgeCorrections n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgAlmanac n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgAlmanac _ m) = toJSON m
toJSON (SBPMsgAlmanacGlo n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgAlmanacGloDep n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgAlmanacGps n m) = toJSON n <<>> toJSON m
Expand All @@ -781,7 +781,7 @@ instance ToJSON SBPMsg where
toJSON (SBPMsgBaselineNed n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgBaselineNedDepA n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgBootloaderHandshakeDepA n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgBootloaderHandshakeReq n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgBootloaderHandshakeReq _ m) = toJSON m
toJSON (SBPMsgBootloaderHandshakeResp n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgBootloaderJumpToApp n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgCellModemStatus n m) = toJSON n <<>> toJSON m
Expand All @@ -790,8 +790,8 @@ instance ToJSON SBPMsg where
toJSON (SBPMsgCommandResp n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgCsacTelemetry n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgCsacTelemetryLabels n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgCwResults n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgCwStart n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgCwResults _ m) = toJSON m
toJSON (SBPMsgCwStart _ m) = toJSON m
toJSON (SBPMsgDeviceMonitor n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgDgnssStatus n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgDops n m) = toJSON n <<>> toJSON m
Expand Down Expand Up @@ -841,7 +841,7 @@ instance ToJSON SBPMsg where
toJSON (SBPMsgIarState n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgImuAux n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgImuRaw n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgInitBase n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgInitBase _ m) = toJSON m
toJSON (SBPMsgInsStatus n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgIono n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgLinuxCpuState n m) = toJSON n <<>> toJSON m
Expand All @@ -858,11 +858,11 @@ instance ToJSON SBPMsg where
toJSON (SBPMsgMaskSatellite n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgMaskSatelliteDep n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgMeasurementState n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgNapDeviceDnaReq n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgNapDeviceDnaReq _ m) = toJSON m
toJSON (SBPMsgNapDeviceDnaResp n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgNdbEvent n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgNetworkBandwidthUsage n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgNetworkStateReq n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgNetworkStateReq _ m) = toJSON m
toJSON (SBPMsgNetworkStateResp n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgObs n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgObsDepA n m) = toJSON n <<>> toJSON m
Expand All @@ -879,18 +879,18 @@ instance ToJSON SBPMsg where
toJSON (SBPMsgPosLlhDepA n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgPrintDep n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgReset n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgResetDep n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgResetDep _ m) = toJSON m
toJSON (SBPMsgResetFilters n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgSbasRaw n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgSetTime n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgSettingsReadByIndexDone n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgSetTime _ m) = toJSON m
toJSON (SBPMsgSettingsReadByIndexDone _ m) = toJSON m
toJSON (SBPMsgSettingsReadByIndexReq n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgSettingsReadByIndexResp n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgSettingsReadReq n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgSettingsReadResp n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgSettingsRegister n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgSettingsRegisterResp n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgSettingsSave n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgSettingsSave _ m) = toJSON m
toJSON (SBPMsgSettingsWrite n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgSettingsWriteResp n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgSpecan n m) = toJSON n <<>> toJSON m
Expand All @@ -902,7 +902,7 @@ instance ToJSON SBPMsg where
toJSON (SBPMsgStartup n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgStmFlashLockSector n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgStmFlashUnlockSector n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgStmUniqueIdReq n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgStmUniqueIdReq _ m) = toJSON m
toJSON (SBPMsgStmUniqueIdResp n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgSvAzEl n m) = toJSON n <<>> toJSON m
toJSON (SBPMsgSvConfigurationGpsDep n m) = toJSON n <<>> toJSON m
Expand Down

0 comments on commit db0f4e9

Please sign in to comment.