Skip to content

[ESD-1238] Do not call nullary constructors in Haskell ToJSON #680

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 3 commits into from
Apr 15, 2019
Merged

[ESD-1238] Do not call nullary constructors in Haskell ToJSON #680

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
ac39872
Do not call nullary constructors in Haskell ToJSON
pmiettinen Apr 12, 2019
69add64
Add lambda for sorting
pmiettinen Apr 12, 2019
2907e1e
Regenerate Msg.hs
pmiettinen Apr 12, 2019
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 3 additions & 3 deletions generator/sbpg/targets/haskell.py
View file
Open in desktop
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
Open in desktop
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
Open in desktop
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