ogma-core-1.10.0/0000755000000000000000000000000015064246145011637 5ustar0000000000000000ogma-core-1.10.0/ogma-core.cabal0000644000000000000000000001544315064246145014503 0ustar0000000000000000-- Copyright 2020 United States Government as represented by the Administrator -- of the National Aeronautics and Space Administration. All Rights Reserved. -- -- Disclaimers -- -- Licensed under the Apache License, Version 2.0 (the "License"); you may -- not use this file except in compliance with the License. You may obtain a -- copy of the License at -- -- https://www.apache.org/licenses/LICENSE-2.0 -- -- Unless required by applicable law or agreed to in writing, software -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the -- License for the specific language governing permissions and limitations -- under the License. cabal-version: 2.0 build-type: Simple name: ogma-core version: 1.10.0 homepage: https://github.com/nasa/ogma bug-reports: https://github.com/nasa/ogma/issues license: Apache-2.0 license-file: LICENSE author: Ivan Perez, Alwyn Goodloe maintainer: ivan.perezdominguez@nasa.gov category: Aerospace extra-source-files: CHANGELOG.md tests/commands-fcs-error-parsing-failed-1.json tests/commands-fcs-error-parsing-failed-2.json tests/commands-fcs-error-parsing-failed-3.json tests/fcs_good.json tests/fdb-example1.json tests/reduced_geofence_msgs_bad.h tests/reduced_geofence_msgs.h synopsis: Ogma: Helper tool to interoperate between Copilot and other languages. description: Ogma is a tool to facilitate the integration of safe runtime monitors into other systems. Ogma extends , a high-level runtime verification framework that generates hard real-time C99 code. . This package implements the internal commands of ogma. data-files: templates/copilot-cfs/CMakeLists.txt templates/copilot-cfs/fsw/for_build/Makefile templates/copilot-cfs/fsw/mission_inc/copilot_cfs_perfids.h templates/copilot-cfs/fsw/platform_inc/copilot_cfs_msgids.h templates/copilot-cfs/fsw/src/Properties.hs templates/copilot-cfs/fsw/src/copilot_cfs_msg.h templates/copilot-cfs/fsw/src/copilot_cfs.c templates/copilot-cfs/fsw/src/copilot_cfs_version.h templates/copilot-cfs/fsw/src/copilot_cfs.h templates/copilot-cfs/fsw/src/copilot_cfs_events.h templates/ros/Dockerfile templates/ros/screenrc templates/ros/copilot/CMakeLists.txt templates/ros/copilot/src/copilot_logger.cpp templates/ros/copilot/src/copilot_monitor.cpp templates/ros/copilot/src/Copilot.hs templates/ros/copilot/package.xml templates/ros/test_requirements/CMakeLists.txt templates/ros/test_requirements/src/test_requirements.cpp templates/ros/test_requirements/package.xml templates/diagram/Copilot.hs templates/fprime/CMakeLists.txt templates/fprime/Copilot.cpp templates/fprime/Copilot.fpp templates/fprime/Copilot.hpp templates/fprime/Dockerfile templates/fprime/instance-copilot templates/standalone/Copilot.hs data/formats/fcs_smv data/formats/fcs_lustre data/formats/fdb_smv data/formats/fdb_lustre data/formats/xml-md_lustre data/formats/xml-md_smv data/formats/xml-reqif_lustre data/formats/xml-reqif_smv data/variable-db.json -- Ogma packages should be uncurated so that only the official maintainers make -- changes. -- -- Because this is a NASA project, we want to make sure that users obtain -- exactly what we publish, unmodified by anyone external to our project. x-curation: uncurated source-repository head type: git location: git@github.com:nasa/ogma.git subdir: ogma-core library exposed-modules: Command.CFSApp Command.CStructs2Copilot Command.CStructs2MsgHandlers Command.Diagram Command.FPrimeApp Command.Overview Command.Result Command.ROSApp Command.Standalone Data.Location Language.Trans.CStruct2CopilotStruct Language.Trans.CStructs2Copilot Language.Trans.CStructs2MsgHandlers Language.Trans.Lustre2Copilot Language.Trans.Spec2Copilot Language.Trans.SMV2Copilot other-modules: Paths_ogma_core Command.Common Command.Errors Command.VariableDB autogen-modules: Paths_ogma_core build-depends: base >= 4.11.0.0 && < 5 , aeson >= 2.0.0.0 && < 2.3 , bytestring >= 0.10.8.2 && < 0.13 , containers >= 0.5 && < 0.8 , directory >= 1.3.1.5 && < 1.4 , filepath >= 1.4.2 && < 1.6 , graphviz >= 2999.20 && < 2999.21 , megaparsec >= 8.0.0 && < 9.10 , mtl >= 2.2.2 && < 2.4 , process >= 1.6 && < 1.7 , text >= 1.2.3.1 && < 2.2 , ogma-extra >= 1.10.0 && < 1.11 , ogma-language-c >= 1.10.0 && < 1.11 , ogma-language-copilot >= 1.10.0 && < 1.11 , ogma-language-csv >= 1.10.0 && < 1.11 , ogma-language-jsonspec >= 1.10.0 && < 1.11 , ogma-language-lustre >= 1.10.0 && < 1.11 , ogma-language-smv >= 1.10.0 && < 1.11 , ogma-language-xlsx >= 1.10.0 && < 1.11 , ogma-language-xmlspec >= 1.10.0 && < 1.11 , ogma-spec >= 1.10.0 && < 1.11 hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall test-suite unit-tests type: exitcode-stdio-1.0 main-is: Main.hs build-depends: base >= 4.11.0.0 && < 5 , directory >= 1.3.1.5 && < 1.4 , HUnit >= 1.2.0.0 && < 1.7 , QuickCheck >= 2.8.2 && < 2.16 , test-framework >= 0.8.2 && < 0.9 , test-framework-hunit >= 0.2.0 && < 0.4 , test-framework-quickcheck2 >= 0.3.0.4 && < 0.4 , ogma-core hs-source-dirs: tests default-language: Haskell2010 ghc-options: -Wall ogma-core-1.10.0/LICENSE0000644000000000000000000002613715064246145012655 0ustar0000000000000000 Apache License Version 2.0, January 2004 http://www.apache.org/licenses/ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 1. Definitions. "License" shall mean the terms and conditions for use, reproduction, and distribution as defined by Sections 1 through 9 of this document. "Licensor" shall mean the copyright owner or entity authorized by the copyright owner that is granting the License. "Legal Entity" shall mean the union of the acting entity and all other entities that control, are controlled by, or are under common control with that entity. For the purposes of this definition, "control" means (i) the power, direct or indirect, to cause the direction or management of such entity, whether by contract or otherwise, or (ii) ownership of fifty percent (50%) or more of the outstanding shares, or (iii) beneficial ownership of such entity. "You" (or "Your") shall mean an individual or Legal Entity exercising permissions granted by this License. "Source" form shall mean the preferred form for making modifications, including but not limited to software source code, documentation source, and configuration files. "Object" form shall mean any form resulting from mechanical transformation or translation of a Source form, including but not limited to compiled object code, generated documentation, and conversions to other media types. "Work" shall mean the work of authorship, whether in Source or Object form, made available under the License, as indicated by a copyright notice that is included in or attached to the work (an example is provided in the Appendix below). "Derivative Works" shall mean any work, whether in Source or Object form, that is based on (or derived from) the Work and for which the editorial revisions, annotations, elaborations, or other modifications represent, as a whole, an original work of authorship. For the purposes of this License, Derivative Works shall not include works that remain separable from, or merely link (or bind by name) to the interfaces of, the Work and Derivative Works thereof. "Contribution" shall mean any work of authorship, including the original version of the Work and any modifications or additions to that Work or Derivative Works thereof, that is intentionally submitted to Licensor for inclusion in the Work by the copyright owner or by an individual or Legal Entity authorized to submit on behalf of the copyright owner. For the purposes of this definition, "submitted" means any form of electronic, verbal, or written communication sent to the Licensor or its representatives, including but not limited to communication on electronic mailing lists, source code control systems, and issue tracking systems that are managed by, or on behalf of, the Licensor for the purpose of discussing and improving the Work, but excluding communication that is conspicuously marked or otherwise designated in writing by the copyright owner as "Not a Contribution." "Contributor" shall mean Licensor and any individual or Legal Entity on behalf of whom a Contribution has been received by Licensor and subsequently incorporated within the Work. 2. Grant of Copyright License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable copyright license to reproduce, prepare Derivative Works of, publicly display, publicly perform, sublicense, and distribute the Work and such Derivative Works in Source or Object form. 3. Grant of Patent License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except as stated in this section) patent license to make, have made, use, offer to sell, sell, import, and otherwise transfer the Work, where such license applies only to those patent claims licensable by such Contributor that are necessarily infringed by their Contribution(s) alone or by combination of their Contribution(s) with the Work to which such Contribution(s) was submitted. If You institute patent litigation against any entity (including a cross-claim or counterclaim in a lawsuit) alleging that the Work or a Contribution incorporated within the Work constitutes direct or contributory patent infringement, then any patent licenses granted to You under this License for that Work shall terminate as of the date such litigation is filed. 4. Redistribution. You may reproduce and distribute copies of the Work or Derivative Works thereof in any medium, with or without modifications, and in Source or Object form, provided that You meet the following conditions: (a) You must give any other recipients of the Work or Derivative Works a copy of this License; and (b) You must cause any modified files to carry prominent notices stating that You changed the files; and (c) You must retain, in the Source form of any Derivative Works that You distribute, all copyright, patent, trademark, and attribution notices from the Source form of the Work, excluding those notices that do not pertain to any part of the Derivative Works; and (d) If the Work includes a "NOTICE" text file as part of its distribution, then any Derivative Works that You distribute must include a readable copy of the attribution notices contained within such NOTICE file, excluding those notices that do not pertain to any part of the Derivative Works, in at least one of the following places: within a NOTICE text file distributed as part of the Derivative Works; within the Source form or documentation, if provided along with the Derivative Works; or, within a display generated by the Derivative Works, if and wherever such third-party notices normally appear. The contents of the NOTICE file are for informational purposes only and do not modify the License. You may add Your own attribution notices within Derivative Works that You distribute, alongside or as an addendum to the NOTICE text from the Work, provided that such additional attribution notices cannot be construed as modifying the License. You may add Your own copyright statement to Your modifications and may provide additional or different license terms and conditions for use, reproduction, or distribution of Your modifications, or for any such Derivative Works as a whole, provided Your use, reproduction, and distribution of the Work otherwise complies with the conditions stated in this License. 5. Submission of Contributions. Unless You explicitly state otherwise, any Contribution intentionally submitted for inclusion in the Work by You to the Licensor shall be under the terms and conditions of this License, without any additional terms or conditions. Notwithstanding the above, nothing herein shall supersede or modify the terms of any separate license agreement you may have executed with Licensor regarding such Contributions. 6. Trademarks. This License does not grant permission to use the trade names, trademarks, service marks, or product names of the Licensor, except as required for reasonable and customary use in describing the origin of the Work and reproducing the content of the NOTICE file. 7. Disclaimer of Warranty. Unless required by applicable law or agreed to in writing, Licensor provides the Work (and each Contributor provides its Contributions) on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied, including, without limitation, any warranties or conditions of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A PARTICULAR PURPOSE. You are solely responsible for determining the appropriateness of using or redistributing the Work and assume any risks associated with Your exercise of permissions under this License. 8. Limitation of Liability. In no event and under no legal theory, whether in tort (including negligence), contract, or otherwise, unless required by applicable law (such as deliberate and grossly negligent acts) or agreed to in writing, shall any Contributor be liable to You for damages, including any direct, indirect, special, incidental, or consequential damages of any character arising as a result of this License or out of the use or inability to use the Work (including but not limited to damages for loss of goodwill, work stoppage, computer failure or malfunction, or any and all other commercial damages or losses), even if such Contributor has been advised of the possibility of such damages. 9. Accepting Warranty or Additional Liability. While redistributing the Work or Derivative Works thereof, You may choose to offer, and charge a fee for, acceptance of support, warranty, indemnity, or other liability obligations and/or rights consistent with this License. However, in accepting such obligations, You may act only on Your own behalf and on Your sole responsibility, not on behalf of any other Contributor, and only if You agree to indemnify, defend, and hold each Contributor harmless for any liability incurred by, or claims asserted against, such Contributor by reason of your accepting any such warranty or additional liability. END OF TERMS AND CONDITIONS APPENDIX: How to apply the Apache License to your work. To apply the Apache License to your work, attach the following boilerplate notice, with the fields enclosed by brackets "[]" replaced with your own identifying information. (Don't include the brackets!) The text should be enclosed in the appropriate comment syntax for the file format. We also recommend that a file or class name and description of purpose be included on the same "printed page" as the copyright notice for easier identification within third-party archives. Copyright [yyyy] [name of copyright owner] Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at https://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. ogma-core-1.10.0/CHANGELOG.md0000644000000000000000000001350415064246145013453 0ustar0000000000000000# Revision history for ogma-core ## [1.10.0] - 2025-09-21 * Version bump 1.10.0 (#310). * Add to ROS 2 template handling methods for triggers with no args (#287). * Install packages locally in ROS 2 dockerfile (#288). * Fix handling of message fields in cFS template (#296). * Avoid unnecessary recompilation of generated cFS app (#299). * Remove tabs from cFS template code (#294). * Fix duplicate linkage of Copilot code in generated cFS app (#297). * Use alternate name for Copilot's step function in cFS template (#303). * Replace NOSA license with Apache license (#293). ## [1.9.0] - 2025-08-06 * Version bump 1.9.0 (#284). * Extend ROS backend to generate testing package (#280). ## [1.8.0] - 2025-07-13 * Version bump 1.8.0 (#275). * Introduce overview command (#272). * Extend code backends to accept expressions to monitor as arguments (#121). ## [1.7.0] - 2025-03-21 * Version bump 1.7.0 (#268). * Import liftIO from Control.Monad.IO.Class (#215). * Remove references to old design of Ogma from hlint files (#220). * Bump upper version constraint on aeson, text (#225). * Remove extraneous EOL character (#224). * Make structured data available to cFS template (#229). * Update Copilot struct code generator to use new function names (#231). * Simplify Copilot struct definitions by using generics (#199). * Update cFS backend to process a handlers file (#234). * Update cFS backend to process a template variables file (#106). * Remove dependency on ICAROUS from generated cFS applications (#237). * Remove incorrect function declaration from template (#240). * Re-structure cFS backend to avoid nested conditions (#242). * Make structured data available to ROS template (#244). * Make structured data available to FPrime template (#246). * Equalize backends (#248). * Update ROS, FPrime, standalone backends to process template vars file (#250). * Make cFS backend accept spec as input (#252). * Make cFS, ROS, FPrime backends generate Copilot monitor (#107). * Standardize variable DB format across backends (#256). * Make backends accept additional data to be passed to handlers (#219). * Add support to read properties from CSV files (#261). * Add support to read properties from XLSX files (#263). * Add all auxiliary test files to distributable Cabal package (#258). * Update to support boolean expressions in the Lustre language (#267). ## [1.6.0] - 2025-01-21 * Version bump 1.6.0 (#208). * Replace queueSize with QUEUE_SIZE in FPP file (#186). * Use template expansion system to generate F' monitoring component (#185). * Use template expansion system to generate standalone Copilot monitor (#189). * Add repository information to cabal package (#148). * Add version bounds to all dependencies (#119). * Add command to transform state diagrams into monitors (#194). * Extend standalone command to use external process to parse properties (#197). * Enable using user-provided file as format definition spec (#200). * Add support for XML files to standalone backend (#202). * Extend support for file, property formats across backends (#204). * Add java runtime to Dockerfile generated by FPrime backend (#206). ## [1.5.0] - 2024-11-21 * Version bump 1.5.0 (#178). * Fix incorrect path when using Space ROS humble-2024.10.0 (#158). * Use template expansion system to generate cFS monitoring application (#157). * Use template expansion system to generate ROS monitoring application (#162). * Fix comment in generated Copilot spec (#164). * Add missing notPreviousNot to generated spec (#168). * Introduce new standalone command (#170). * Correct name in documentation (#176). ## [1.4.1] - 2024-09-21 * Version bump 1.4.1 (#155). * Remove dependency on IfElse (#150). * Replace homepage (#147). ## [1.4.0] - 2024-05-21 * Version bump 1.4.0 (#145). * Make ros command generate dockerfile (#136). * Map float and double to the same types in C++ (#138). ## [1.3.0] - 2024-03-21 * Version bump 1.3.0 (#133). * Fix missing stream name substitution (#120). * Use generalized JSON parser for DB Spec (#122). * Fix translation of equivalence boolean operator from SMV (#126). * Sanitize handler names (#127). * Use same handler name in FPrime/ROS and Copilot (#130). ## [1.2.0] - 2024-01-21 * Version bump 1.2.0 (#117). * Generalize JSON parser (#115). ## [1.1.0] - 2023-11-21 * Version bump 1.1.0 (#112). * Remove trailing spaces from cFS app template (#108). * Replace all mentions of the Sample App (#105). ## [1.0.11] - 2023-09-21 * Version bump 1.0.11 (#103). * Support MTL operators with number ranges in SMV (#101). ## [1.0.10] - 2023-07-21 * Version bump 1.0.10 (#98). * Correct test case (#96). ## [1.0.9] - 2023-05-21 * Version bump 1.0.9 (#93). * Allow customizing the names of the C files generated by Copilot (#80). * Translate ZtoPre and YtoPre to Copilot (#86). ## [1.0.8] - 2023-03-21 * Version bump 1.0.8 (#81). * Support inequality operator in SMV and CoCoSpec (#71). * Introduce new F' (FPrime) backend (#77). * Mark package as uncurated (#74). ## [1.0.7] - 2023-01-21 * Version bump 1.0.7 (#69). * Introduce new ROS2 backend (#56). ## [1.0.6] - 2022-11-21 * Version bump 1.0.6 (#64). * Update license in cabal file to OtherLicense (#62). ## [1.0.5] - 2022-09-21 * Version bump 1.0.5 (#60). * Bump version bounds of Aeson (#55). * Support floating point numbers in SMV expressions (#58). ## [1.0.4] - 2022-07-21 * Version bump 1.0.4 (#53). * Address all hlint suggestions (#51). ## [1.0.3] - 2022-05-21 * Version bump 1.0.3 (#49). * Conformance with style guide (partial) (#45). ## [1.0.2] - 2022-03-21 * Version bump 1.0.2 (#43). * Fix compilation error in unit tests (#42). * Remove reduntant parenthesis (#40). ## [1.0.1] - 2022-01-21 * Version bump 1.0.1 (#39). * Align definitions consistently (#35). * Indent ogma-core:Language.Trans.CStruct2CopilotStruct.buildCField (#36). * Indent ogma-core:Command.Result module declaration (#37). ## [1.0.0] - 2021-11-22 * Initial release. ogma-core-1.10.0/Setup.hs0000644000000000000000000000005615064246145013274 0ustar0000000000000000import Distribution.Simple main = defaultMain ogma-core-1.10.0/data/0000755000000000000000000000000015064246145012550 5ustar0000000000000000ogma-core-1.10.0/data/variable-db.json0000644000000000000000000000762615064246145015626 0ustar0000000000000000{ "inputs": [ ] , "topics": [ ] , "types": [ { "fromScope": "fprime/port" , "fromType": "U8" , "toScope": "C" , "toType": "uint8_t" } , { "fromScope": "fprime/port" , "fromType": "U16" , "toScope": "C" , "toType": "uint16_t" } , { "fromScope": "fprime/port" , "fromType": "U32" , "toScope": "C" , "toType": "uint32_t" } , { "fromScope": "fprime/port" , "fromType": "U64" , "toScope": "C" , "toType": "uint64_t" } , { "fromScope": "fprime/port" , "fromType": "I8" , "toScope": "C" , "toType": "int8_t" } , { "fromScope": "fprime/port" , "fromType": "I16" , "toScope": "C" , "toType": "int16_t" } , { "fromScope": "fprime/port" , "fromType": "I32" , "toScope": "C" , "toType": "int32_t" } , { "fromScope": "fprime/port" , "fromType": "I64" , "toScope": "C" , "toType": "int64_t" } , { "fromScope": "fprime/port" , "fromType": "F32" , "toScope": "C" , "toType": "float" } , { "fromScope": "fprime/port" , "fromType": "F64" , "toScope": "C" , "toType": "double" } , { "fromScope": "ros/variable" , "fromType": "std::uint8_t" , "toScope": "C" , "toType": "uint8_t" } , { "fromScope": "ros/variable" , "fromType": "std::uint16_t" , "toScope": "C" , "toType": "uint16_t" } , { "fromScope": "ros/variable" , "fromType": "std::uint32_t" , "toScope": "C" , "toType": "uint32_t" } , { "fromScope": "ros/variable" , "fromType": "std::uint64_t" , "toScope": "C" , "toType": "uint64_t" } , { "fromScope": "ros/variable" , "fromType": "std::int8_t" , "toScope": "C" , "toType": "int8_t" } , { "fromScope": "ros/variable" , "fromType": "std::int16_t" , "toScope": "C" , "toType": "int16_t" } , { "fromScope": "ros/variable" , "fromType": "std::int32_t" , "toScope": "C" , "toType": "int32_t" } , { "fromScope": "ros/variable" , "fromType": "std::int64_t" , "toScope": "C" , "toType": "int64_t" } , { "fromScope": "ros/message" , "fromType": "std_msgs::msg::Bool" , "toScope": "C" , "toType": "bool" } , { "fromScope": "ros/message" , "fromType": "std_msgs::msg::UInt8" , "toScope": "C" , "toType": "uint8_t" } , { "fromScope": "ros/message" , "fromType": "std_msgs::msg::UInt16" , "toScope": "C" , "toType": "uint16_t" } , { "fromScope": "ros/message" , "fromType": "std_msgs::msg::UInt32" , "toScope": "C" , "toType": "uint32_t" } , { "fromScope": "ros/message" , "fromType": "std_msgs::msg::UInt64" , "toScope": "C" , "toType": "uint64_t" } , { "fromScope": "ros/message" , "fromType": "std_msgs::msg::Int8" , "toScope": "C" , "toType": "int8_t" } , { "fromScope": "ros/message" , "fromType": "std_msgs::msg::Int16" , "toScope": "C" , "toType": "int16_t" } , { "fromScope": "ros/message" , "fromType": "std_msgs::msg::Int32" , "toScope": "C" , "toType": "int32_t" } , { "fromScope": "ros/message" , "fromType": "std_msgs::msg::Int64" , "toScope": "C" , "toType": "int64_t" } , { "fromScope": "ros/message" , "fromType": "std_msgs::msg::Float32" , "toScope": "C" , "toType": "float" } , { "fromScope": "ros/message" , "fromType": "std_msgs::msg::Float64" , "toScope": "C" , "toType": "double" } ] } ogma-core-1.10.0/data/formats/0000755000000000000000000000000015064246145014223 5ustar0000000000000000ogma-core-1.10.0/data/formats/xml-md_smv0000644000000000000000000000136115064246145016232 0ustar0000000000000000XMLFormat { XML.specInternalVars = Nothing , XML.specInternalVarId = ("//*", Nothing) , XML.specInternalVarExpr = ("//*", Nothing) , XML.specInternalVarType = Nothing , XML.specExternalVars = Nothing , XML.specExternalVarId = ("//*", Nothing) , XML.specExternalVarType = Nothing , XML.specRequirements = ("//sysml:Requirement", Nothing) , XML.specRequirementId = ("//sysml:Requirement/@Id/text()", Nothing) , XML.specRequirementDesc = Just ("//sysml:Requirement/@Id/text()", Nothing) , XML.specRequirementExpr = ("//sysml:Requirement/@Text/text()", Nothing) , XML.specRequirementResultType = Nothing , XML.specRequirementResultExpr = Nothing } ogma-core-1.10.0/data/formats/xml-reqif_lustre0000644000000000000000000000231515064246145017451 0ustar0000000000000000XMLFormat { specInternalVars = Nothing , specInternalVarId = ("//*", Nothing) , specInternalVarExpr = ("//*", Nothing) , specInternalVarType = Nothing , specExternalVars = Nothing , specExternalVarId = ("//*", Nothing) , specExternalVarType = Nothing , specRequirements = ("//SPEC-OBJECTS/SPEC-OBJECT/TYPE/SPEC-OBJECT-TYPE-REF[contains(text(),\"KEY\")]/../..", Just ("KEY", "//SPEC-OBJECT-TYPE[contains(@LONG-NAME, \"Requirement\")]/@IDENTIFIER/text()")) , specRequirementId = ("//SPEC-OBJECT/@IDENTIFIER/text()", Nothing) , specRequirementDesc = Just ("//ATTRIBUTE-VALUE-XHTML/DEFINITION/ATTRIBUTE-DEFINITION-XHTML-REF[contains(text(),'KEY')]/../../THE-VALUE/div/*", Just ("KEY", "//ATTRIBUTE-DEFINITION-XHTML[contains(@LONG-NAME, \"ReqIF.Name\")]/@IDENTIFIER/text()")) , specRequirementExpr = ("//ATTRIBUTE-VALUE-XHTML/DEFINITION/ATTRIBUTE-DEFINITION-XHTML-REF[contains(text(),'KEY')]/../../THE-VALUE/div/*", Just ("KEY", "//ATTRIBUTE-DEFINITION-XHTML[contains(@LONG-NAME, \"ReqIF.Text\")]/@IDENTIFIER/text()")) , specRequirementResultType = Nothing , specRequirementResultExpr = Nothing } ogma-core-1.10.0/data/formats/xml-reqif_smv0000644000000000000000000000231515064246145016740 0ustar0000000000000000XMLFormat { specInternalVars = Nothing , specInternalVarId = ("//*", Nothing) , specInternalVarExpr = ("//*", Nothing) , specInternalVarType = Nothing , specExternalVars = Nothing , specExternalVarId = ("//*", Nothing) , specExternalVarType = Nothing , specRequirements = ("//SPEC-OBJECTS/SPEC-OBJECT/TYPE/SPEC-OBJECT-TYPE-REF[contains(text(),\"KEY\")]/../..", Just ("KEY", "//SPEC-OBJECT-TYPE[contains(@LONG-NAME, \"Requirement\")]/@IDENTIFIER/text()")) , specRequirementId = ("//SPEC-OBJECT/@IDENTIFIER/text()", Nothing) , specRequirementDesc = Just ("//ATTRIBUTE-VALUE-XHTML/DEFINITION/ATTRIBUTE-DEFINITION-XHTML-REF[contains(text(),'KEY')]/../../THE-VALUE/div/*", Just ("KEY", "//ATTRIBUTE-DEFINITION-XHTML[contains(@LONG-NAME, \"ReqIF.Name\")]/@IDENTIFIER/text()")) , specRequirementExpr = ("//ATTRIBUTE-VALUE-XHTML/DEFINITION/ATTRIBUTE-DEFINITION-XHTML-REF[contains(text(),'KEY')]/../../THE-VALUE/div/*", Just ("KEY", "//ATTRIBUTE-DEFINITION-XHTML[contains(@LONG-NAME, \"ReqIF.Text\")]/@IDENTIFIER/text()")) , specRequirementResultType = Nothing , specRequirementResultExpr = Nothing } ogma-core-1.10.0/data/formats/fdb_smv0000644000000000000000000000107215064246145015566 0ustar0000000000000000JSONFormat { specInternalVars = Nothing , specInternalVarId = "" , specInternalVarExpr = "" , specInternalVarType = Nothing , specExternalVars = Just ".semantics.variables..*.*" , specExternalVarId = "" , specExternalVarType = Nothing , specRequirements = "$[:]" , specRequirementId = ".reqid" , specRequirementDesc = Just ".fulltext" , specRequirementExpr = ".semantics.ptExpanded" , specRequirementResultType = Nothing , specRequirementResultExpr = Nothing } ogma-core-1.10.0/data/formats/xml-md_lustre0000644000000000000000000000136115064246145016743 0ustar0000000000000000XMLFormat { XML.specInternalVars = Nothing , XML.specInternalVarId = ("//*", Nothing) , XML.specInternalVarExpr = ("//*", Nothing) , XML.specInternalVarType = Nothing , XML.specExternalVars = Nothing , XML.specExternalVarId = ("//*", Nothing) , XML.specExternalVarType = Nothing , XML.specRequirements = ("//sysml:Requirement", Nothing) , XML.specRequirementId = ("//sysml:Requirement/@Id/text()", Nothing) , XML.specRequirementDesc = Just ("//sysml:Requirement/@Id/text()", Nothing) , XML.specRequirementExpr = ("//sysml:Requirement/@Text/text()", Nothing) , XML.specRequirementResultType = Nothing , XML.specRequirementResultExpr = Nothing } ogma-core-1.10.0/data/formats/fcs_smv0000644000000000000000000000115615064246145015611 0ustar0000000000000000JSONFormat { specInternalVars = Just "..Internal_variables[*]" , specInternalVarId = ".name" , specInternalVarExpr = ".assignmentCopilot" , specInternalVarType = Just ".type" , specExternalVars = Just "..Other_variables[*]" , specExternalVarId = ".name" , specExternalVarType = Just ".type" , specRequirements = "..Requirements[*]" , specRequirementId = ".name" , specRequirementDesc = Just ".fretish" , specRequirementExpr = ".ptLTL" , specRequirementResultType = Nothing , specRequirementResultExpr = Nothing } ogma-core-1.10.0/data/formats/fdb_lustre0000644000000000000000000000107415064246145016301 0ustar0000000000000000JSONFormat { specInternalVars = Nothing , specInternalVarId = "" , specInternalVarExpr = "" , specInternalVarType = Nothing , specExternalVars = Just ".semantics.variables..*.*" , specExternalVarId = "" , specExternalVarType = Nothing , specRequirements = "$[:]" , specRequirementId = ".reqid" , specRequirementDesc = Just ".fulltext" , specRequirementExpr = ".semantics.CoCoSpecCode" , specRequirementResultType = Nothing , specRequirementResultExpr = Nothing } ogma-core-1.10.0/data/formats/fcs_lustre0000644000000000000000000000116515064246145016322 0ustar0000000000000000JSONFormat { specInternalVars = Just "..Internal_variables[*]" , specInternalVarId = ".name" , specInternalVarExpr = ".assignmentCopilot" , specInternalVarType = Just ".type" , specExternalVars = Just "..Other_variables[*]" , specExternalVarId = ".name" , specExternalVarType = Just ".type" , specRequirements = "..Requirements[*]" , specRequirementId = ".name" , specRequirementDesc = Just ".fretish" , specRequirementExpr = ".CoCoSpecCode" , specRequirementResultType = Nothing , specRequirementResultExpr = Nothing } ogma-core-1.10.0/templates/0000755000000000000000000000000015064246145013635 5ustar0000000000000000ogma-core-1.10.0/templates/ros/0000755000000000000000000000000015064246145014440 5ustar0000000000000000ogma-core-1.10.0/templates/ros/screenrc0000644000000000000000000000150715064246145016172 0ustar0000000000000000deflogin off startup_message off chdir /demo screen -t "Copilot RV" bash -c 'bash --init-file <(echo "source /home/spaceros-user/spaceros/install/setup.bash; set -x; ros2 run copilot copilot")' {{#testingApps}} split focus screen -t "{{nodeName}}" bash -c 'bash --init-file <(echo "source /home/spaceros-user/spaceros/install/setup.bash; set -x; ros2 run {{nodePackage}} {{nodeName}}")' {{/testingApps}} split focus screen -t "Requirements testing" bash -c 'sleep 2; bash --init-file <( echo "source /home/spaceros-user/spaceros/install/setup.bash; set -x; ros2 run test_requirements test_requirements")' split focus screen -t "" bash -c 'bash --init-file <(echo "echo This is an interactive shell. Send data to topics with ros2 topic pub \ \; source /home/spaceros-user/spaceros/install/setup.bash")' ogma-core-1.10.0/templates/ros/Dockerfile0000644000000000000000000000127715064246145016441 0ustar0000000000000000FROM osrf/space-ros:humble-2024.10.0 ARG USER=spaceros-user ARG PACKAGE_PATH=/home/${USER}/monitors ARG ROS_PATH=/home/${USER}/spaceros/ RUN mkdir -p ${PACKAGE_PATH}/src/ ADD copilot ${PACKAGE_PATH}/src/copilot ADD test_requirements ${PACKAGE_PATH}/src/test_requirements USER root RUN chown -R ${USER} ${PACKAGE_PATH} USER ${USER} SHELL ["/bin/bash", "-c"] WORKDIR ${PACKAGE_PATH} RUN source /opt/spaceros/install/setup.bash && \ colcon build --packages-select copilot && \ colcon build --packages-select test_requirements ADD screenrc /home/spaceros-user/.screenrc USER root ADD screenrc /root/.screenrc RUN chown -R spaceros-user /home/spaceros-user/.screenrc USER spaceros-user ogma-core-1.10.0/templates/ros/copilot/0000755000000000000000000000000015064246145016111 5ustar0000000000000000ogma-core-1.10.0/templates/ros/copilot/CMakeLists.txt0000644000000000000000000000136415064246145020655 0ustar0000000000000000cmake_minimum_required(VERSION 3.8) project(copilot) if(CMAKE_COMPILER_IS_GNUCXX OR CMAKE_CXX_COMPILER_ID MATCHES "Clang") add_compile_options(-Wall -Wextra -Wpedantic) endif() # find dependencies find_package(ament_cmake REQUIRED) find_package(rclcpp REQUIRED) find_package(std_msgs REQUIRED) add_executable(copilot src/copilot_monitor.cpp) ament_target_dependencies(copilot rclcpp std_msgs) # Uncomment to enable compiling the copilot logger # add_executable(copilot_logger src/copilot_logger.cpp) # ament_target_dependencies(copilot_logger rclcpp std_msgs) install(TARGETS copilot DESTINATION lib/${PROJECT_NAME}) if(BUILD_TESTING) find_package(ament_lint_auto REQUIRED) ament_lint_auto_find_test_dependencies() endif() ament_package() ogma-core-1.10.0/templates/ros/copilot/package.xml0000644000000000000000000000120515064246145020224 0ustar0000000000000000 copilot 0.0.0 TODO: Package description root TODO: License declaration ament_cmake rclcpp std_msgs ament_lint_auto ament_lint_common ament_cmake ogma-core-1.10.0/templates/ros/copilot/src/0000755000000000000000000000000015064246145016700 5ustar0000000000000000ogma-core-1.10.0/templates/ros/copilot/src/Copilot.hs0000644000000000000000000000250515064246145020647 0ustar0000000000000000{{#copilot}} import Copilot.Compile.C99 import Copilot.Language hiding (prop) import Copilot.Language.Prelude import Copilot.Library.LTL (next) import Copilot.Library.MTL hiding (since, alwaysBeen, trigger) import Copilot.Library.PTLTL (since, previous, alwaysBeen) import qualified Copilot.Library.PTLTL as PTLTL import qualified Copilot.Library.MTL as MTL import Language.Copilot (reify) import Prelude hiding ((&&), (||), (++), (<=), (>=), (<), (>), (==), (/=), not) {{{copilot.externs}}} {{{copilot.internals}}} {{{copilot.reqs}}} -- | Clock that increases in one-unit steps. clock :: Stream Int64 clock = [0] ++ (clock + 1) -- | First Time Point ftp :: Stream Bool ftp = [True] ++ false pre :: Stream Bool -> Stream Bool pre = ([False] ++) tpre :: Stream Bool -> Stream Bool tpre = ([True] ++) notPreviousNot :: Stream Bool -> Stream Bool notPreviousNot = not . PTLTL.previous . not -- | Complete specification. Calls C handler functions when properties are -- violated. spec :: Spec spec = do {{{copilot.triggers}}} main :: IO () main = reify spec >>= compile "{{{copilot.specName}}}" {{/copilot}} {{^copilot}} -- No specification provided. Place your specification in this file. {{/copilot}} ogma-core-1.10.0/templates/ros/copilot/src/copilot_logger.cpp0000644000000000000000000000376215064246145022424 0ustar0000000000000000#include #include #include "rclcpp/rclcpp.hpp" #include "std_msgs/msg/bool.hpp" #include "std_msgs/msg/empty.hpp" #include "std_msgs/msg/u_int8.hpp" #include "std_msgs/msg/u_int16.hpp" #include "std_msgs/msg/u_int32.hpp" #include "std_msgs/msg/u_int64.hpp" #include "std_msgs/msg/int8.hpp" #include "std_msgs/msg/int16.hpp" #include "std_msgs/msg/int32.hpp" #include "std_msgs/msg/int64.hpp" #include "std_msgs/msg/float32.hpp" #include "std_msgs/msg/float64.hpp" #include "std_msgs/msg/empty.hpp" using std::placeholders::_1; class CopilotLogger : public rclcpp::Node { public: CopilotLogger() : Node("copilotlogger") { {{#monitors}} {{#monitorMsgType}} {{monitorName}}_subscription_ = this->create_subscription<{{.}}>( "copilot/{{monitorName}}", 10, std::bind(&CopilotLogger::{{monitorName}}_callback, this, _1)); {{/monitorMsgType}} {{^monitorMsgType}} {{monitorName}}_subscription_ = this->create_subscription( "copilot/{{monitorName}}", 10, std::bind(&CopilotLogger::{{monitorName}}_callback, this, _1)); {{/monitorMsgType}} {{/monitors}} } private: {{#monitors}} {{#monitorMsgType}} void {{monitorName}}_callback(const {{.}}::SharedPtr msg) const { RCLCPP_INFO(this->get_logger(), "Copilot monitor violation: {{monitorName}}"); } {{/monitorMsgType}} {{^monitorMsgType}} void {{monitorName}}_callback(const std_msgs::msg::Empty::SharedPtr msg) const { RCLCPP_INFO(this->get_logger(), "Copilot monitor violation: {{monitorName}}"); } {{/monitorMsgType}} {{/monitors}} {{#monitors}} {{#monitorMsgType}} rclcpp::Subscription<{{.}}>::SharedPtr {{monitorName}}_subscription_; {{/monitorMsgType}} {{^monitorMsgType}} rclcpp::Subscription::SharedPtr {{monitorName}}_subscription_; {{/monitorMsgType}} {{/monitors}} }; int main(int argc, char* argv[]) { rclcpp::init(argc, argv); rclcpp::spin(std::make_shared()); rclcpp::shutdown(); return 0; } ogma-core-1.10.0/templates/ros/copilot/src/copilot_monitor.cpp0000644000000000000000000000637515064246145022637 0ustar0000000000000000#include #include #include "rclcpp/rclcpp.hpp" #include "std_msgs/msg/bool.hpp" #include "std_msgs/msg/empty.hpp" #include "std_msgs/msg/u_int8.hpp" #include "std_msgs/msg/u_int16.hpp" #include "std_msgs/msg/u_int32.hpp" #include "std_msgs/msg/u_int64.hpp" #include "std_msgs/msg/int8.hpp" #include "std_msgs/msg/int16.hpp" #include "std_msgs/msg/int32.hpp" #include "std_msgs/msg/int64.hpp" #include "std_msgs/msg/float32.hpp" #include "std_msgs/msg/float64.hpp" #include {{#copilot}} #include "{{{copilot.specName}}}_types.h" #include "{{{copilot.specName}}}.h" #include "{{{copilot.specName}}}.c" {{/copilot}} using std::placeholders::_1; {{#variables}} {{varDeclType}} {{varDeclName}}; {{/variables}} class CopilotRV : public rclcpp::Node { public: CopilotRV() : Node("copilotrv") { {{#variables}} {{varDeclName}}_subscription_ = this->create_subscription<{{varDeclMsgType}}>( "{{varDeclId}}", 10, std::bind(&CopilotRV::{{varDeclName}}_callback, this, _1)); {{/variables}} {{#monitors}} {{#monitorMsgType}} {{monitorName}}_publisher_ = this->create_publisher<{{.}}>( "copilot/{{monitorName}}", 10); {{/monitorMsgType}} {{^monitorMsgType}} {{monitorName}}_publisher_ = this->create_publisher( "copilot/{{monitorName}}", 10); {{/monitorMsgType}} {{/monitors}} } {{#monitors}} {{#monitorType}} // Report (publish) monitor violations. void {{monitorName}}({{.}} arg) { {{#monitorMsgType}} auto output = {{.}}(); output.data = arg; {{/monitorMsgType}} {{^monitorMsgType}} auto output = std_msgs::msg::Empty(); {{/monitorMsgType}} {{monitorName}}_publisher_->publish(output); } {{/monitorType}} {{^monitorType}} // Report (publish) monitor violations. void {{monitorName}}() { auto output = std_msgs::msg::Empty(); {{monitorName}}_publisher_->publish(output); } {{/monitorType}} {{/monitors}} // Needed so we can report messages to the log. static CopilotRV& getInstance() { static CopilotRV instance; return instance; } private: {{#variables}} void {{varDeclName}}_callback(const {{varDeclMsgType}}::SharedPtr msg) const { {{varDeclName}} = msg->data; step(); } {{/variables}} {{#variables}} rclcpp::Subscription<{{varDeclMsgType}}>::SharedPtr {{varDeclName}}_subscription_; {{/variables}} {{#monitors}} {{#monitorMsgType}} rclcpp::Publisher<{{.}}>::SharedPtr {{monitorName}}_publisher_; {{/monitorMsgType}} {{^monitorMsgType}} rclcpp::Publisher::SharedPtr {{monitorName}}_publisher_; {{/monitorMsgType}} {{/monitors}} }; {{#monitors}} // Pass monitor violations to the actual class, which has ways to // communicate with other applications. {{#monitorType}} void {{monitorName}}({{.}} arg) { CopilotRV::getInstance().{{monitorName}}(arg); } {{/monitorType}} {{^monitorType}} void {{monitorName}}() { CopilotRV::getInstance().{{monitorName}}(); } {{/monitorType}} {{/monitors}} int main(int argc, char* argv[]) { rclcpp::init(argc, argv); rclcpp::spin(std::make_shared()); rclcpp::shutdown(); return 0; } ogma-core-1.10.0/templates/ros/test_requirements/0000755000000000000000000000000015064246145020222 5ustar0000000000000000ogma-core-1.10.0/templates/ros/test_requirements/CMakeLists.txt0000644000000000000000000000125415064246145022764 0ustar0000000000000000cmake_minimum_required(VERSION 3.8) project(test_requirements) if(CMAKE_COMPILER_IS_GNUCXX OR CMAKE_CXX_COMPILER_ID MATCHES "Clang") add_compile_options(-Wall -Wextra -Wpedantic) endif() # find dependencies find_package(ament_cmake REQUIRED) find_package(rclcpp REQUIRED) find_package(std_msgs REQUIRED) # Uncomment to enable compiling the requirement tests add_executable(test_requirements src/test_requirements.cpp) ament_target_dependencies(test_requirements rclcpp std_msgs) install(TARGETS test_requirements DESTINATION lib/${PROJECT_NAME}) if(BUILD_TESTING) find_package(ament_lint_auto REQUIRED) ament_lint_auto_find_test_dependencies() endif() ament_package() ogma-core-1.10.0/templates/ros/test_requirements/package.xml0000644000000000000000000000121715064246145022340 0ustar0000000000000000 test_requirements 0.0.0 TODO: Package description root TODO: License declaration ament_cmake rclcpp std_msgs ament_lint_auto ament_lint_common ament_cmake ogma-core-1.10.0/templates/ros/test_requirements/src/0000755000000000000000000000000015064246145021011 5ustar0000000000000000ogma-core-1.10.0/templates/ros/test_requirements/src/test_requirements.cpp0000644000000000000000000001254215064246145025303 0ustar0000000000000000#include #include #include "gtest/gtest.h" #include "rclcpp/rclcpp.hpp" #include "std_msgs/msg/bool.hpp" #include "std_msgs/msg/empty.hpp" #include "std_msgs/msg/u_int8.hpp" #include "std_msgs/msg/u_int16.hpp" #include "std_msgs/msg/u_int32.hpp" #include "std_msgs/msg/u_int64.hpp" #include "std_msgs/msg/int8.hpp" #include "std_msgs/msg/int16.hpp" #include "std_msgs/msg/int32.hpp" #include "std_msgs/msg/int64.hpp" #include "std_msgs/msg/float32.hpp" #include "std_msgs/msg/float64.hpp" #include using std::placeholders::_1; class RequirementsTest : public rclcpp::Node { public: RequirementsTest() : Node("requirementstest") { declare_parameter("testing_seed", 0); // defaults to 0 declare_parameter("testing_deadline", 2); // defaults to 2 secs {{#testingVariables}} {{varDeclName}}_publisher_ = this->create_publisher<{{varDeclMsgType}}>( "{{varDeclId}}", 10); {{/testingVariables}} {{#monitors}} {{monitorName}}_subscription_ = this->create_subscription( "copilot/{{monitorName}}", 10, std::bind(&RequirementsTest::{{monitorName}}_callback, this, _1)); {{/monitors}} get_parameter("testing_seed", initial_seed); get_parameter("testing_deadline", deadline); std::srand((unsigned int)this->initial_seed); this->seed = this->initial_seed; this->max_tests = calculate_num_tests(); rclcpp::Duration update_period = rclcpp::Duration::from_seconds(1); timerInit = rclcpp::create_timer(this->get_node_base_interface(), this->get_node_timers_interface(), this->get_node_clock_interface()->get_clock(), update_period, std::bind(&RequirementsTest::tests_init, this) ); } private: {{#monitors}} bool violation_{{monitorName}} = false; {{/monitors}} bool violations = false; {{#testingVariables}} rclcpp::Publisher<{{varDeclMsgType}}>::SharedPtr {{varDeclName}}_publisher_; {{/testingVariables}} {{#monitors}} void {{monitorName}}_callback(const std_msgs::msg::Empty::SharedPtr msg) { this->violation_{{monitorName}} = true; this->violations = true; } {{/monitors}} {{#monitors}} rclcpp::Subscription::SharedPtr {{monitorName}}_subscription_; {{/monitors}} int initial_seed; // To be configured using a parameter. int seed; // To be configured using a parameter. int deadline; // To be configured using a parameter. int max_tests; int num_test = 0; // Calculate the number of tests to be executed int calculate_num_tests() { return abs(std::rand()); } rclcpp::TimerBase::SharedPtr timerResult; rclcpp::TimerBase::SharedPtr timerInit; void tests_init () { timerInit->cancel(); tests_step_send(); } void tests_step_send () { {{#testingVariables}} {{varDeclType}} {{varDeclName}}_data = {{varDeclRandom}}(); auto {{varDeclName}}_data_msg = {{varDeclMsgType}}(); {{varDeclName}}_data_msg.data = {{varDeclName}}_data; {{varDeclName}}_publisher_->publish({{varDeclName}}_data_msg); {{/testingVariables}} rclcpp::Duration update_period = rclcpp::Duration::from_seconds(deadline); timerResult = rclcpp::create_timer(this->get_node_base_interface(), this->get_node_timers_interface(), this->get_node_clock_interface()->get_clock(), update_period, std::bind(&RequirementsTest::tests_step_result, this) ); } void tests_step_result () { timerResult->cancel(); {{#monitors}} if (this->violation_{{monitorName}}) { this->publish_violation("{{monitorName}}"); } {{/monitors}} this->num_test++; // Stop if out of steps or there have been violations if ((this->num_test >= this->max_tests) || violations) { // Terminate using the gtest mechanism to indicate the result if (violations) { RCLCPP_INFO(this->get_logger(), "Tests failed"); // FAIL(); } else { RCLCPP_INFO(this->get_logger(), "Tests succeeded"); // SUCCEED(); } rclcpp::shutdown(); } else { tests_step_send(); } } float randomFloat() { int numerator = rand(); int denominator = rand(); // Ensure that we do not divide by zero. if (denominator == 0) { denominator = 1; } return (float)numerator / (float)denominator; } int randomInt() { return rand(); } bool randomBool() { return rand() & 1; } void delay(int time) { rclcpp::sleep_for(std::chrono::seconds(time)); } void publish_violation (const char* requirement) { RCLCPP_INFO(this->get_logger(), "Requirement violation. Req: %s; Seed: %d; Step: %d\\n", requirement, this->initial_seed, this->num_test); } }; int main(int argc, char* argv[]) { rclcpp::init(argc, argv); rclcpp::spin(std::make_shared()); rclcpp::shutdown(); return 0; } ogma-core-1.10.0/templates/fprime/0000755000000000000000000000000015064246145015117 5ustar0000000000000000ogma-core-1.10.0/templates/fprime/Copilot.hpp0000644000000000000000000000375215064246145017250 0ustar0000000000000000// ====================================================================== // \title Copilot.hpp // \author root // \brief hpp file for Copilot component implementation class // ====================================================================== #ifndef Copilot_HPP #define Copilot_HPP #include "Ref/Copilot/CopilotComponentAc.hpp" namespace Ref { class Copilot : public CopilotComponentBase { public: // ---------------------------------------------------------------------- // Construction, initialization, and destruction // ---------------------------------------------------------------------- //! Construct object Copilot //! Copilot( const char *const compName /*!< The component name*/ ); //! Initialize object Copilot //! void init( const NATIVE_INT_TYPE queueDepth, /*!< The queue depth*/ const NATIVE_INT_TYPE instance = 0 /*!< The instance number*/ ); //! Destroy object Copilot //! ~Copilot(); PRIVATE: // ---------------------------------------------------------------------- // Handler implementations for user-defined typed input ports // ---------------------------------------------------------------------- {{#variables}} //! Handler implementation for {{varDeclName}}In //! void {{varDeclName}}In_handler( const NATIVE_INT_TYPE portNum, /*!< The port number*/ {{varDeclType}} value ); {{/variables}} PRIVATE: // ---------------------------------------------------------------------- // Command handler implementations // ---------------------------------------------------------------------- //! Implementation for CHECK_MONITORS command handler //! void CHECK_MONITORS_cmdHandler( const FwOpcodeType opCode, /*!< The opcode*/ const U32 cmdSeq /*!< The command sequence number*/ ); }; } // end namespace Ref #endif ogma-core-1.10.0/templates/fprime/instance-copilot0000644000000000000000000000013315064246145020312 0ustar0000000000000000 instance copilotMonitor: Ref.Copilot base id 0x2700 \ queue size Default.QUEUE_SIZE ogma-core-1.10.0/templates/fprime/Dockerfile0000644000000000000000000000343315064246145017114 0ustar0000000000000000# This dockerfile compiles a monitoring application inside FPrime's Reference # Application. FROM ubuntu:focal # Avoid questions during package installation. ENV DEBIAN_FRONTEND=noninteractive # Install FPrime dependencies and clone fprime from the repo. RUN apt-get update RUN apt-get install -y git cmake gcc python3 pip default-jre RUN git clone https://github.com/nasa/fprime RUN pip install -r fprime/requirements.txt RUN apt-get install ghc cabal-install alex happy pkg-config libz-dev RUN cabal update RUN cabal install --lib copilot copilot-c99 copilot-language copilot-theorem \ copilot-libraries copilot-interpreter WORKDIR fprime/Ref # Add all the monitoring app files. RUN mkdir Copilot ADD CMakeLists.txt Copilot/ ADD Copilot.fpp Copilot/ ADD Copilot.cpp Copilot/ ADD Copilot.hpp Copilot/ ADD Copilot.hs Copilot/ WORKDIR Copilot/ RUN runhaskell Copilot.hs WORKDIR .. # Enable Copilot app (add it after SignalGen). RUN sed -i -e '/^add_fprime_subdirectory.*SignalGen.*/a add_fprime_subdirectory("${CMAKE_CURRENT_LIST_DIR}\/Copilot\/")' CMakeLists.txt RUN fprime-util generate # Update Ref deployment. ## Define Component Instance. ## ## This command adds the contents of the given instance-copilot at the end of ## Queued component instances section, which is right before the Passive ## components section. ADD instance-copilot . RUN line=$(grep -n 'Passive component instances' Top/instances.fpp | tail -n1 | cut -d: -f1); line=$(($line - 2)); sed -i -e "${line}r instance-copilot" Top/instances.fpp RUN rm instance-copilot ## Update topology. ## ## This command adds the copilot monitoring node right after linuxTime in the ## topology. RUN sed -i -e '/^ \+instance linuxTime/a\ \ \ \ instance copilotMonitor' Top/topology.fpp RUN fprime-util build --jobs "$(nproc || printf '%s\n' 1)" ogma-core-1.10.0/templates/fprime/Copilot.fpp0000644000000000000000000000401315064246145017235 0ustar0000000000000000module Ref { {{#variables}} port {{varDeclFPrimeType}}Value(value: {{varDeclFPrimeType}}) {{/variables}} @ Monitoring component queued component Copilot { # ---------------------------------------------------------------------- # General ports # ---------------------------------------------------------------------- {{#variables}} async input port {{varDeclName}}In : {{varDeclFPrimeType}}Value {{/variables}} # ---------------------------------------------------------------------- # Special ports # ---------------------------------------------------------------------- @ Command receive command recv port cmdIn @ Command registration command reg port cmdRegOut @ Command response command resp port cmdResponseOut @ Event event port eventOut @ Parameter get param get port prmGetOut @ Parameter set param set port prmSetOut @ Telemetry telemetry port tlmOut @ Text event text event port textEventOut @ Time get time get port timeGetOut # ---------------------------------------------------------------------- # Parameters # ---------------------------------------------------------------------- # This section intentionally left blank # ---------------------------------------------------------------------- # Events # ---------------------------------------------------------------------- {{#monitors}} @ {{monitorName}} violation event {{monitorUC}}_VIOLATION() \ severity activity high \ id 0 \ format "{{monitorName}} violation" {{/monitors}} # ---------------------------------------------------------------------- # Commands # ---------------------------------------------------------------------- sync command CHECK_MONITORS() # ---------------------------------------------------------------------- # Telemetry # ---------------------------------------------------------------------- # This section intentionally left blank } } ogma-core-1.10.0/templates/fprime/CMakeLists.txt0000644000000000000000000000043415064246145017660 0ustar0000000000000000# Register the standard build set(SOURCE_FILES "${CMAKE_CURRENT_LIST_DIR}/copilot.c" "${CMAKE_CURRENT_LIST_DIR}/copilot.h" "${CMAKE_CURRENT_LIST_DIR}/copilot_types.h" "${CMAKE_CURRENT_LIST_DIR}/Copilot.cpp" "${CMAKE_CURRENT_LIST_DIR}/Copilot.fpp" ) register_fprime_module() ogma-core-1.10.0/templates/fprime/Copilot.cpp0000644000000000000000000000456115064246145017242 0ustar0000000000000000// ====================================================================== // \title Copilot.cpp // \author Ogma // \brief cpp file for Copilot component implementation class // ====================================================================== #include #include "Fw/Types/BasicTypes.hpp" #ifdef __cplusplus extern "C" { #endif {{#copilot}} #include "{{{copilot.specName}}}_types.h" #include "{{{copilot.specName}}}.h" {{/copilot}} #ifdef __cplusplus } #endif {{#variables}} {{varDeclType}} {{varDeclName}}; {{/variables}} {{#monitors}} bool {{monitorName}}_result; {{/monitors}} namespace Ref { // ---------------------------------------------------------------------- // Construction, initialization, and destruction // ---------------------------------------------------------------------- Copilot :: Copilot( const char *const compName ) : CopilotComponentBase(compName) { } void Copilot :: init( const NATIVE_INT_TYPE queueDepth, const NATIVE_INT_TYPE instance ) { CopilotComponentBase::init(queueDepth, instance); } Copilot :: ~Copilot() { } // ---------------------------------------------------------------------- // Handler implementations for user-defined typed input ports // ---------------------------------------------------------------------- {{#variables}} void Copilot :: {{varDeclName}}In_handler( const NATIVE_INT_TYPE portNum, {{varDeclType}} value ) { {{varDeclName}} = ({{varDeclType}}) value; } {{/variables}} // ---------------------------------------------------------------------- // Command handler implementations // ---------------------------------------------------------------------- void Copilot :: CHECK_MONITORS_cmdHandler( const FwOpcodeType opCode, const U32 cmdSeq ) { {{#monitors}} {{monitorName}}_result = false; {{/monitors}} step(); this->cmdResponse_out(opCode,cmdSeq,Fw::CmdResponse::OK); {{#monitors}} if ({{monitorName}}_result) { this->log_ACTIVITY_HI_{{monitorUC}}_VIOLATION(); } {{/monitors}} } } // end namespace Ref {{#monitors}} {{#monitorType}} void {{monitorName}}({{.}} arg) { {{monitorName}}_result = true; } {{/monitorType}} {{^monitorType}} void {{monitorName}}() { {{monitorName}}_result = true; } {{/monitorType}} {{/monitors}} ogma-core-1.10.0/templates/copilot-cfs/0000755000000000000000000000000015064246145016057 5ustar0000000000000000ogma-core-1.10.0/templates/copilot-cfs/CMakeLists.txt0000644000000000000000000000314515064246145020622 0ustar0000000000000000cmake_minimum_required(VERSION 2.6.4) project(CFE_COPILOT_APP C) include_directories(../../Modules/Core/Interfaces) {{#included_libraries}} include_directories({{{.}}}) {{/included_libraries}} include_directories(../inc) include_directories(fsw/mission_inc) include_directories(fsw/platform_inc) aux_source_directory(fsw/src APP_SRC_FILES) # Create the app module add_cfe_app(copilot_cfs ${APP_SRC_FILES} ${CMAKE_CURRENT_SOURCE_DIR}/fsw/src/copilot.c ${CMAKE_CURRENT_SOURCE_DIR}/fsw/src/copilot.h ${CMAKE_CURRENT_SOURCE_DIR}/fsw/src/copilot_types.h ) add_custom_command( OUTPUT ${CMAKE_CURRENT_SOURCE_DIR}/fsw/src/cabal.sandbox.config WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}/fsw/src/ COMMAND cabal v1-sandbox init COMMAND cabal update COMMAND cabal v1-install copilot COMMENT "Installing Copilot" ) add_custom_command( DEPENDS ${CMAKE_CURRENT_SOURCE_DIR}/fsw/src/cabal.sandbox.config DEPENDS ${CMAKE_CURRENT_SOURCE_DIR}/fsw/src/Properties.hs OUTPUT ${CMAKE_CURRENT_SOURCE_DIR}/fsw/src/copilot.c ${CMAKE_CURRENT_SOURCE_DIR}/fsw/src/copilot.h ${CMAKE_CURRENT_SOURCE_DIR}/fsw/src/copilot_types.h WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}/fsw/src/ COMMAND cabal v1-exec "--" runhaskell Properties.hs COMMENT "Compiling Copilot code" ) add_custom_target(HASKELL_COPILOT DEPENDS ${CMAKE_CURRENT_SOURCE_DIR}/fsw/src/copilot.c ${CMAKE_CURRENT_SOURCE_DIR}/fsw/src/copilot.h ${CMAKE_CURRENT_SOURCE_DIR}/fsw/src/copilot_types.h SOURCES ${CMAKE_CURRENT_SOURCE_DIR}/fsw/src/Properties.hs ) add_dependencies(copilot_cfs HASKELL_COPILOT) ogma-core-1.10.0/templates/copilot-cfs/fsw/0000755000000000000000000000000015064246145016656 5ustar0000000000000000ogma-core-1.10.0/templates/copilot-cfs/fsw/for_build/0000755000000000000000000000000015064246145020623 5ustar0000000000000000ogma-core-1.10.0/templates/copilot-cfs/fsw/for_build/Makefile0000644000000000000000000000560515064246145022271 0ustar0000000000000000############################################################################### # File: CFS Application Makefile # # $Id: Makefile 1.8 2009/07/09 12:25:54EDT rmcgraw Exp $ # # $Log: Makefile $ # Revision 1.8 2009/07/09 12:25:54EDT rmcgraw # DCR8291:1 Changed CFE_MISSION_INC to CFS_MISSION_INC and added log # ############################################################################### # # Subsystem produced by this makefile. # APPTARGET = copilot_cfs # # Entry Point for task # ENTRY_PT = COPILOT_CFSMain # # Object files required to build subsystem. # OBJS = copilot_cfs.o # # Source files required to build subsystem; used to generate dependencies. # As long as there are no assembly files this can be automated. # SOURCES = $(OBJS:.o=.c) ## ## Specify extra C Flags needed to build this subsystem ## LOCAL_COPTS = ## ## EXEDIR is defined here, just in case it needs to be different for a custom ## build ## EXEDIR=../exe ## ## Certain OSs and Application Loaders require the following option for ## Shared libraries. Currently only needed for vxWorks 5.5 and RTEMS. ## For each shared library that this app depends on, you need to have an ## entry like the following: ## -R../tst_lib/tst_lib.elf ## SHARED_LIB_LINK = ######################################################################## # Should not have to change below this line, except for customized # Mission and cFE directory structures ######################################################################## # # Set build type to CFE_APP. This allows us to # define different compiler flags for the cFE Core and Apps. # BUILD_TYPE = CFE_APP ## ## Include all necessary cFE make rules ## Any of these can be copied to a local file and ## changed if needed. ## ## ## cfe-config.mak contains PSP and OS selection ## include ../cfe/cfe-config.mak ## ## debug-opts.mak contains debug switches ## include ../cfe/debug-opts.mak ## ## compiler-opts.mak contains compiler definitions and switches/defines ## include $(CFE_PSP_SRC)/$(PSP)/make/compiler-opts.mak ## ## Setup the include path for this subsystem ## The OS specific includes are in the build-rules.make file ## ## If this subsystem needs include files from another app, add the path here. ## INCLUDE_PATH = \ -I$(OSAL_SRC)/inc \ -I$(CFE_CORE_SRC)/inc \ -I$(CFE_PSP_SRC)/inc \ -I$(CFE_PSP_SRC)/$(PSP)/inc \ -I$(CFS_APP_SRC)/inc \ -I$(CFS_APP_SRC)/$(APPTARGET)/fsw/src \ -I$(CFS_MISSION_INC) \ -I../cfe/inc \ -I../inc ## ## Define the VPATH make variable. ## This can be modified to include source from another directory. ## If there is no corresponding app in the cfs-apps directory, then this can be discarded, or ## if the mission chooses to put the src in another directory such as "src", then that can be ## added here as well. ## VPATH = $(CFS_APP_SRC)/$(APPTARGET)/fsw/src ## ## Include the common make rules for building a cFE Application ## include $(CFE_CORE_SRC)/make/app-rules.mak ogma-core-1.10.0/templates/copilot-cfs/fsw/mission_inc/0000755000000000000000000000000015064246145021170 5ustar0000000000000000ogma-core-1.10.0/templates/copilot-cfs/fsw/mission_inc/copilot_cfs_perfids.h0000644000000000000000000000075515064246145025370 0ustar0000000000000000/************************************************************************ ** File: ** $Id: copilot_cfs_perfids.h $ ** ** Purpose: ** Define Copilot App Performance IDs ** ** Notes: ** *************************************************************************/ #ifndef _copilot_cfs_perfids_h_ #define _copilot_cfs_perfids_h_ #define COPILOT_CFS_PERF_ID 91 #endif /* _copilot_cfs_perfids_h_ */ /************************/ /* End of File Comment */ /************************/ ogma-core-1.10.0/templates/copilot-cfs/fsw/src/0000755000000000000000000000000015064246145017445 5ustar0000000000000000ogma-core-1.10.0/templates/copilot-cfs/fsw/src/copilot_cfs_msg.h0000644000000000000000000000200315064246145022763 0ustar0000000000000000/******************************************************************************* ** File: ** copilot_cfs_msg.h ** ** Purpose: ** Define COPILOT App Messages and info ** ** Notes: ** ** *******************************************************************************/ #ifndef _copilot_cfs_msg_h_ #define _copilot_cfs_msg_h_ /*************************************************************************/ /* ** Type definition (generic "no arguments" command) */ typedef struct { uint8 CmdHeader[CFE_SB_CMD_HDR_SIZE]; } COPILOT_NoArgsCmd_t; /*************************************************************************/ /* ** Type definition (COPILOT App housekeeping) */ typedef struct { uint8 TlmHeader[CFE_SB_TLM_HDR_SIZE]; uint8 copilot_command_error_count; uint8 copilot_command_count; uint8 spare[2]; } OS_PACK copilot_hk_tlm_t ; #endif /* _copilot_cfs_msg_h_ */ /************************/ /* End of File Comment */ /************************/ ogma-core-1.10.0/templates/copilot-cfs/fsw/src/copilot_cfs_events.h0000644000000000000000000000131015064246145023501 0ustar0000000000000000/************************************************************************ ** File: ** copilot_app_events.h ** ** Purpose: ** Define COPILOT App Events IDs ** ** Notes: ** ** *************************************************************************/ #ifndef _copilot_app_events_h_ #define _copilot_app_events_h_ #define COPILOT_RESERVED_EID 0 #define COPILOT_STARTUP_INF_EID 1 #define COPILOT_COMMAND_ERR_EID 2 #define COPILOT_COMMANDCPVIOL_INF_EID 3 #define COPILOT_INVALID_MSGID_ERR_EID 4 #define COPILOT_LEN_ERR_EID 5 #endif /* _copilot_app_events_h_ */ /************************/ /* End of File Comment */ /************************/ ogma-core-1.10.0/templates/copilot-cfs/fsw/src/copilot_cfs.h0000644000000000000000000000252015064246145022121 0ustar0000000000000000/******************************************************************************* ** File: copilot_app.h ** ** Purpose: ** This file is main hdr file for the COPILOT application. ** ** *******************************************************************************/ #ifndef _copilot_app_h_ #define _copilot_app_h_ /* ** Required header files. */ #include "cfe.h" #include "cfe_error.h" #include "cfe_evs.h" #include "cfe_sb.h" #include "cfe_es.h" #include #include #include /***********************************************************************/ #define COPILOT_PIPE_DEPTH 32 /************************************************************************ ** Type Definitions *************************************************************************/ /****************************************************************************/ /* ** Local function prototypes. ** ** Note: Except for the entry point (COPILOT_AppMain), these ** functions are not called from any other source module. */ void COPILOT_AppMain(void); void COPILOT_AppInit(void); void COPILOT_ProcessCommandPacket(void); {{#msgCases}} void COPILOT_Process{{msgInfoDesc}}(void); {{/msgCases}} void COPILOT_ResetCounters(void); boolean COPILOT_VerifyCmdLength(CFE_SB_MsgPtr_t msg, uint16 ExpectedLength); #endif /* _copilot_app_h_ */ ogma-core-1.10.0/templates/copilot-cfs/fsw/src/copilot_cfs_version.h0000644000000000000000000000117215064246145023670 0ustar0000000000000000/************************************************************************ ** File: ** $Id: copilot_app_version.h $ ** ** Purpose: ** The Copilot Application header file containing version number ** ** Notes: ** ** *************************************************************************/ #ifndef _copilot_app_version_h_ #define _copilot_app_version_h_ #define COPILOT_CFS_MAJOR_VERSION 1 #define COPILOT_CFS_MINOR_VERSION 0 #define COPILOT_CFS_REVISION 0 #define COPILOT_CFS_MISSION_REV 0 #endif /* _copilot_app_version_h_ */ /************************/ /* End of File Comment */ /************************/ ogma-core-1.10.0/templates/copilot-cfs/fsw/src/Properties.hs0000644000000000000000000000265315064246145022143 0ustar0000000000000000{{#copilot}} import Copilot.Compile.C99 import Copilot.Language hiding (prop) import Copilot.Language.Prelude import Copilot.Library.LTL (next) import Copilot.Library.MTL hiding (since, alwaysBeen, trigger) import Copilot.Library.PTLTL (since, previous, alwaysBeen) import qualified Copilot.Library.PTLTL as PTLTL import qualified Copilot.Library.MTL as MTL import Language.Copilot (reify) import Prelude hiding ((&&), (||), (++), (<=), (>=), (<), (>), (==), (/=), not) {{{copilot.externs}}} {{{copilot.internals}}} {{{copilot.reqs}}} -- | Clock that increases in one-unit steps. clock :: Stream Int64 clock = [0] ++ (clock + 1) -- | First Time Point ftp :: Stream Bool ftp = [True] ++ false pre :: Stream Bool -> Stream Bool pre = ([False] ++) tpre :: Stream Bool -> Stream Bool tpre = ([True] ++) notPreviousNot :: Stream Bool -> Stream Bool notPreviousNot = not . PTLTL.previous . not -- | Complete specification. Calls C handler functions when properties are -- violated. spec :: Spec spec = do {{{copilot.triggers}}} main :: IO () main = reify spec >>= compileWith settings "{{{copilot.specName}}}" where settings = mkDefaultCSettings { cSettingsStepFunctionName = "copilot_step" } {{/copilot}} {{^copilot}} -- No specification provided. Place your specification in this file. {{/copilot}} ogma-core-1.10.0/templates/copilot-cfs/fsw/src/copilot_cfs.c0000644000000000000000000001274715064246145022130 0ustar0000000000000000/******************************************************************************* ** File: copilot_cfs.c ** ** Purpose: ** This file contains the source code for the Copilot App. ** *******************************************************************************/ /* ** Include Files: */ #include "copilot_cfs.h" #include "copilot_cfs_perfids.h" #include "copilot_cfs_msgids.h" #include "copilot_cfs_msg.h" #include "copilot_cfs_events.h" #include "copilot_cfs_version.h" {{#impl_extra_header}} {{{.}}} {{/impl_extra_header}} {{#copilot}} #include "{{{copilot.specName}}}_types.h" #include "{{{copilot.specName}}}.h" {{/copilot}} {{#variables}} {{varDeclType}} {{varDeclName}}; {{/variables}} /* ** global data */ copilot_hk_tlm_t COPILOT_HkTelemetryPkt; CFE_SB_PipeId_t COPILOT_CommandPipe; CFE_SB_MsgPtr_t COPILOTMsgPtr; static CFE_EVS_BinFilter_t COPILOT_EventFilters[] = { /* Event ID mask */ {COPILOT_STARTUP_INF_EID, 0x0000}, {COPILOT_COMMAND_ERR_EID, 0x0000}, {COPILOT_COMMANDCPVIOL_INF_EID, 0x0000}, }; /** * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* COPILOT_AppMain() -- Application entry point and main process loop */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * **/ void COPILOT_AppMain( void ) { int32 status; uint32 RunStatus = CFE_ES_APP_RUN; CFE_ES_PerfLogEntry(COPILOT_CFS_PERF_ID); COPILOT_AppInit(); /* ** COPILOT Runloop */ while (CFE_ES_RunLoop(&RunStatus) == TRUE) { CFE_ES_PerfLogExit(COPILOT_CFS_PERF_ID); /* Pend on receipt of command packet -- timeout set to 500 millisecs */ status = CFE_SB_RcvMsg(&COPILOTMsgPtr, COPILOT_CommandPipe, 500); CFE_ES_PerfLogEntry(COPILOT_CFS_PERF_ID); if (status == CFE_SUCCESS) { COPILOT_ProcessCommandPacket(); } } CFE_ES_ExitApp(RunStatus); } /* End of COPILOT_AppMain() */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* COPILOT_AppInit() -- initialization */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * **/ void COPILOT_AppInit(void) { /* ** Register the app with Executive services */ CFE_ES_RegisterApp() ; /* ** Register the events */ CFE_EVS_Register(COPILOT_EventFilters, sizeof(COPILOT_EventFilters)/sizeof(CFE_EVS_BinFilter_t), CFE_EVS_BINARY_FILTER); /* ** Create the Software Bus command pipe and subscribe to housekeeping ** messages */ CFE_SB_CreatePipe(&COPILOT_CommandPipe, COPILOT_PIPE_DEPTH,"COPILOT_CMD_PIPE"); {{#msgIds}} CFE_SB_Subscribe({{.}}, COPILOT_CommandPipe); {{/msgIds}} CFE_EVS_SendEvent (COPILOT_STARTUP_INF_EID, CFE_EVS_INFORMATION, "COPILOT App Initialized. Version %d.%d.%d.%d", COPILOT_CFS_MAJOR_VERSION, COPILOT_CFS_MINOR_VERSION, COPILOT_CFS_REVISION, COPILOT_CFS_MISSION_REV); } /* End of COPILOT_AppInit() */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * **/ /* Name: COPILOT_ProcessCommandPacket */ /* */ /* Purpose: */ /* This routine will process any packet that is received on the COPILOT */ /* command pipe. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ void COPILOT_ProcessCommandPacket(void) { CFE_SB_MsgId_t MsgId; MsgId = CFE_SB_GetMsgId(COPILOTMsgPtr); switch (MsgId) { {{#msgCases}} case {{msgInfoId}}: COPILOT_Process{{msgInfoDesc}}(); break; {{/msgCases}} default: COPILOT_HkTelemetryPkt.copilot_command_error_count++; CFE_EVS_SendEvent(COPILOT_COMMAND_ERR_EID,CFE_EVS_ERROR, "COPILOT: invalid command packet,MID = 0x%x", MsgId); break; } return; } /* End COPILOT_ProcessCommandPacket */ {{#msgHandlers}} /** * Make received data available to Copilot and run monitors. */ void COPILOT_Process{{msgDataDesc}}(void) { {{#msgDataFromType}} {{msgDataFromType}}* msg; msg = ({{.}}*) COPILOTMsgPtr; {{/msgDataFromType}} {{^msgDataFromType}} {{msgDataVarType}}* msg; msg = ({{msgDataVarType}}*) COPILOTMsgPtr; {{/msgDataFromType}} {{#msgDataFromField}} {{msgDataVarName}} = msg->{{.}}; {{/msgDataFromField}} {{^msgDataFromField}} {{msgDataVarName}} = *msg; {{/msgDataFromField}} // Run all copilot monitors. copilot_step(); } {{/msgHandlers}} {{#triggers}} /** * Report copilot property violations. */ {{#triggerType}} void {{triggerName}}({{.}} arg) { {{/triggerType}} {{^triggerType}} void {{triggerName}}(void) { {{/triggerType}} CFE_EVS_SendEvent(COPILOT_COMMANDCPVIOL_INF_EID, CFE_EVS_ERROR, "COPILOT: violation: {{triggerName}}"); } {{/triggers}} ogma-core-1.10.0/templates/copilot-cfs/fsw/platform_inc/0000755000000000000000000000000015064246145021333 5ustar0000000000000000ogma-core-1.10.0/templates/copilot-cfs/fsw/platform_inc/copilot_cfs_msgids.h0000644000000000000000000000106115064246145025354 0ustar0000000000000000/************************************************************************ ** File: ** $Id: copilot_cfs_msgids.h $ ** ** Purpose: ** Define Copilot App Message IDs ** ** Notes: ** ** *************************************************************************/ #ifndef _copilot_cfs_msgids_h_ #define _copilot_cfs_msgids_h_ #define COPILOT_CFS_CMD_MID 0x1882 #define COPILOT_CFS_SEND_HK_MID 0x1883 #define COPILOT_CFS_HK_TLM_MID 0x0883 #endif /* _copilot_cfs_msgids_h_ */ /************************/ /* End of File Comment */ /************************/ ogma-core-1.10.0/templates/standalone/0000755000000000000000000000000015064246145015765 5ustar0000000000000000ogma-core-1.10.0/templates/standalone/Copilot.hs0000644000000000000000000000224415064246145017734 0ustar0000000000000000import Copilot.Compile.C99 import Copilot.Language hiding (prop) import Copilot.Language.Prelude import Copilot.Library.LTL (next) import Copilot.Library.MTL hiding (since, alwaysBeen, trigger) import Copilot.Library.PTLTL (since, previous, alwaysBeen) import qualified Copilot.Library.PTLTL as PTLTL import qualified Copilot.Library.MTL as MTL import Language.Copilot (reify) import Prelude hiding ((&&), (||), (++), (<=), (>=), (<), (>), (==), (/=), not) {{{externs}}} {{{internals}}} {{{reqs}}} -- | Clock that increases in one-unit steps. clock :: Stream Int64 clock = [0] ++ (clock + 1) -- | First Time Point ftp :: Stream Bool ftp = [True] ++ false pre :: Stream Bool -> Stream Bool pre = ([False] ++) tpre :: Stream Bool -> Stream Bool tpre = ([True] ++) notPreviousNot :: Stream Bool -> Stream Bool notPreviousNot = not . PTLTL.previous . not -- | Complete specification. Calls C handler functions when properties are -- violated. spec :: Spec spec = do {{{triggers}}} main :: IO () main = reify spec >>= compile "{{{specName}}}" ogma-core-1.10.0/templates/diagram/0000755000000000000000000000000015064246145015241 5ustar0000000000000000ogma-core-1.10.0/templates/diagram/Copilot.hs0000644000000000000000000000601615064246145017211 0ustar0000000000000000import Copilot.Compile.C99 import Copilot.Language hiding (max, min, prop) import Copilot.Language.Prelude import Copilot.Library.LTL (next) import Copilot.Library.MTL hiding (alwaysBeen, since, trigger) import qualified Copilot.Library.MTL as MTL import Copilot.Library.PTLTL (alwaysBeen, previous, since) import qualified Copilot.Library.PTLTL as PTLTL import Language.Copilot (reify) import Language.Copilot hiding (max, min) import Prelude hiding (max, min, mod, not, until, (&&), (++), (/=), (<), (<=), (==), (>), (>=), (||)) externalState :: Stream Word8 externalState = extern "{{{state}}}" Nothing input :: Stream Word8 input = extern "{{{input}}}" Nothing {{{streamDefs}}} -- | Complete specification. Calls C handler functions when properties are -- violated. spec :: Spec spec = do trigger "handler" stateMachineProp {{{handlerInputs}}} main :: IO () main = reify spec >>= compile "{{{specName}}}" -- Initial state, final state, no transition signal, transitions, bad state type StateMachineGF = ( Word8, Word8, Stream Bool, [(Word8, Stream Bool, Word8)], Word8) stateMachineGF :: StateMachineGF -> Stream Word8 stateMachineGF (initialState, finalState, noInputData, transitions, badState) = state where state = [initialState] ++ ifThenElses transitions ifThenElses :: [(Word8, Stream Bool, Word8)] -> Stream Word8 ifThenElses [] = ifThenElse (state == constant finalState && noInputData) (constant finalState) (constant badState) ifThenElses ((s1,i,s2):ss) = ifThenElse (state == constant s1 && i) (constant s2) (ifThenElses ss) -- | True when the given input stream does hold any of the values in the given -- list. noneOf :: [Stream Bool] -> Stream Bool noneOf [] = true noneOf (x:xs) = not x && noneOf xs -- | Given a list of transitions, and a current state, and a list of possible -- destination states, produce a list of booleans indicating if a transition to -- each of the destination states would be valid. checkValidTransitions :: [(Word8, Stream Bool, Word8)] -> Stream Word8 -> [Word8] -> [Stream Bool] checkValidTransitions transitions curState destinations = map (checkValidTransition transitions curState) destinations -- | Given a list of transitions, and a current state, and destination states, -- produce a list of booleans indicating if a transition to each of the -- destination states would be valid. checkValidTransition :: [(Word8, Stream Bool, Word8)] -> Stream Word8 -> Word8 -> Stream Bool checkValidTransition [] _ _ = true checkValidTransition ((so1, c, sd1):sx) so2 sd2 = ifThenElse ((constant so1 == so2) && (constant sd1 == constant sd2)) c (checkValidTransition sx so2 sd2) ogma-core-1.10.0/tests/0000755000000000000000000000000015064246145013001 5ustar0000000000000000ogma-core-1.10.0/tests/commands-fcs-error-parsing-failed-2.json0000644000000000000000000000467415064246145022432 0ustar0000000000000000{ "RTSASpec": { "Internal_variables": [], "Other_variables": [ {"name":"param_is_short"}, {"name":"param_value_short", "type":"real"}, {"name":"param_value_long", "type":"real"}, {"name":"upper_param_limit", "type":"real"}, {"name":"lower_param_limit", "type":"real"}, {"name":"envelope_issue", "type":"bool"} ], "Requirements": [ { "name": "behnazOne", "ptExpanded": "((H ((((! flight_mode) & (Y flight_mode)) & (Y TRUE)) -> (Y (((O[=10] (((conflict_detected) & ((Y (! (conflict_detected))) | (flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))))) & (! (( replanning_mode ))))) -> (O[<10] ((flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))) | (( replanning_mode ))))) S (((O[=10] (((conflict_detected) & ((Y (! (conflict_detected))) | (flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))))) & (! (( replanning_mode ))))) -> (O[<10] ((flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))) | (( replanning_mode ))))) & (flight_mode & ((! (Y TRUE)) | (Y (! flight_mode))))))))) & (((! ((! flight_mode) & (Y flight_mode))) S ((! ((! flight_mode) & (Y flight_mode))) & (flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))))) -> (((O[=10] (((conflict_detected) & ((Y (! (conflict_detected))) | (flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))))) & (! (( replanning_mode ))))) -> (O[<10] ((flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))) | (( replanning_mode ))))) S (((O[=10] (((conflict_detected) & ((Y (! (conflict_detected))) | (flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))))) & (! (( replanning_mode ))))) -> (O[<10] ((flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))) | (( replanning_mode ))))) & (flight_mode & ((! (Y TRUE)) | (Y (! flight_mode))))))))" } ] } } ogma-core-1.10.0/tests/Main.hs0000644000000000000000000001316315064246145014225 0ustar0000000000000000-- | Test ogma-core module Main where import Data.Monoid ( mempty ) import Test.Framework ( Test, defaultMainWithOpts ) import Test.Framework.Providers.HUnit ( testCase ) import Test.HUnit ( assertBool ) import System.Directory ( getTemporaryDirectory ) -- Internal imports import Command.CStructs2Copilot (cstructs2Copilot) import Command.Result (isSuccess) import Command.Standalone (CommandOptions (..), command) -- | Run all unit tests on ogma-core. main :: IO () main = defaultMainWithOpts tests mempty -- | All unit tests for ogma-core. tests :: [Test.Framework.Test] tests = [ testCase "standalone-cmd-fcs-ok" (testStandaloneFCS "tests/fcs_good.json" True) -- Should pass , testCase "standalone-cmd-fsc-file-not-found" (testStandaloneFCS "tests/file-invalid.json" False) -- Should fail because the file does not exist , testCase "standalone-cmd-fcs-parse-fail-1" (testStandaloneFCS "tests/commands-fcs-error-parsing-failed-1.json" False ) -- Should fail because the opening bracket is [ and not { , testCase "standalone-cmd-fcs-parse-fail-2" (testStandaloneFCS "tests/commands-fcs-error-parsing-failed-2.json" False ) -- Should fail because a field is missing in an external variable , testCase "standalone-cmd-fcs-parse-fail-3" (testStandaloneFCS "tests/commands-fcs-error-parsing-failed-3.json" False ) -- Should fail because a field is missing in an internal variable , testCase "standalone-reqs-db-lustre" (testStandaloneFDB "tests/fdb-example1.json" True) -- Should pass , testCase "structs-parse-ok" (testCStructs2Copilot "tests/reduced_geofence_msgs.h" True) -- Should pass , testCase "structs-parse-fail-1" (testCStructs2Copilot "tests/reduced_geofence_msgs_bad.h" False) -- Should fail because a keyword is incorrect ] -- | Test C struct parser and conversion to Copilot structs -- for a particular file. -- -- This test uses the Copilot backend for C header files, so it generates -- Copilot types and instances. -- -- This IO action fails if any of the following are true: -- * The given file is not found or accessible. -- * The format in the given file is incorrect. -- * Ogma fails due to an internal error or bug. -- testCStructs2Copilot :: FilePath -- ^ Path to a C header file with structs -> Bool -> IO () testCStructs2Copilot file success = do result <- cstructs2Copilot file -- True if success is expected and detected, or niether expected nor -- detected. let testPass = success == isSuccess result assertBool errorMsg testPass where errorMsg = "The result of the transformation of the C header file " ++ file ++ " to Copilot struct declarations was unexpected." -- | Test standalone backend. -- -- This test uses the standalone, so it generates a Copilot file. -- -- This IO action fails if any of the following are true: -- * The given file is not found or accessible. -- * The format in the given file is incorrect. -- * Ogma fails due to an internal error or bug. testStandaloneFCS :: FilePath -- ^ Path to a input file -> Bool -> IO () testStandaloneFCS file success = do targetDir <- getTemporaryDirectory let opts = CommandOptions { commandConditionExpr = Nothing , commandInputFile = Just file , commandFormat = "fcs" , commandPropFormat = "smv" , commandTypeMapping = [("int", "Int64"), ("real", "Float")] , commandFilename = "monitor" , commandTargetDir = targetDir , commandTemplateDir = Nothing , commandPropVia = Nothing , commandExtraVars = Nothing } result <- command opts -- True if success is expected and detected, or niether expected nor -- detected. let testPass = success == isSuccess result assertBool errorMsg testPass where errorMsg = "The result of the transformation of input file " ++ file ++ " to Copilot was unexpected." -- | Test standalone backend with FDB format. -- -- This test uses the standalone backend with the FDB format and the Lustre -- property format. -- -- This IO action fails if any of the following are true: -- * The given file is not found or accessible. -- * The format in the given file is incorrect. -- * Ogma fails due to an internal error or bug. -- testStandaloneFDB :: FilePath -- ^ Path to input file -> Bool -> IO () testStandaloneFDB file success = do targetDir <- getTemporaryDirectory let opts = CommandOptions { commandConditionExpr = Nothing , commandInputFile = Just file , commandFormat = "fdb" , commandPropFormat = "lustre" , commandTypeMapping = [] , commandFilename = "monitor" , commandTargetDir = targetDir , commandTemplateDir = Nothing , commandPropVia = Nothing , commandExtraVars = Nothing } result <- command opts -- True if success is expected and detected, or niether expected nor -- detected. let testPass = success == isSuccess result assertBool errorMsg testPass where errorMsg = "The result of the transformation of input file " ++ file ++ " to Copilot was unexpected." ogma-core-1.10.0/tests/commands-fcs-error-parsing-failed-1.json0000644000000000000000000000471315064246145022423 0ustar0000000000000000[ "RTSASpec": { "Internal_variables": [], "Other_variables": [ {"name":"param_is_short", "type":"bool"}, {"name":"param_value_short", "type":"real"}, {"name":"param_value_long", "type":"real"}, {"name":"upper_param_limit", "type":"real"}, {"name":"lower_param_limit", "type":"real"}, {"name":"envelope_issue", "type":"bool"} ], "Requirements": [ { "name": "behnazOne", "ptExpanded": "((H ((((! flight_mode) & (Y flight_mode)) & (Y TRUE)) -> (Y (((O[=10] (((conflict_detected) & ((Y (! (conflict_detected))) | (flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))))) & (! (( replanning_mode ))))) -> (O[<10] ((flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))) | (( replanning_mode ))))) S (((O[=10] (((conflict_detected) & ((Y (! (conflict_detected))) | (flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))))) & (! (( replanning_mode ))))) -> (O[<10] ((flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))) | (( replanning_mode ))))) & (flight_mode & ((! (Y TRUE)) | (Y (! flight_mode))))))))) & (((! ((! flight_mode) & (Y flight_mode))) S ((! ((! flight_mode) & (Y flight_mode))) & (flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))))) -> (((O[=10] (((conflict_detected) & ((Y (! (conflict_detected))) | (flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))))) & (! (( replanning_mode ))))) -> (O[<10] ((flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))) | (( replanning_mode ))))) S (((O[=10] (((conflict_detected) & ((Y (! (conflict_detected))) | (flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))))) & (! (( replanning_mode ))))) -> (O[<10] ((flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))) | (( replanning_mode ))))) & (flight_mode & ((! (Y TRUE)) | (Y (! flight_mode))))))))" } ] } } ogma-core-1.10.0/tests/reduced_geofence_msgs_bad.h0000644000000000000000000000051115064246145020254 0ustar0000000000000000/** * @struct geofence_parameters_t * @brief data structure containing information about the parameters used by the geofence app */ typeduuuef struct{ uint8_t TlmHeader[CFE_SB_TLM_HDR_SIZE]; double lookahead; double hthreshold; double vthreshold; double hstepback; double vstepback; }geofence_parameters_t; ogma-core-1.10.0/tests/reduced_geofence_msgs.h0000644000000000000000000000050615064246145017452 0ustar0000000000000000/** * @struct geofence_parameters_t * @brief data structure containing information about the parameters used by the geofence app */ typedef struct{ uint8_t TlmHeader[CFE_SB_TLM_HDR_SIZE]; double lookahead; double hthreshold; double vthreshold; double hstepback; double vstepback; }geofence_parameters_t; ogma-core-1.10.0/tests/fdb-example1.json0000644000000000000000000002257515064246145016154 0ustar0000000000000000[ { "reqid": "test_req1", "parent_reqid": "", "project": "Test", "rationale": "", "fulltext": "during flight_mode when conflict_detected planner_module shall within 10 seconds satisfy (replanning_mode).", "semantics": { "type": "nasa", "scope": { "type": "in" }, "condition": "regular", "timing": "within", "response": "satisfaction", "variables": { "regular": [ "conflict_detected", "replanning_mode" ], "modes": [ "flight_mode" ] }, "scope_mode": "flight_mode", "scopeTextRange": [ 0, 17 ], "regular_condition": "(conflict_detected)", "qualifier_word": "when", "pre_condition": "(conflict_detected)", "conditionTextRange": [ 19, 40 ], "component_name": "planner_module", "componentTextRange": [ 42, 55 ], "duration": [ "10" ], "timingTextRange": [ 63, 79 ], "post_condition": "(( replanning_mode ))", "responseTextRange": [ 81, 105 ], "ft": "((LAST V ((! (Fin_flight_mode & (! LAST))) | (X (((Lin_flight_mode | LAST) V (((! (conflict_detected)) & ((! LAST) & ((X (conflict_detected)) & (! (Lin_flight_mode | LAST))))) -> ((X ((F[<=10] (( replanning_mode ))) | (F[<10] (Lin_flight_mode | LAST)))) & (! (Lin_flight_mode | LAST))))) & ((conflict_detected) -> ((F[<=10] (( replanning_mode ))) | (F[<10] (Lin_flight_mode | LAST)))))))) & (flight_mode -> (((Lin_flight_mode | LAST) V (((! (conflict_detected)) & ((! LAST) & ((X (conflict_detected)) & (! (Lin_flight_mode | LAST))))) -> ((X ((F[<=10] (( replanning_mode ))) | (F[<10] (Lin_flight_mode | LAST)))) & (! (Lin_flight_mode | LAST))))) & ((conflict_detected) -> ((F[<=10] (( replanning_mode ))) | (F[<10] (Lin_flight_mode | LAST)))))))", "pt": "((H ((Lin_flight_mode & (! FTP)) -> (Y (((O[=10] (((conflict_detected) & ((Y (! (conflict_detected))) | Fin_flight_mode)) & (! (( replanning_mode ))))) -> (O[<10] (Fin_flight_mode | (( replanning_mode ))))) S (((O[=10] (((conflict_detected) & ((Y (! (conflict_detected))) | Fin_flight_mode)) & (! (( replanning_mode ))))) -> (O[<10] (Fin_flight_mode | (( replanning_mode ))))) & Fin_flight_mode))))) & (((! Lin_flight_mode) S ((! Lin_flight_mode) & Fin_flight_mode)) -> (((O[=10] (((conflict_detected) & ((Y (! (conflict_detected))) | Fin_flight_mode)) & (! (( replanning_mode ))))) -> (O[<10] (Fin_flight_mode | (( replanning_mode ))))) S (((O[=10] (((conflict_detected) & ((Y (! (conflict_detected))) | Fin_flight_mode)) & (! (( replanning_mode ))))) -> (O[<10] (Fin_flight_mode | (( replanning_mode ))))) & Fin_flight_mode))))", "ftExpanded": "((LAST V ((! ((((! flight_mode) & (! LAST)) & (X flight_mode)) & (! LAST))) | (X (((((flight_mode & (! LAST)) & (X (! flight_mode))) | LAST) V (((! (conflict_detected)) & ((! LAST) & ((X (conflict_detected)) & (! (((flight_mode & (! LAST)) & (X (! flight_mode))) | LAST))))) -> ((X ((F[<=10] (( replanning_mode ))) | (F[<10] (((flight_mode & (! LAST)) & (X (! flight_mode))) | LAST)))) & (! (((flight_mode & (! LAST)) & (X (! flight_mode))) | LAST))))) & ((conflict_detected) -> ((F[<=10] (( replanning_mode ))) | (F[<10] (((flight_mode & (! LAST)) & (X (! flight_mode))) | LAST)))))))) & (flight_mode -> (((((flight_mode & (! LAST)) & (X (! flight_mode))) | LAST) V (((! (conflict_detected)) & ((! LAST) & ((X (conflict_detected)) & (! (((flight_mode & (! LAST)) & (X (! flight_mode))) | LAST))))) -> ((X ((F[<=10] (( replanning_mode ))) | (F[<10] (((flight_mode & (! LAST)) & (X (! flight_mode))) | LAST)))) & (! (((flight_mode & (! LAST)) & (X (! flight_mode))) | LAST))))) & ((conflict_detected) -> ((F[<=10] (( replanning_mode ))) | (F[<10] (((flight_mode & (! LAST)) & (X (! flight_mode))) | LAST)))))))", "ptExpanded": "((H ((((! flight_mode) & (Y flight_mode)) & (Y TRUE)) -> (Y (((O[=10] (((conflict_detected) & ((Y (! (conflict_detected))) | (flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))))) & (! (( replanning_mode ))))) -> (O[<10] ((flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))) | (( replanning_mode ))))) S (((O[=10] (((conflict_detected) & ((Y (! (conflict_detected))) | (flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))))) & (! (( replanning_mode ))))) -> (O[<10] ((flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))) | (( replanning_mode ))))) & (flight_mode & ((! (Y TRUE)) | (Y (! flight_mode))))))))) & (((! ((! flight_mode) & (Y flight_mode))) S ((! ((! flight_mode) & (Y flight_mode))) & (flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))))) -> (((O[=10] (((conflict_detected) & ((Y (! (conflict_detected))) | (flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))))) & (! (( replanning_mode ))))) -> (O[<10] ((flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))) | (( replanning_mode ))))) S (((O[=10] (((conflict_detected) & ((Y (! (conflict_detected))) | (flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))))) & (! (( replanning_mode ))))) -> (O[<10] ((flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))) | (( replanning_mode ))))) & (flight_mode & ((! (Y TRUE)) | (Y (! flight_mode))))))))", "component": "planner_module", "CoCoSpecCode": "((H(((( not flight_mode) and (pre (flight_mode))) and ( not FTP)) => (pre (SI( (flight_mode and (FTP or (pre ( not flight_mode)))), ((OT(10,10,( ( (conflict_detected) and ( ( Y ( not (conflict_detected) ) ) or ( flight_mode and ( FTP or ( Y not flight_mode ) ) ) ) ) and ( not (( replanning_mode )) ) ))) => (OT(10-1,0,( ( flight_mode and ( FTP or ( Y not flight_mode ) ) ) or (( replanning_mode )) )))) ))))) and ((SI( (flight_mode and (FTP or (pre ( not flight_mode)))), ( not (( not flight_mode) and (pre (flight_mode)))) )) => (SI( (flight_mode and (FTP or (pre ( not flight_mode)))), ((OT(10,10,( ( (conflict_detected) and ( ( Y ( not (conflict_detected) ) ) or ( flight_mode and ( FTP or ( Y not flight_mode ) ) ) ) ) and ( not (( replanning_mode )) ) ))) => (OT(10-1,0,( ( flight_mode and ( FTP or ( Y not flight_mode ) ) ) or (( replanning_mode )) )))) ))))", "diagramVariables": "M = flight_mode, TC = (conflict_detected), n = 10, Response = (( replanning_mode )).", "description": "ENFORCED: in every interval where flight_mode holds.\nTRIGGER: first point in the interval if (conflict_detected) is true and any point in the interval where (conflict_detected) becomes true (from false).\nREQUIRES: for every trigger, RES must hold at some point with distance <=10 from the trigger, except if the end of the interval occurs sooner.", "diagram": "_media/user-interface/examples/svgDiagrams/in_regular_within_satisfaction.svg" }, "_id": "fbc0a840-a04b-11ea-b135-098996762962" } ]ogma-core-1.10.0/tests/commands-fcs-error-parsing-failed-3.json0000644000000000000000000000474515064246145022432 0ustar0000000000000000{ "RTSASpec": { "Internal_variables": [ "name":"unused_variable" ], "Other_variables": [ {"name":"param_is_short", "type":"bool"}, {"name":"param_value_short", "type":"real"}, {"name":"param_value_long", "type":"real"}, {"name":"upper_param_limit", "type":"real"}, {"name":"lower_param_limit", "type":"real"}, {"name":"envelope_issue", "type":"bool"} ], "Requirements": [ { "name": "behnazOne", "ptExpanded": "((H ((((! flight_mode) & (Y flight_mode)) & (Y TRUE)) -> (Y (((O[=10] (((conflict_detected) & ((Y (! (conflict_detected))) | (flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))))) & (! (( replanning_mode ))))) -> (O[<10] ((flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))) | (( replanning_mode ))))) S (((O[=10] (((conflict_detected) & ((Y (! (conflict_detected))) | (flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))))) & (! (( replanning_mode ))))) -> (O[<10] ((flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))) | (( replanning_mode ))))) & (flight_mode & ((! (Y TRUE)) | (Y (! flight_mode))))))))) & (((! ((! flight_mode) & (Y flight_mode))) S ((! ((! flight_mode) & (Y flight_mode))) & (flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))))) -> (((O[=10] (((conflict_detected) & ((Y (! (conflict_detected))) | (flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))))) & (! (( replanning_mode ))))) -> (O[<10] ((flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))) | (( replanning_mode ))))) S (((O[=10] (((conflict_detected) & ((Y (! (conflict_detected))) | (flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))))) & (! (( replanning_mode ))))) -> (O[<10] ((flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))) | (( replanning_mode ))))) & (flight_mode & ((! (Y TRUE)) | (Y (! flight_mode))))))))" } ] } } ogma-core-1.10.0/tests/fcs_good.json0000644000000000000000000000502215064246145015456 0ustar0000000000000000{ "RTSASpec": { "Internal_variables": [], "Other_variables": [ {"name":"param_is_short", "type":"bool"}, {"name":"param_value_short", "type":"real"}, {"name":"param_value_long", "type":"real"}, {"name":"upper_param_limit", "type":"real"}, {"name":"lower_param_limit", "type":"real"}, {"name":"envelope_issue", "type":"bool"} ], "Requirements": [ { "name": "behnazOne", "CoCoSpecCode": "true", "ptLTL": "((H ((((! flight_mode) & (Y flight_mode)) & (Y TRUE)) -> (Y (((O[=10] (((conflict_detected) & ((Y (! (conflict_detected))) | (flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))))) & (! (( replanning_mode ))))) -> (O[<10] ((flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))) | (( replanning_mode ))))) S (((O[=10] (((conflict_detected) & ((Y (! (conflict_detected))) | (flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))))) & (! (( replanning_mode ))))) -> (O[<10] ((flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))) | (( replanning_mode ))))) & (flight_mode & ((! (Y TRUE)) | (Y (! flight_mode))))))))) & (((! ((! flight_mode) & (Y flight_mode))) S ((! ((! flight_mode) & (Y flight_mode))) & (flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))))) -> (((O[=10] (((conflict_detected) & ((Y (! (conflict_detected))) | (flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))))) & (! (( replanning_mode ))))) -> (O[<10] ((flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))) | (( replanning_mode ))))) S (((O[=10] (((conflict_detected) & ((Y (! (conflict_detected))) | (flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))))) & (! (( replanning_mode ))))) -> (O[<10] ((flight_mode & ((! (Y TRUE)) | (Y (! flight_mode)))) | (( replanning_mode ))))) & (flight_mode & ((! (Y TRUE)) | (Y (! flight_mode))))))))", "fretish": "Meaning not specified" } ] } } ogma-core-1.10.0/src/0000755000000000000000000000000015064246145012426 5ustar0000000000000000ogma-core-1.10.0/src/Language/0000755000000000000000000000000015064246145014151 5ustar0000000000000000ogma-core-1.10.0/src/Language/Trans/0000755000000000000000000000000015064246145015240 5ustar0000000000000000ogma-core-1.10.0/src/Language/Trans/CStruct2CopilotStruct.hs0000644000000000000000000001557315064246145022017 0ustar0000000000000000-- Copyright 2020 United States Government as represented by the Administrator -- of the National Aeronautics and Space Administration. All Rights Reserved. -- -- Disclaimers -- -- Licensed under the Apache License, Version 2.0 (the "License"); you may -- not use this file except in compliance with the License. You may obtain a -- copy of the License at -- -- https://www.apache.org/licenses/LICENSE-2.0 -- -- Unless required by applicable law or agreed to in writing, software -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the -- License for the specific language governing permissions and limitations -- under the License. -- -- | Copilot's struct representation of C Structs and creation from C's AST. module Language.Trans.CStruct2CopilotStruct ( -- * Constructors mkCStruct -- * Convert C type names to valid Copilot names , camelCaseTypeName ) where -- External imports import Data.Char ( toUpper ) -- External imports: Copilot C Struct representation import Language.Copilot.CStruct ( CField (CArray, CPlain), CStruct(..) ) -- Internal imports import qualified Language.C.AbsC as C -- | Convert a top-level struct declaration into a CStruct mkCStruct :: C.ExternalDeclaration -> Either String CStruct mkCStruct (C.MkExternalDeclarationFunctionDefinition _) = Left "C files must contain struct definitions only." mkCStruct (C.MkExternalDeclarationDeclaration (C.MkDeclaration specifiers initDecl)) = case specifiers of C.DeclarationSpecifiers (C.MkDeclarationSpecifierStorageClass C.MkStorageClassSpecifierTypedef) s -> let [C.MkDeclarationSpecifierTypeSpecifier (C.MkTypeSpecifierStructOrUnion (C.MkStructOrUnionSpecifierWithFields C.MkStructOrUnionStruct _structName u))] = s (C.MkInitDeclarationListOptJust [C.MkInitDeclaratorUninitialized (C.MkDeclarator C.MkPointerOptNothing (C.MkDirectDeclaratorIdentifier (C.Identifier t)))]) = initDecl name = Right t fields = mapM buildCField u in CStruct <$> name <*> fields _ -> Left "C files must contain struct definitions only." -- -- | Convert a declaration within a struct into a field declaration. buildCField :: C.StructDeclaration -> Either String CField buildCField (C.MkStructDeclaration field name) | fieldLength > 0 = CArray <$> fieldType <*> fieldName <*> pure fieldLength | otherwise = CPlain <$> fieldType <*> fieldName where fieldType = extractFieldType (head field) fieldName = extractFieldName (head name) fieldLength = extractFieldLength (head name) -- | Extract the type of a field from a type specification. extractFieldType :: C.SpecifierQualifier -> Either String String extractFieldType (C.MkSpecifierQualifierTypeSpecifier t) = Right $ showTypeSpecifier t extractFieldType (C.MkSpecifierQualifierTypeQualifier _) = Left "type qualifiers." -- | String representing a known type. showTypeSpecifier :: C.TypeSpecifier -> String showTypeSpecifier C.MkTypeSpecifierFloat = "float" showTypeSpecifier C.MkTypeSpecifierDouble = "double" showTypeSpecifier C.MkTypeSpecifierUInt8 = "uint8_t" showTypeSpecifier C.MkTypeSpecifierUInt16 = "uint16_t" showTypeSpecifier C.MkTypeSpecifierUInt32 = "uint32_t" showTypeSpecifier C.MkTypeSpecifierUInt64 = "uint64_t" showTypeSpecifier C.MkTypeSpecifierInt8 = "int8_t" showTypeSpecifier C.MkTypeSpecifierInt16 = "int16_t" showTypeSpecifier C.MkTypeSpecifierInt32 = "int32_t" showTypeSpecifier C.MkTypeSpecifierInt64 = "int64_t" showTypeSpecifier C.MkTypeSpecifierInt = "int" -- -- | Extract the name of a field from a struct declarator. extractFieldName :: Read n => C.StructDeclarator -> Either String n extractFieldName (C.MkStructDeclaratorDeclarator (C.MkDeclarator C.MkPointerOptNothing (C.MkDirectDeclaratorIdentifier (C.Identifier d)))) = Right $ read $ show d extractFieldName (C.MkStructDeclaratorDeclarator (C.MkDeclarator C.MkPointerOptNothing (C.MkDirectDeclaratorConstantExpressionOpt (C.MkDirectDeclaratorIdentifier (C.Identifier i)) _arrayLength ) ) ) = Right $ read $ show i extractFieldName _ = Left $ "only struct declarations that are IDs without a" ++ " pointer, or plain arrays without a pointer, are" ++ " supported." -- -- -- | Extract the length of an array field from a struct declarator. extractFieldLength :: C.StructDeclarator -> Integer extractFieldLength (C.MkStructDeclaratorDeclarator (C.MkDeclarator C.MkPointerOptNothing (C.MkDirectDeclaratorConstantExpressionOpt _varIdent (C.MkConditionalExpressionJust (C.MkConstantExpression (C.Expression12 (C.MkCastExpression1 (C.MkUnaryExpressionPostfix (C.MkPostfixExpression1 (C.MkPrimaryExpressionIdentifier (C.Identifier _n)) ) ) ) ) ) ) ) ) ) = 99 extractFieldLength (C.MkStructDeclaratorDeclarator (C.MkDeclarator C.MkPointerOptNothing (C.MkDirectDeclaratorConstantExpressionOpt _varIdent (C.MkConditionalExpressionJust (C.MkConstantExpression (C.Expression12 (C.MkCastExpression1 (C.MkUnaryExpressionPostfix (C.MkPostfixExpression1 (C.MkPrimaryExpressionConstant (C.MkConstantInteger (C.IntegerConstant i)) ) ) ) ) ) ) ) ) ) ) = read i extractFieldLength _ = 0 -- -- | Convert a 'String' to camel case, also eliminating the @_t@ at the end if -- present. camelCaseTypeName :: String -> String camelCaseTypeName [] = [] camelCaseTypeName (x:xs) = toUpper x : camelCaseTypeName' xs where camelCaseTypeName' :: String -> String camelCaseTypeName' [] = [] camelCaseTypeName' "_t" = [] camelCaseTypeName' ('_':y:ys) = toUpper y : camelCaseTypeName' ys camelCaseTypeName' (y:ys) = y : camelCaseTypeName' ys ogma-core-1.10.0/src/Language/Trans/SMV2Copilot.hs0000644000000000000000000002116215064246145017657 0ustar0000000000000000-- Copyright 2020 United States Government as represented by the Administrator -- of the National Aeronautics and Space Administration. All Rights Reserved. -- -- Disclaimers -- -- Licensed under the Apache License, Version 2.0 (the "License"); you may -- not use this file except in compliance with the License. You may obtain a -- copy of the License at -- -- https://www.apache.org/licenses/LICENSE-2.0 -- -- Unless required by applicable law or agreed to in writing, software -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the -- License for the specific language governing permissions and limitations -- under the License. -- -- | Transform an SMV TL specification into a Copilot specification. -- -- Normally, this module would be implemented as a conversion between ASTs, -- but we want to add comments to the generated code, which are not -- representable in the abstract syntax tree. module Language.Trans.SMV2Copilot where import Language.SMV.AbsSMV (AdditiveOp (..), BoolConst (..), BoolSpec (..), Ident (..), MultOp (..), NumExpr (..), Number (..), Op1Name (..), OpOne (..), OpTwo (..), OrdOp (..)) -- | Return the Copilot representation of an SMV BoolSpec. -- -- This function returns the temporal property only. The string does not -- contain any top-level names, any imports, or auxiliary definitions that may -- be required. boolSpec2Copilot :: BoolSpec -> String boolSpec2Copilot b = case b of BoolSpecConst bc -> const2Copilot bc BoolSpecNum nc -> numExpr2Copilot nc BoolSpecSignal i -> ident2Copilot i BoolSpecCmp spec1 op2 spec2 -> "(" ++ boolSpec2Copilot spec1 ++ " " ++ ordOp2Copilot op2 ++ " " ++ boolSpec2Copilot spec2 ++ ")" BoolSpecNeg spec -> "(" ++ "not" ++ " " ++ boolSpec2Copilot spec ++ ")" BoolSpecAnd spec1 spec2 -> "(" ++ boolSpec2Copilot spec1 ++ " " ++ "&&" ++ " " ++ boolSpec2Copilot spec2 ++ ")" BoolSpecOr spec1 spec2 -> "(" ++ boolSpec2Copilot spec1 ++ " " ++ "||" ++ " " ++ boolSpec2Copilot spec2 ++ ")" BoolSpecXor spec1 spec2 -> "(" ++ boolSpec2Copilot spec1 ++ " " ++ "`xor`" ++ " " ++ boolSpec2Copilot spec2 ++ ")" BoolSpecImplies spec1 spec2 -> "(" ++ boolSpec2Copilot spec1 ++ " " ++ "==>" ++ " " ++ boolSpec2Copilot spec2 ++ ")" BoolSpecEquivs spec1 spec2 -> "(" ++ boolSpec2Copilot spec1 ++ " " ++ "==" ++ " " ++ boolSpec2Copilot spec2 ++ ")" BoolSpecOp1 op spec -> "(" ++ opOne2Copilot op ++ " " ++ boolSpec2Copilot spec ++ ")" BoolSpecOp2 spec1 op2 spec2 -> "(" ++ boolSpec2Copilot spec1 ++ " " ++ opTwo2Copilot op2 ++ " " ++ boolSpec2Copilot spec2 ++ ")" -- | Return the Copilot representation of an SMV boolean constant. const2Copilot :: BoolConst -> String const2Copilot BoolConstTrue = "true" const2Copilot BoolConstFalse = "false" const2Copilot BoolConstFTP = "ftp" const2Copilot BoolConstLAST = "last" -- | Return the Copilot representation of a numeric expression. numExpr2Copilot :: NumExpr -> String numExpr2Copilot (NumId i) = ident2Copilot i numExpr2Copilot (NumConstI i) = show i numExpr2Copilot (NumConstD i) = show i numExpr2Copilot (NumAdd x op y) = "(" ++ numExpr2Copilot x ++ additiveOp2Copilot op ++ numExpr2Copilot y ++ ")" numExpr2Copilot (NumMult x op y) = "(" ++ numExpr2Copilot x ++ multOp2Copilot op ++ numExpr2Copilot y ++ ")" -- | Return the Copilot representation of an SMV additive operator. additiveOp2Copilot :: AdditiveOp -> String additiveOp2Copilot OpPlus = "+" additiveOp2Copilot OpMinus = "-" -- | Return the Copilot representation of an SMV multiplicative operator. multOp2Copilot :: MultOp -> String multOp2Copilot OpTimes = "*" multOp2Copilot OpDiv = "/" -- | Return the Copilot representation of an SMV comparison operator. ordOp2Copilot :: OrdOp -> String ordOp2Copilot OrdOpLT = "<" ordOp2Copilot OrdOpLE = "<=" ordOp2Copilot OrdOpEQ = "==" ordOp2Copilot OrdOpNE = "/=" ordOp2Copilot OrdOpGT = ">" ordOp2Copilot OrdOpGE = ">=" -- | Return the Copilot representation of a unary logical SMV operator. opOne2Copilot :: OpOne -> String opOne2Copilot (Op1Alone x) = opOneAlone2Copilot x opOne2Copilot (Op1MTL x op v) = opOneMTL2Copilot x op v opOne2Copilot (Op1MTLRange op mn mx) = opOneMTLRange2Copilot op mn mx -- | Return the Copilot representation of a unary logical non-MTL SMV -- operator. opOneAlone2Copilot :: Op1Name -> String opOneAlone2Copilot Op1Pre = "pre" opOneAlone2Copilot Op1X = "next" opOneAlone2Copilot Op1G = "always" opOneAlone2Copilot Op1F = "eventually" opOneAlone2Copilot Op1Y = "PTLTL.previous" opOneAlone2Copilot Op1Z = "notPreviousNot" opOneAlone2Copilot Op1Hist = "PTLTL.alwaysBeen" opOneAlone2Copilot Op1O = "PTLTL.eventuallyPrev" -- | Return the Copilot representation of a unary logical MTL SMV operator. opOneMTL2Copilot :: Op1Name -> OrdOp -> Number -> String opOneMTL2Copilot operator _comparison number = opOneMTL2Copilot' operator ++ " " ++ show (0 :: Int) ++ " " ++ number2Copilot number ++ " " ++ "clock" ++ " " ++ show (1 :: Int) -- | Return the Copilot representation of a unary logical MTL SMV operator -- that uses an explicit range. opOneMTLRange2Copilot :: Op1Name -> Number -> Number -> String opOneMTLRange2Copilot operator mn mx = opOneMTL2Copilot' operator ++ " " ++ number2Copilot mn ++ " " ++ number2Copilot mx ++ " " ++ "clock" ++ " " ++ show (1 :: Int) -- | Return the Copilot representation of a unary logical possibly MTL SMV -- operator. opOneMTL2Copilot' :: Op1Name -> String opOneMTL2Copilot' Op1Pre = "pre" opOneMTL2Copilot' Op1X = "next" opOneMTL2Copilot' Op1G = "always" opOneMTL2Copilot' Op1F = "eventually" opOneMTL2Copilot' Op1Y = "MTL.previous" opOneMTL2Copilot' Op1Z = "notPreviousNot" opOneMTL2Copilot' Op1Hist = "MTL.alwaysBeen" opOneMTL2Copilot' Op1O = "MTL.eventuallyPrev" -- | Return the Copilot representation of an SMV number. number2Copilot :: Number -> String number2Copilot (NumberInt n) = show n -- | Return the Copilot representation of a binary logical non-MTL SMV -- operator. opTwo2Copilot :: OpTwo -> String opTwo2Copilot Op2S = "`since`" opTwo2Copilot Op2T = "`triggers`" opTwo2Copilot Op2V = "`releases`" opTwo2Copilot Op2U = "`until`" -- | Return the Copilot representation of an SMV identifier. ident2Copilot :: Ident -> String ident2Copilot (Ident i) = i -- | Return all identifiers used in a BoolSpec that are not reserved keywords. boolSpecNames :: BoolSpec -> [String] boolSpecNames b = case b of BoolSpecConst _bc -> [] BoolSpecSignal (Ident i) -> [i] BoolSpecNum e -> numExprNames e BoolSpecCmp spec1 _op2 spec2 -> boolSpecNames spec1 ++ boolSpecNames spec2 BoolSpecNeg spec -> boolSpecNames spec BoolSpecAnd spec1 spec2 -> boolSpecNames spec1 ++ boolSpecNames spec2 BoolSpecOr spec1 spec2 -> boolSpecNames spec1 ++ boolSpecNames spec2 BoolSpecXor spec1 spec2 -> boolSpecNames spec1 ++ boolSpecNames spec2 BoolSpecImplies spec1 spec2 -> boolSpecNames spec1 ++ boolSpecNames spec2 BoolSpecEquivs spec1 spec2 -> boolSpecNames spec1 ++ boolSpecNames spec2 BoolSpecOp1 _op spec -> boolSpecNames spec BoolSpecOp2 spec1 _op2 spec2 -> boolSpecNames spec1 ++ boolSpecNames spec2 -- | Return all identifiers used in a numeric expression. numExprNames :: NumExpr -> [String] numExprNames numExpr = case numExpr of NumId (Ident i) -> [i] NumConstI _c -> [] NumConstD _c -> [] NumAdd expr1 _op expr2 -> numExprNames expr1 ++ numExprNames expr2 NumMult expr1 _op expr2 -> numExprNames expr1 ++ numExprNames expr2 ogma-core-1.10.0/src/Language/Trans/CStructs2Copilot.hs0000644000000000000000000001532315064246145020766 0ustar0000000000000000-- Copyright 2020 United States Government as represented by the Administrator -- of the National Aeronautics and Space Administration. All Rights Reserved. -- -- Disclaimers -- -- Licensed under the Apache License, Version 2.0 (the "License"); you may -- not use this file except in compliance with the License. You may obtain a -- copy of the License at -- -- https://www.apache.org/licenses/LICENSE-2.0 -- -- Unless required by applicable law or agreed to in writing, software -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the -- License for the specific language governing permissions and limitations -- under the License. -- -- | Generate Copilot struct definitions and instances from structs defined in -- a C header file. -- -- Working with Copilot structs requires three definitions: the datatype, -- a @Struct@ instance, and a @Typed@ instance. -- -- This module converts the C structs into 'CStruct's, and then converts -- those 'CStruct's into Copilot (i.e., Haskell) data type declarations and -- instance declarations represented as strings. module Language.Trans.CStructs2Copilot where -- External imports import Data.Char ( isUpper, toLower ) import Data.List ( intercalate ) -- External imports: auxiliary import Data.List.Extra ( toHead, toTail ) -- Internal imports: C AST import qualified Language.C.AbsC as C import Language.Copilot.CStruct ( CField (CArray, CPlain), CStruct (..) ) -- Internal imports: Copilot's representation of C structs import Language.Trans.CStruct2CopilotStruct ( camelCaseTypeName, mkCStruct ) -- | Convert all the 'CStruct's in a header file into the declarations needed -- in Copilot to use it. cstructs2CopilotDecls :: C.TranslationUnit -> Either String [ String ] cstructs2CopilotDecls (C.MkTranslationUnit gs) = concat <$> mapM (fmap cstruct2CopilotDecls . mkCStruct) gs -- | Convert a 'CStruct' into the declarations needed in Copilot to use it. cstruct2CopilotDecls :: CStruct -> [ String ] cstruct2CopilotDecls cstruct = [ cStructToCopilotStruct cstruct , structInstance cstruct , typedInstance cstruct ] -- ** Individual conversions -- | Convert a 'CStruct' definition into a Copilot Struct declaration. -- -- For example, given the struct generated by the following definition: -- -- @ -- struct { -- uint8_t f1; -- } a_struct_t; -- @ -- -- the corresponding Haskell definition would be: -- -- @ -- data AStruct = AStruct -- { aSF1 :: Word8 } -- deriving Generic -- @ cStructToCopilotStruct :: CStruct -> String cStructToCopilotStruct cstruct = unlines [ "data " ++ datatype ++ " = " ++ constructor , " deriving Generic" ] where -- The name of the type (e.g., @AStruct@). datatype = cStructName2Haskell (cStructName cstruct) -- The name of the constructor (e.g., @AStruct@). constructor = cStructName2Haskell (cStructName cstruct) ++ "\n" ++ fields -- The fields in the struct (e.g., @aSF1 :: Word 8@), formated as record -- fields: separated by commas, enclosed in curly brackets, and indented. fields = unlines $ map (" " ++) $ (++ ["}"]) $ toTail (", " ++) $ toHead ("{ " ++) $ map (toField cstruct) (cStructFields cstruct) -- Convert a 'CStruct' field into a Copilot record field declaration. -- -- The second case (@CArray@) uses depedent types to promote the length of -- the array to type level. toField :: CStruct -> CField -> String toField cstruct' (CPlain t n) = name ++ " :: " ++ ty where name = fieldName cstruct' n ty = "Field" ++ " " ++ show n ++ " " ++ cTypeName2HaskellType t toField cstruct' (CArray t n l) = name ++ " :: " ++ ty where name = fieldName cstruct' n ty = "Field" ++ " " ++ show n ++ " (" ++ "Array" ++ " " ++ show l ++ " " ++ cTypeName2HaskellType t ++ ")" -- | Convert a 'CStruct' definition into a Copilot @Struct@ instance -- declaration. For example, for the struct: -- -- @ -- struct { -- uint8_t f1; -- } a_struct_t; -- @ -- -- the corresponding @Struct@ instance would be: -- -- @ -- instance Struct AStruct where -- typeName = typeNameDefault -- toValues = toValuesDefault -- @ structInstance :: CStruct -> String structInstance cstruct = unlines [ "instance Struct " ++ instanceName ++ " where" , " typeName = typeNameDefault" , " toValues = toValuesDefault" ] where instanceName = cStructName2Haskell $ cStructName cstruct -- | Convert a 'CStruct' definition to Copilot @Typed@ instance declaration. -- For example, for the struct: -- -- @ -- struct { -- uint8_t f1; -- } a_struct_t; -- @ -- -- the corresponding @Typed@ instance could be: -- -- @ -- instance Typed AStruct where -- typeOf = typeOfDefault -- @ typedInstance :: CStruct -> String typedInstance cstruct = unlines [ "instance Typed " ++ instanceName ++ " where" , " typeOf = typeOfDefault" ] where instanceName = cStructName2Haskell $ cStructName cstruct -- * Auxiliary functions -- | Provide a suitable field name for a record field of a 'CStruct' in Haskell. -- -- For example, given the struct: -- -- @ -- struct { -- uint8_t f1; -- } a_struct_t; -- @ -- -- the field name in the Haskell record would be @aSF1@, where the @aS@ and -- comes from @a_struct_t@ and the final @F1@ comes from @f1@. fieldName :: CStruct -> String -> String fieldName cstruct n = summary (cStructName2Haskell (cStructName cstruct)) ++ cStructName2Haskell n where summary :: String -> String summary = map toLower . filter isUpper -- | Convert a C struct name (e.g., @some_type_t@) to a Haskell type name -- (e.g., @SomeType@). cStructName2Haskell :: String -> String cStructName2Haskell = camelCaseTypeName -- | Return the corresponding type in Copilot/Haskell for a given type. cTypeName2HaskellType :: String -> String cTypeName2HaskellType "float" = "Float" cTypeName2HaskellType "double" = "Double" cTypeName2HaskellType "int" = "Int" cTypeName2HaskellType "uint8_t" = "Word8" cTypeName2HaskellType "uint16_t" = "Word16" cTypeName2HaskellType "uint32_t" = "Word32" cTypeName2HaskellType "uint64_t" = "Word64" cTypeName2HaskellType "int8_t" = "Int8" cTypeName2HaskellType "int16_t" = "Int16" cTypeName2HaskellType "int32_t" = "Int32" cTypeName2HaskellType "int64_t" = "Int64" cTypeName2HaskellType "bool" = "Bool" cTypeName2HaskellType t = camelCaseTypeName t ogma-core-1.10.0/src/Language/Trans/Lustre2Copilot.hs0000644000000000000000000002050415064246145020467 0ustar0000000000000000-- Copyright 2020 United States Government as represented by the Administrator -- of the National Aeronautics and Space Administration. All Rights Reserved. -- -- Disclaimers -- -- Licensed under the Apache License, Version 2.0 (the "License"); you may -- not use this file except in compliance with the License. You may obtain a -- copy of the License at -- -- https://www.apache.org/licenses/LICENSE-2.0 -- -- Unless required by applicable law or agreed to in writing, software -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the -- License for the specific language governing permissions and limitations -- under the License. -- -- | Transform a Lustre specification, extended with temporal logic operators, -- into a Copilot specification. -- -- Normally, this module would be implemented as a conversion between ASTs, -- but we want to add comments to the generated code, which are not -- representable in the abstract syntax tree. module Language.Trans.Lustre2Copilot (boolSpec2Copilot, boolSpecNames) where -- Internal imports import Language.Lustre.AbsLustre (BoolConst (..), BoolNumOp (..), BoolSpec (..), Ident (..), NumExpr (..), NumOp2In (..), Op1Pre (..), Op2In (..), Op2Pre (..)) -- | Return the Copilot representation of a Lustre 'BoolSpec'. -- -- This function returns the temporal property only. The string does not -- contain any top-level names, any imports, or auxiliary definitions that -- may be required. boolSpec2Copilot :: BoolSpec -> String boolSpec2Copilot b = case b of BoolSpecPar bs -> "( " ++ boolSpec2Copilot bs ++ " )" BoolSpecConstI bc -> show bc BoolSpecConstD bc -> show bc BoolSpecConstB bc -> const2Copilot bc BoolSpecSignal i -> ident2Copilot i BoolSpecOp1Pre op spec -> opOnePre2Copilot op ++ " (" ++ boolSpec2Copilot spec ++ ")" BoolSpecOp2In spec1 Op2InPre (BoolSpecOp1Pre Op1Pre spec2) -> "[" ++ lit2Copilot spec1 ++ "] ++ " ++ boolSpec2Copilot spec2 BoolSpecOp2In spec1 Op2InPre spec2 -> "mux ftp (constant " ++ lit2Copilot spec1 ++ ") (" ++ boolSpec2Copilot spec2 ++ ")" BoolSpecOp2In spec1 op2 spec2 -> "(" ++ boolSpec2Copilot spec1 ++ " " ++ opTwoIn2Copilot op2 ++ " " ++ boolSpec2Copilot spec2 ++ ")" BoolSpecOp2Pre op2 spec1 spec2 -> opTwoPre2Copilot op2 ++ " " ++ boolSpec2Copilot spec1 ++ " " ++ boolSpec2Copilot spec2 BoolSpecOp2HT num1 num2 spec -> "MTL.alwaysBeen" ++ " " ++ numExpr2Copilot num2 ++ " " ++ numExpr2Copilot num1 ++ " clock 1" -- clock and min time distance ++ " " ++ boolSpec2Copilot spec BoolSpecOp2OT num1 num2 spec -> "MTL.eventuallyPrev" ++ " " ++ numExpr2Copilot num2 ++ " " ++ numExpr2Copilot num1 ++ " clock 1" -- clock and min time distance ++ " " ++ boolSpec2Copilot spec BoolSpecOp2ST num1 num2 spec1 spec2 -> "MTL.since" ++ " " ++ numExpr2Copilot num1 ++ " " ++ numExpr2Copilot num2 ++ " clock 1" -- clock and min time distance ++ " " ++ boolSpec2Copilot spec1 ++ " " ++ boolSpec2Copilot spec2 -- | Return the Copilot representation of a Lustre numeric -- expression. -- -- This function returns the expression only. The string does not contain any -- top-level names, any imports, or auxiliary definitions that may be required. numExpr2Copilot :: NumExpr -> String numExpr2Copilot expr = case expr of NumExprNum i -> show i NumExprPar iExpr -> "(" ++ numExpr2Copilot iExpr ++ ")" NumExprOp2In iExpr1 op iExpr2 -> "(" ++ numExpr2Copilot iExpr1 ++ " " ++ numOpTwoIn2Copilot op ++ " " ++ numExpr2Copilot iExpr2 ++ ")" NumExprId i -> ident2Copilot i -- | Return the Copilot representation of a numeric Lustre arithmetic -- operator. numOpTwoIn2Copilot :: NumOp2In -> String numOpTwoIn2Copilot NumOp2Plus = "+" numOpTwoIn2Copilot NumOp2Minus = "-" numOpTwoIn2Copilot NumOp2Mult = "*" -- | Return the Copilot representation of a numeric Lustre comparison -- operator. opTwoNum2Copilot :: BoolNumOp -> String opTwoNum2Copilot BoolNumOp2Eq = "==" opTwoNum2Copilot BoolNumOp2Ne = "/=" opTwoNum2Copilot BoolNumOp2Le = "<=" opTwoNum2Copilot BoolNumOp2Lt = "<" opTwoNum2Copilot BoolNumOp2Gt = ">=" opTwoNum2Copilot BoolNumOp2Ge = ">" -- | Return the Copilot representation of a Lustre boolean -- constant. const2Copilot :: BoolConst -> String const2Copilot BoolConstTrue = "true" const2Copilot BoolConstFalse = "false" const2Copilot BoolConstFTP = "ftp" -- | Return the Copilot representation of a Lustre logical -- operator. opOnePre2Copilot :: Op1Pre -> String opOnePre2Copilot Op1Pre = "pre" opOnePre2Copilot Op1YtoPre = "pre" opOnePre2Copilot Op1ZtoPre = "tpre" opOnePre2Copilot Op1Once = "PTLTL.eventuallyPrev" opOnePre2Copilot Op1Hist = "PTLTL.alwaysBeen" opOnePre2Copilot Op1Y = "PTLTL.previous" opOnePre2Copilot Op1Not = "not" opOnePre2Copilot Op1Bang = "not" -- | Return the Copilot representation of a Lustre logical -- operator. opTwoIn2Copilot :: Op2In -> String opTwoIn2Copilot Op2Amp = "&&" opTwoIn2Copilot Op2And = "&&" opTwoIn2Copilot Op2Or = "||" opTwoIn2Copilot Op2Impl = "==>" opTwoIn2Copilot Op2InPre = "pre" opTwoIn2Copilot (Op2NumOp n) = numOpTwoIn2Copilot n opTwoIn2Copilot (Op2NumCmp n) = opTwoNum2Copilot n -- | Return the Copilot representation of a Lustre logical -- operator. opTwoPre2Copilot :: Op2Pre -> String opTwoPre2Copilot Op2SI = "since" opTwoPre2Copilot Op2OT = "ot" -- | Return the Copilot representation of a Lustre identifier. ident2Copilot :: Ident -> String ident2Copilot (Ident "FTP") = "ftp" ident2Copilot (Ident s) = s -- | Return all identifiers used in a BoolSpec that are not reserved keywords. boolSpecNames :: BoolSpec -> [String] boolSpecNames (BoolSpecPar bs) = boolSpecNames bs boolSpecNames (BoolSpecConstI _bc) = [] boolSpecNames (BoolSpecConstD _bc) = [] boolSpecNames (BoolSpecConstB _bc) = [] boolSpecNames (BoolSpecSignal (Ident i)) = [i] boolSpecNames (BoolSpecOp1Pre _op spec) = boolSpecNames spec boolSpecNames (BoolSpecOp2In spec1 _op2 spec2) = boolSpecNames spec1 ++ boolSpecNames spec2 boolSpecNames (BoolSpecOp2Pre _op2 spec1 spec2) = boolSpecNames spec1 ++ boolSpecNames spec2 boolSpecNames (BoolSpecOp2HT num1 num2 spec) = numExprNames num1 ++ numExprNames num2 ++ boolSpecNames spec boolSpecNames (BoolSpecOp2OT num1 num2 spec) = numExprNames num1 ++ numExprNames num2 ++ boolSpecNames spec boolSpecNames (BoolSpecOp2ST num1 num2 spec1 spec2) = numExprNames num1 ++ numExprNames num2 ++ boolSpecNames spec1 ++ boolSpecNames spec2 -- | Return all identifiers used in a NumExpr that are not reserved keywords. numExprNames :: NumExpr -> [String] numExprNames (NumExprNum _i) = [] numExprNames (NumExprPar expr) = numExprNames expr numExprNames (NumExprOp2In expr1 _op expr2) = numExprNames expr1 ++ numExprNames expr2 numExprNames (NumExprId (Ident i)) = [i] -- | Return the Copilot representation of a Lustre literal. lit2Copilot :: BoolSpec -> String lit2Copilot b = case b of BoolSpecConstI bc -> show bc BoolSpecConstD bc -> show bc BoolSpecConstB bc -> litConst2Copilot bc BoolSpecSignal i -> ident2Copilot i _ -> ":error converting literal:" where -- | Return the Copilot representation of a Lustre boolean -- constant. litConst2Copilot :: BoolConst -> String litConst2Copilot BoolConstTrue = "True" litConst2Copilot BoolConstFalse = "False" litConst2Copilot _ = ":error converting literal boolean:" ogma-core-1.10.0/src/Language/Trans/Spec2Copilot.hs0000644000000000000000000002150515064246145020105 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} -- Copyright 2024 United States Government as represented by the Administrator -- Copyright 2024 United States Government as represented by the Administrator -- of the National Aeronautics and Space Administration. All Rights Reserved. -- -- Disclaimers -- -- Licensed under the Apache License, Version 2.0 (the "License"); you may -- not use this file except in compliance with the License. You may obtain a -- copy of the License at -- -- https://www.apache.org/licenses/LICENSE-2.0 -- -- Unless required by applicable law or agreed to in writing, software -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the -- License for the specific language governing permissions and limitations -- under the License. -- | Transform an Ogma specification into a standalone Copilot specification. -- -- Normally, this module would be implemented as a conversion between ASTs, but -- we want to add comments to the generated code, which are not representable -- in the abstract syntax tree. module Language.Trans.Spec2Copilot where -- External imports import Data.List ( intercalate, intersect, lookup, union ) import Data.Maybe ( fromMaybe ) -- External imports: auxiliary import Data.String.Extra ( sanitizeLCIdentifier, sanitizeUCIdentifier ) -- External imports: ogma-spec import Data.OgmaSpec (ExternalVariableDef (..), InternalVariableDef (..), Requirement (..), Spec (..)) -- | For a given spec, return the corresponding Copilot file, or an error -- message if such file cannot be generated. -- -- PRE: there are no name clashes between the variables and names used in the -- specification and any definitions in Haskell's Prelude or in Copilot. spec2Copilot :: forall a . String -- Spec / target file name -> [(String, String)] -- Type substitution table -> ([(String, String)] -> a -> a) -- Expr subsitution function -> (a -> String) -- Expr show function -> Spec a -- Specification -> Either String (String, String, String, String, String) spec2Copilot specName typeMaps exprTransform showExpr spec = pure (externs, internals, reqs, triggers, specName) where -- Extern streams externs = unlines' $ intercalate [""] $ map externVarToDecl (externalVariables spec) where externVarToDecl i = [ propName ++ " :: Stream " ++ "(" ++ safeMap typeMaps (externalVariableType i) ++ ")" , propName ++ " = " ++ "extern" ++ " " ++ show (externalVariableName i) ++ " " ++ "Nothing" ] where propName = safeMap nameSubstitutions (externalVariableName i) -- Internal stream definitions internals = unlines' $ intercalate [""] $ map internalVarToDecl (internalVariables spec) where internalVarToDecl i = (\implem -> [ propName ++ " :: Stream " ++ "(" ++ safeMap typeMaps (internalVariableType i) ++ ")" , propName ++ " = " ++ implem ]) implementation where propName = safeMap nameSubstitutions (internalVariableName i) implementation = (internalVariableExpr i) -- Encoding of requirements as boolean streams reqs :: String reqs = unlines' $ intercalate [""] $ map reqToDecl (requirements spec) where reqToDecl i = [ reqComment, reqSignature , reqBody nameSubstitutions ] where reqName = safeMap nameSubstitutions (requirementName i) -- Definition comment, which includes the requirement for -- traceability purposes. reqComment = "-- | " ++ requirementName i ++ "\n" ++ "-- @" ++ "\n" ++ "-- " ++ requirementDescription i ++ "\n" ++ "-- @" -- Definition type signature. reqSignature = reqName ++ " :: " ++ "Stream" ++ " " ++ "Bool" -- Definition implementation. We use an auxiliary function to -- transform the implementation into Copilot, applying a -- substitution. reqBody subs = reqName ++ " = " ++ (showExpr (exprTransform subs (requirementExpr i))) -- Main specification triggers triggers :: String triggers = unlines' $ fmap reqTrigger (requirements spec) where reqTrigger :: Requirement a -> String reqTrigger r = " trigger " ++ show handlerName ++ " (not " ++ propName ++ ") " ++ handlerArg where handlerName = "handler" ++ sanitizeUCIdentifier (requirementName r) propName = safeMap nameSubstitutions (requirementName r) handlerArg = case (requirementResultType r, requirementResultExpr r) of (Just ty, Just ex) -> "[ arg (" ++ showExpr ex ++ " ) ]" _ -> "[]" -- Map from a variable name to its desired identifier in the code -- generated. internalVariableMap = map (\x -> (x, sanitizeLCIdentifier x)) internalVariableNames externalVariableMap = map (\x -> (x, sanitizeLCIdentifier x)) externalVariableNames requirementNameMap = map (\x -> (x, "prop" ++ sanitizeUCIdentifier x)) requirementNames nameSubstitutions = internalVariableMap ++ externalVariableMap ++ requirementNameMap -- Variable/requirement names used in the input spec. internalVariableNames = map internalVariableName $ internalVariables spec externalVariableNames = map externalVariableName $ externalVariables spec requirementNames = map requirementName $ requirements spec specAnalyze :: Spec a -> Either String (Spec a) specAnalyze spec | not (null evnClash) = Left $ "Name clash detected: " ++ show evnClash | not (null ivnClash) = Left $ "Name clash detected: " ++ show ivnClash | not (null reqClash) = Left $ "Name clash detected: " ++ show reqClash | otherwise = Right spec where -- Sets containing name clashes ivnClash = internalVariableNames' `intersect` (externalVariableNames' `union` requirementNames') evnClash = externalVariableNames' `intersect` (internalVariableNames' `union` requirementNames') reqClash = requirementNames' `intersect` (internalVariableNames' `union` externalVariableNames') -- Names used. internalVariableNames' = map snd internalVariableMap externalVariableNames' = map snd externalVariableMap requirementNames' = map snd requirementNameMap -- Map from a variable name to its desired identifier in the code -- generated. internalVariableMap = map (\x -> (x, sanitizeLCIdentifier x)) internalVariableNames externalVariableMap = map (\x -> (x, sanitizeLCIdentifier x)) externalVariableNames requirementNameMap = map (\x -> (x, "prop" ++ sanitizeUCIdentifier x)) requirementNames -- Variable/requirement names used in the input spec. internalVariableNames = map internalVariableName $ internalVariables spec externalVariableNames = map externalVariableName $ externalVariables spec requirementNames = map requirementName $ requirements spec -- * Auxiliary -- | Substitute a string based on a given substitution table. -- -- This function leaves the key unchanged if it cannot be found in the -- substitution table. safeMap :: [(String, String)] -> String -> String safeMap ls k = fromMaybe k $ lookup k ls -- | Create a string from a list of strings, inserting new line characters -- between them. Unlike 'Prelude.unlines', this function does not insert -- an end of line character at the end of the last string. unlines' :: [String] -> String unlines' = intercalate "\n" ogma-core-1.10.0/src/Language/Trans/CStructs2MsgHandlers.hs0000644000000000000000000000470715064246145021570 0ustar0000000000000000-- Copyright 2020 United States Government as represented by the Administrator -- of the National Aeronautics and Space Administration. All Rights Reserved. -- -- Disclaimers -- -- Licensed under the Apache License, Version 2.0 (the "License"); you may -- not use this file except in compliance with the License. You may obtain a -- copy of the License at -- -- https://www.apache.org/licenses/LICENSE-2.0 -- -- Unless required by applicable law or agreed to in writing, software -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the -- License for the specific language governing permissions and limitations -- under the License. -- -- | Generate C methods that process message dealing with the structs -- defined in a header file. -- -- This module contains the pure conversion from CStructs into C code. -- Normally, this module would be implemented as a conversion between C ASTs, -- but we want to add comments to the generated code, which are not -- representable in the abstract syntax tree. module Language.Trans.CStructs2MsgHandlers where -- Internal imports: C AST representation. import qualified Language.C.AbsC as C ( TranslationUnit (MkTranslationUnit) ) -- Internal imports: Copilot's own CStruct representation. import Language.Copilot.CStruct ( CStruct (cStructName) ) import Language.Trans.CStruct2CopilotStruct ( camelCaseTypeName, mkCStruct ) -- | Generate a C methods that process message dealing with the structs -- defined in a header file. cstructs2MsgHandlers :: C.TranslationUnit -> Either String String cstructs2MsgHandlers (C.MkTranslationUnit gs) = unlines <$> mapM (fmap cstruct2MsgHandler . mkCStruct) gs -- | Generate a C method that processes one message dealing with one -- kind of struct. cstruct2MsgHandler :: CStruct -> String cstruct2MsgHandler cstruct = unlines [ nameCStruct ++ " " ++ nameLocalVar ++ ";" , "" , "/**" , "* Make ICAROUS data available to Copilot and run monitors." , "*/" , "void COPILOT_Process" ++ nameVar ++ "Monitor(void)" , "{" , " " ++ nameCStruct ++ "* msg;" , " msg = (" ++ nameCStruct ++ "*) COPILOTMsgPtr;" , " " ++ nameLocalVar ++ " = *msg;" , "" , " // Run all copilot monitors." , " step();" , "}" ] where nameCStruct = cStructName cstruct nameVar = camelCaseTypeName nameCStruct nameLocalVar = 'm' : 'y' : camelCaseTypeName nameCStruct ogma-core-1.10.0/src/Data/0000755000000000000000000000000015064246145013277 5ustar0000000000000000ogma-core-1.10.0/src/Data/Location.hs0000644000000000000000000000242015064246145015401 0ustar0000000000000000-- Copyright 2020 United States Government as represented by the Administrator -- of the National Aeronautics and Space Administration. All Rights Reserved. -- -- Disclaimers -- -- Licensed under the Apache License, Version 2.0 (the "License"); you may -- not use this file except in compliance with the License. You may obtain a -- copy of the License at -- -- https://www.apache.org/licenses/LICENSE-2.0 -- -- Unless required by applicable law or agreed to in writing, software -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the -- License for the specific language governing permissions and limitations -- under the License. -- -- | Locations where conditions take place (within a file, or outside). module Data.Location ( Location(..) ) where -- | Locations where conditions take place (within a file, or outside). data Location = LocationNothing -- ^ No location info. | LocationFile String -- ^ Within a file. | LocationFileLine String Int -- ^ On a line within a file. | LocationFileLC String Int Int -- ^ On a line and column -- within a file. ogma-core-1.10.0/src/Command/0000755000000000000000000000000015064246145014004 5ustar0000000000000000ogma-core-1.10.0/src/Command/FPrimeApp.hs0000644000000000000000000001774515064246145016201 0ustar0000000000000000{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -- Copyright 2022 United States Government as represented by the Administrator -- of the National Aeronautics and Space Administration. All Rights Reserved. -- -- Disclaimers -- -- Licensed under the Apache License, Version 2.0 (the "License"); you may -- not use this file except in compliance with the License. You may obtain a -- copy of the License at -- -- https://www.apache.org/licenses/LICENSE-2.0 -- -- Unless required by applicable law or agreed to in writing, software -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the -- License for the specific language governing permissions and limitations -- under the License. -- -- | Create components that subscribe -- to obtain data and call Copilot when new values arrive. {- HLINT ignore "Functor law" -} module Command.FPrimeApp ( command , CommandOptions(..) , ErrorCode ) where -- External imports import Control.Applicative ( liftA2, (<|>) ) import qualified Control.Exception as E import Control.Monad.Except ( ExceptT(..), liftEither ) import Data.Aeson ( ToJSON, toJSON ) import Data.Char ( toUpper ) import Data.Maybe ( fromMaybe, mapMaybe, maybeToList ) import GHC.Generics ( Generic ) -- External imports: auxiliary import System.Directory.Extra ( copyTemplate ) import qualified Command.Standalone -- Internal imports: auxiliary import Command.Result (Result (..)) -- Internal imports import Command.Common import Command.Errors (ErrorCode, ErrorTriplet (..)) import Command.VariableDB (InputDef (..), TypeDef (..), VariableDB, findInput, findType, findTypeByType) -- | Generate a new FPrime component connected to Copilot. command :: CommandOptions -- ^ Options to the ROS backend. -> IO (Result ErrorCode) command options = processResult $ do -- Obtain template dir templateDir <- locateTemplateDir mTemplateDir "fprime" templateVars <- parseTemplateVarsFile templateVarsF appData <- command' options functions let subst = mergeObjects (toJSON appData) templateVars -- Expand template ExceptT $ fmap (makeLeftE cannotCopyTemplate) $ E.try $ copyTemplate templateDir subst targetDir where targetDir = commandTargetDir options mTemplateDir = commandTemplateDir options functions = exprPair (commandPropFormat options) templateVarsF = commandExtraVars options command' :: CommandOptions -> ExprPair -> ExceptT ErrorTriplet IO AppData command' options (ExprPair exprT) = do -- Open files needed to fill in details in the template. vs <- parseVariablesFile varNameFile rs <- parseRequirementsListFile handlersFile varDB <- openVarDBFilesWithDefault varDBFile specT <- maybe (return Nothing) (\e -> Just <$> parseInputExpr' e) cExpr specF <- maybe (return Nothing) (\f -> Just <$> parseInputFile' f) fp let spec = specT <|> specF liftEither $ checkArguments spec vs rs copilotM <- sequenceA $ (\spec' -> processSpec spec' fp cExpr) <$> spec let varNames = fromMaybe (specExtractExternalVariables spec) vs monitors = maybe (specExtractHandlers spec) (map (\x -> (x, Nothing))) rs let appData = AppData variables monitors' copilotM variables = mapMaybe (variableMap varDB) varNames monitors' = mapMaybe (monitorMap varDB) monitors return appData where cExpr = commandConditionExpr options fp = commandInputFile options varNameFile = commandVariables options varDBFile = maybeToList $ commandVariableDB options handlersFile = commandHandlers options formatName = commandFormat options propFormatName = commandPropFormat options propVia = commandPropVia options parseInputExpr' e = parseInputExpr e propFormatName propVia exprT parseInputFile' f = parseInputFile f formatName propFormatName propVia exprT processSpec spec' expr' fp' = Command.Standalone.commandLogic expr' fp' "copilot" [] exprT spec' -- ** Argument processing -- | Options used to customize the conversion of specifications to F' -- applications. data CommandOptions = CommandOptions { commandConditionExpr :: Maybe String -- ^ Trigger condition. , commandInputFile :: Maybe FilePath -- ^ Input specification file. , commandTargetDir :: FilePath -- ^ Target directory where the -- component should be created. , commandTemplateDir :: Maybe FilePath -- ^ Directory where the template is -- to be found. , commandVariables :: Maybe FilePath -- ^ File containing a list of -- variables to make available to -- Copilot. , commandVariableDB :: Maybe FilePath -- ^ File containing a list of known -- variables with their types and the -- message IDs they can be obtained -- from. , commandHandlers :: Maybe FilePath -- ^ File containing a list of -- handlers used in the Copilot -- specification. The handlers are -- assumed to receive no arguments. , commandFormat :: String -- ^ Format of the input file. , commandPropFormat :: String -- ^ Format used for input properties. , commandPropVia :: Maybe String -- ^ Use external command to -- pre-process system properties. , commandExtraVars :: Maybe FilePath -- ^ File containing additional -- variables to make available to the -- template. } -- | Return the variable information needed to generate declarations -- and subscriptions for a given variable name and variable database. variableMap :: VariableDB -> String -> Maybe VarDecl variableMap varDB varName = do inputDef <- findInput varDB varName inputDefType <- inputType inputDef let typeDef = findType varDB varName "fprime/port" "C" portType <- maybe (inputType inputDef) (Just . typeFromType) typeDef return $ VarDecl varName inputDefType portType -- | Return the monitor information needed to generate declarations and -- publishers for the given monitor info, and variable database. monitorMap :: VariableDB -> (String, Maybe String) -> Maybe Monitor monitorMap varDB (monitorName, Nothing) = Just $ Monitor monitorName (map toUpper monitorName) Nothing Nothing monitorMap varDB (monitorName, Just ty) = do let tyPort = maybe ty typeFromType $ findTypeByType varDB "fprime/port" "C" ty return $ Monitor monitorName (map toUpper monitorName) (Just ty) (Just tyPort) -- | The declaration of a variable in C, with a given type and name. data VarDecl = VarDecl { varDeclName :: String , varDeclType :: String , varDeclFPrimeType :: String } deriving Generic instance ToJSON VarDecl data Monitor = Monitor { monitorName :: String , monitorUC :: String , monitorType :: Maybe String , monitorPortType :: Maybe String } deriving Generic instance ToJSON Monitor -- | Data that may be relevant to generate a ROS application. data AppData = AppData { variables :: [VarDecl] , monitors :: [Monitor] , copilot :: Maybe Command.Standalone.AppData } deriving (Generic) instance ToJSON AppData ogma-core-1.10.0/src/Command/VariableDB.hs0000644000000000000000000002512215064246145016275 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright 2022 United States Government as represented by the Administrator -- of the National Aeronautics and Space Administration. All Rights Reserved. -- -- Disclaimers -- -- Licensed under the Apache License, Version 2.0 (the "License"); you may -- not use this file except in compliance with the License. You may obtain a -- copy of the License at -- -- https://www.apache.org/licenses/LICENSE-2.0 -- -- Unless required by applicable law or agreed to in writing, software -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the -- License for the specific language governing permissions and limitations -- under the License. -- -- | Variable DBs. module Command.VariableDB ( VariableDB(..) , InputDef(..) , Connection(..) , TopicDef(..) , TypeDef(..) , emptyVariableDB , findInput , findConnection , findTopic , findType , findTypeByType , mergeVariableDB ) where -- External imports import Control.Monad.Except (ExceptT, throwError) import Data.Aeson (FromJSON (..)) import Data.Aeson.TH (defaultOptions, deriveFromJSON, fieldLabelModifier) import Data.Char (toLower) import Data.List (find) import Data.Maybe (isNothing) import GHC.Generics (Generic) -- External imports: auxiliary import Data.List.Extra (toHead) import Data.Location (Location(..)) -- Internal imports import Command.Errors (ErrorTriplet(..), ErrorCode) -- * Variable Databases -- | A variable database. data VariableDB = VariableDB { inputs :: [InputDef] , topics :: [TopicDef] , types :: [TypeDef] } deriving (Generic, Show) -- | Definition of an input variable. data InputDef = InputDef { inputName :: String , inputType :: Maybe String , inputConnections :: [ Connection ] } deriving (Eq, Show) -- | Definition of a connection to a topic. data Connection = Connection { connectionScope :: String , connectionTopic :: String , connectionField :: Maybe String } deriving (Eq, Show) -- | Definition of a topic. data TopicDef = TopicDef { topicScope :: String , topicTopic :: String , topicType :: String } deriving (Eq, Show) -- | Definition of a type or type mapping. data TypeDef = TypeDef { typeFromScope :: String , typeFromType :: String , typeFromField :: Maybe String , typeToScope :: String , typeToType :: String } deriving (Eq, Show) -- | A variable database with no entries. emptyVariableDB :: VariableDB emptyVariableDB = VariableDB [] [] [] -- | Find an input with a given name. findInput :: VariableDB -> String -> Maybe InputDef findInput varDB name = find (\x -> inputName x == name) (inputs varDB) -- | Find a connection a given scope. findConnection :: InputDef -> String -> Maybe Connection findConnection inputDef scope = find (\x -> connectionScope x == scope) (inputConnections inputDef) -- | Find a topic a given scope and name. findTopic :: VariableDB -> String -> String -> Maybe TopicDef findTopic varDB scope name = find (\x -> topicScope x == scope && topicTopic x == name) (topics varDB) -- | Find a type with a given input name, scope, and destination system. findType :: VariableDB -> String -> String -> String -> Maybe TypeDef findType varDB name scope destConn = do inputDef <- findInput varDB name let connectionDef :: Maybe Connection connectionDef = findConnection inputDef scope field :: Maybe String field = connectionField =<< connectionDef topic :: Maybe String topic = connectionTopic <$> connectionDef topicDef :: Maybe TopicDef topicDef = findTopic varDB scope =<< topic ty :: Maybe String ty = topicType <$> topicDef let match :: TypeDef -> Bool match typeDef = case (inputType inputDef, ty) of (Just ty1, Nothing) -> typeFromScope typeDef == scope && typeFromField typeDef == field && typeToScope typeDef == destConn && typeToType typeDef == ty1 (Just ty1, Just ty2) -> typeFromScope typeDef == scope && typeFromType typeDef == ty2 && typeFromField typeDef == field && typeToScope typeDef == destConn && typeToType typeDef == ty1 (_ , Just ty2) -> typeFromScope typeDef == scope && typeFromType typeDef == ty2 && typeFromField typeDef == field && typeToScope typeDef == destConn (Nothing, Nothing) -> False find match (types varDB) -- | Find a type definition for a given scope, and destination system, and -- destination type. findTypeByType :: VariableDB -> String -> String -> String -> Maybe TypeDef findTypeByType varDB fromScope toScope toType = do let match :: TypeDef -> Bool match typeDef = typeFromScope typeDef == fromScope && typeToScope typeDef == toScope && typeToType typeDef == toType find match (types varDB) -- ** Merging of variable DBs -- | Merge two variable DBs, so long as they do not contain contradictory -- information. mergeVariableDB :: Monad m => VariableDB -> VariableDB -> ExceptT ErrorTriplet m VariableDB mergeVariableDB varDB1 varDB2 = do inputs' <- mergeInputs (inputs varDB1) (inputs varDB2) topics' <- mergeTopics (topics varDB1) (topics varDB2) types' <- mergeTypes (types varDB1) (types varDB2) return $ VariableDB inputs' topics' types' -- | Merge two lists of input definitions, so long as they do not contain -- contradictory information. mergeInputs :: Monad m => [InputDef] -> [InputDef] -> ExceptT ErrorTriplet m [InputDef] mergeInputs is1 [] = return is1 mergeInputs is1 (i2:is2) = do is1' <- mergeInput is1 i2 mergeInputs is1' is2 -- | Merge an input definition into a list of input definitions, so long as it -- does not contain contradictory information. mergeInput :: Monad m => [InputDef] -> InputDef -> ExceptT ErrorTriplet m [InputDef] mergeInput [] i2 = return [i2] mergeInput (i1:is1) i2 | inputName i1 == inputName i2 && ( isNothing (inputType i1) || isNothing (inputType i2) || inputType i1 == inputType i2 ) = do cs <- mergeConnections (inputConnections i1) (inputConnections i2) let i1' = i1 { inputType = mergeMaybe (inputType i1) (inputType i2) , inputConnections = cs } return (i1' : is1) | otherwise = do is1' <- mergeInput is1 i2 return $ i1 : is1' -- | Merge two lists of connections, so long as they do not contain -- contradictory information. mergeConnections :: Monad m => [Connection] -> [Connection] -> ExceptT ErrorTriplet m [Connection] mergeConnections cs1 [] = return cs1 mergeConnections cs1 (c2:cs2) = do cs1' <- mergeConnection cs1 c2 mergeConnections cs1' cs2 -- | Merge a connection into a list of connections, so long as it does not -- contain contradictory information. mergeConnection :: Monad m => [Connection] -> Connection -> ExceptT ErrorTriplet m [Connection] mergeConnection [] c2 = return [c2] mergeConnection (c1:cs1) c2 | c1 == c2 = return $ c1 : cs1 | connectionScope c1 == connectionScope c2 = throwError $ cannotMergeVariableDBs "connections with the same scopes" | otherwise = do cs1' <- mergeConnection cs1 c2 return (c1 : cs1') -- | Merge two lists of topics, so long as they do not contain contradictory -- information. mergeTopics :: Monad m => [TopicDef] -> [TopicDef] -> ExceptT ErrorTriplet m [TopicDef] mergeTopics ts1 [] = return ts1 mergeTopics ts1 (t2:ts2) = do ts1' <- mergeTopic ts1 t2 mergeTopics ts1' ts2 -- | Merge a topic into a list of topics, so long as it does not contain -- contradictory information. mergeTopic :: Monad m => [TopicDef] -> TopicDef -> ExceptT ErrorTriplet m [TopicDef] mergeTopic [] t2 = return [t2] mergeTopic (t1:ts1) t2 | t1 == t2 = return $ t1 : ts1 | topicScope t1 == topicScope t2 && topicTopic t1 == topicTopic t2 = throwError $ cannotMergeVariableDBs "topics with the same scopes and different types" | otherwise = do ts1' <- mergeTopic ts1 t2 return (t1 : ts1') -- | Merge two lists of type definitions, so long as they do not contain -- contradictory information. mergeTypes :: Monad m => [TypeDef] -> [TypeDef] -> ExceptT ErrorTriplet m [TypeDef] mergeTypes ts1 [] = return ts1 mergeTypes ts1 (t2:ts2) = do ts1' <- mergeType ts1 t2 mergeTypes ts1' ts2 -- | Merge a type definition into a list of type definitions, so long as it -- does not contain contradictory information. mergeType :: Monad m => [TypeDef] -> TypeDef -> ExceptT ErrorTriplet m [TypeDef] mergeType [] t2 = return [t2] mergeType (t1:ts1) t2 | t1 == t2 = return $ t1 : ts1 | typeFromScope t1 == typeFromScope t2 && typeFromType t1 == typeFromType t2 && typeToScope t1 == typeToScope t2 = throwError $ cannotMergeVariableDBs "types with the same scopes and from types but otherwise different" | otherwise = do ts1' <- mergeType ts1 t2 return (t1 : ts1') -- | Exception handler to deal with the case of variable DB files that cannot -- be merged due to having incompatible information. cannotMergeVariableDBs :: String -> ErrorTriplet cannotMergeVariableDBs element = ErrorTriplet ecCannotMergeVariableDB msg LocationNothing where msg = "Reading variable DBs has failed due to them having incompatible" ++ " information for " ++ element ++ "." -- | Error: one of the variable DBs provided cannot be merged. ecCannotMergeVariableDB :: ErrorCode ecCannotMergeVariableDB = 1 -- | Merge two @Maybe@ values, prefering the left one if two @Just@s are -- provided. mergeMaybe :: Maybe a -> Maybe a -> Maybe a mergeMaybe Nothing x = x mergeMaybe x Nothing = x mergeMaybe x _ = x -- | Implement default instances of parser to read variable DB from JSON, -- dropping the prefix in each field name. deriveFromJSON defaultOptions {fieldLabelModifier = toHead toLower . drop 4 } ''TypeDef deriveFromJSON defaultOptions {fieldLabelModifier = toHead toLower . drop 5 } ''TopicDef deriveFromJSON defaultOptions {fieldLabelModifier = toHead toLower . drop 10 } ''Connection deriveFromJSON defaultOptions {fieldLabelModifier = toHead toLower . drop 5 } ''InputDef instance FromJSON VariableDB ogma-core-1.10.0/src/Command/ROSApp.hs0000644000000000000000000002373615064246145015457 0ustar0000000000000000{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -- Copyright 2022 United States Government as represented by the Administrator -- of the National Aeronautics and Space Administration. All Rights Reserved. -- -- Disclaimers -- -- Licensed under the Apache License, Version 2.0 (the "License"); you may -- not use this file except in compliance with the License. You may obtain a -- copy of the License at -- -- https://www.apache.org/licenses/LICENSE-2.0 -- -- Unless required by applicable law or agreed to in writing, software -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the -- License for the specific language governing permissions and limitations -- under the License. -- -- | Create (ROS) applications -- that subscribe to obtain data and call Copilot when new values arrive. -- -- It is the user's responsibility to modify the generated Copilot/C/C++ code -- to deal with the monitors they'd like to implement, and the data they must -- manipulate. {- HLINT ignore "Functor law" -} module Command.ROSApp ( command , CommandOptions(..) , Node(Node) , ErrorCode ) where -- External imports import Control.Applicative (liftA2, (<|>)) import qualified Control.Exception as E import Control.Monad.Except (ExceptT (..), liftEither) import Data.Aeson (ToJSON (..)) import Data.Maybe (fromMaybe, mapMaybe, maybeToList) import GHC.Generics (Generic) -- External imports: auxiliary import System.Directory.Extra (copyTemplate) import qualified Command.Standalone -- Internal imports: auxiliary import Command.Result (Result (..)) -- Internal imports import Command.Common import Command.Errors (ErrorCode, ErrorTriplet (..)) import Command.VariableDB (Connection (..), InputDef (..), TopicDef (..), TypeDef (..), VariableDB, findConnection, findInput, findTopic, findType, findTypeByType) -- | Generate a new ROS application connected to Copilot. command :: CommandOptions -- ^ Options to the ROS backend. -> IO (Result ErrorCode) command options = processResult $ do -- Obtain template dir templateDir <- locateTemplateDir mTemplateDir "ros" templateVars <- parseTemplateVarsFile templateVarsF appData <- command' options functions let subst = mergeObjects (toJSON appData) templateVars -- Expand template ExceptT $ fmap (makeLeftE cannotCopyTemplate) $ E.try $ copyTemplate templateDir subst targetDir where targetDir = commandTargetDir options mTemplateDir = commandTemplateDir options functions = exprPair (commandPropFormat options) templateVarsF = commandExtraVars options command' :: CommandOptions -> ExprPair -> ExceptT ErrorTriplet IO AppData command' options (ExprPair exprT) = do -- Open files needed to fill in details in the template. vs <- parseVariablesFile varNameFile rs <- parseRequirementsListFile handlersFile varDB <- openVarDBFilesWithDefault varDBFile specT <- maybe (return Nothing) (\e -> Just <$> parseInputExpr' e) cExpr specF <- maybe (return Nothing) (\f -> Just <$> parseInputFile' f) fp let spec = specT <|> specF liftEither $ checkArguments spec vs rs copilotM <- sequenceA $ (\spec' -> processSpec spec' fp cExpr) <$> spec let varNames = fromMaybe (specExtractExternalVariables spec) vs monitors = maybe (specExtractHandlers spec) (map (\x -> (x, Nothing))) rs let appData = AppData variables monitors' copilotM testingAdditionalApps testingVars variables = mapMaybe (variableMap varDB) varNames monitors' = mapMaybe (monitorMap varDB) monitors testingVars | null testingLimitedVars = variables | otherwise = filter (\x -> varDeclName x `elem` testingLimitedVars) variables return appData where cExpr = commandConditionExpr options fp = commandInputFile options varNameFile = commandVariables options varDBFile = maybeToList $ commandVariableDB options handlersFile = commandHandlers options formatName = commandFormat options propFormatName = commandPropFormat options propVia = commandPropVia options parseInputExpr' e = parseInputExpr e propFormatName propVia exprT parseInputFile' f = parseInputFile f formatName propFormatName propVia exprT processSpec spec' expr' fp' = Command.Standalone.commandLogic expr' fp' "copilot" [] exprT spec' testingAdditionalApps = commandTestingApps options testingLimitedVars = commandTestingVars options -- ** Argument processing -- | Options used to customize the conversion of specifications to ROS -- applications. data CommandOptions = CommandOptions { commandConditionExpr :: Maybe String -- ^ Trigger condition. , commandInputFile :: Maybe FilePath -- ^ Input specification file. , commandTargetDir :: FilePath -- ^ Target directory where the -- application should be created. , commandTemplateDir :: Maybe FilePath -- ^ Directory where the template is -- to be found. , commandVariables :: Maybe FilePath -- ^ File containing a list of -- variables to make available to -- Copilot. , commandVariableDB :: Maybe FilePath -- ^ File containing a list of known -- variables with their types and the -- message IDs they can be obtained -- from. , commandHandlers :: Maybe FilePath -- ^ File containing a list of -- handlers used in the Copilot -- specification. The handlers are -- assumed to receive no arguments. , commandFormat :: String -- ^ Format of the input file. , commandPropFormat :: String -- ^ Format used for input properties. , commandPropVia :: Maybe String -- ^ Use external command to -- pre-process system properties. , commandExtraVars :: Maybe FilePath -- ^ File containing additional -- variables to make available to the -- template. , commandTestingApps :: [Node] -- ^ Additional applications to turn -- on during testing. , commandTestingVars :: [String] -- ^ Limited list of variables to use -- for testing. } -- | Return the variable information needed to generate declarations -- and subscriptions for a given variable name and variable database. variableMap :: VariableDB -> String -> Maybe VarDecl variableMap varDB varName = do inputDef <- findInput varDB varName mid <- connectionTopic <$> findConnection inputDef "ros/message" topicDef <- findTopic varDB "ros/message" mid typeVar' <- maybe (inputType inputDef) (Just . typeToType) (findType varDB varName "ros/variable" "C") let typeMsg' = fromMaybe (topicType topicDef) (typeFromType <$> findType varDB varName "ros/message" "C") return $ VarDecl varName typeVar' mid typeMsg' (randomBaseType typeVar') -- | Return the monitor information needed to generate declarations and -- publishers for the given monitor info, and variable database. monitorMap :: VariableDB -> (String, Maybe String) -> Maybe Monitor monitorMap varDB (monitorName, Nothing) = Just $ Monitor monitorName Nothing Nothing monitorMap varDB (monitorName, Just ty) = do let ty1 = maybe ty typeFromType $ findTypeByType varDB "ros/variable" "C" ty ty2 <- typeFromType <$> findTypeByType varDB "ros/message" "C" ty return $ Monitor monitorName (Just ty1) (Just ty2) -- | The declaration of a variable in C, with a given type and name. data VarDecl = VarDecl { varDeclName :: String , varDeclType :: String , varDeclId :: String , varDeclMsgType :: String , varDeclRandom :: String } deriving Generic instance ToJSON VarDecl -- | The name of a handler associated to each condition, and the type -- of value it receives, together with the type for the message. data Monitor = Monitor { monitorName :: String , monitorType :: Maybe String , monitorMsgType :: Maybe String } deriving Generic instance ToJSON Monitor -- | A package-qualified ROS 2 node name. data Node = Node { nodePackage :: String , nodeName :: String } deriving Generic instance ToJSON Node -- | Data that may be relevant to generate a ROS application. data AppData = AppData { variables :: [VarDecl] , monitors :: [Monitor] , copilot :: Maybe Command.Standalone.AppData , testingApps :: [Node] , testingVariables :: [VarDecl] } deriving (Generic) instance ToJSON AppData -- | Name of the function to be used to generate random values of a given type. randomBaseType :: String -- ^ Type to generate random values of. -> String randomBaseType ty = case ty of "bool" -> "randomBool" "uint8_t" -> "randomInt" "uint16_t" -> "randomInt" "uint32_t" -> "randomInt" "uint64_t" -> "randomInt" "int8_t" -> "randomInt" "int16_t" -> "randomInt" "int32_t" -> "randomInt" "int64_t" -> "randomInt" "float" -> "randomFloat" "double" -> "randomFloat" def -> def ogma-core-1.10.0/src/Command/Standalone.hs0000644000000000000000000002343515064246145016437 0ustar0000000000000000{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -- Copyright 2020 United States Government as represented by the Administrator -- of the National Aeronautics and Space Administration. All Rights Reserved. -- -- Disclaimers -- -- Licensed under the Apache License, Version 2.0 (the "License"); you may -- not use this file except in compliance with the License. You may obtain a -- copy of the License at -- -- https://www.apache.org/licenses/LICENSE-2.0 -- -- Unless required by applicable law or agreed to in writing, software -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the -- License for the specific language governing permissions and limitations -- under the License. -- -- | Transform a specification into a standalone Copilot specification. module Command.Standalone ( command , commandLogic , AppData , CommandOptions(..) , ErrorCode ) where -- External imports import Control.Applicative ((<|>)) import Control.Exception as E import Control.Monad.Except (ExceptT (..), liftEither) import Data.Aeson (ToJSON (..)) import Data.List (nub, (\\)) import Data.Maybe (fromMaybe) import GHC.Generics (Generic) -- External imports: Ogma import Data.OgmaSpec (ExternalVariableDef (..), InternalVariableDef (..), Requirement (..), Spec (..)) import System.Directory.Extra (copyTemplate) -- Internal imports import Command.Common import Command.Errors (ErrorCode, ErrorTriplet(..)) import Command.Result (Result (..)) import Data.Location (Location (..)) import Language.Trans.Spec2Copilot (spec2Copilot, specAnalyze) -- | Generate a new standalone Copilot monitor that implements the spec in an -- input file. -- -- PRE: The file given is readable, contains a valid file with recognizable -- format, the formulas in the file do not use any identifiers that exist in -- Copilot, or any of @prop@, @clock@, @ftp@, @notPreviousNot@. All identifiers -- used are valid C99 identifiers. The template, if provided, exists and uses -- the variables needed by the standalone application generator. The target -- directory is writable and there's enough disk space to copy the files over. command :: CommandOptions -- ^ Customization options -> IO (Result ErrorCode) command options = processResult $ do -- Obtain template dir templateDir <- locateTemplateDir mTemplateDir "standalone" templateVars <- parseTemplateVarsFile templateVarsF appData <- command' options functions let subst = mergeObjects (toJSON appData) templateVars -- Expand template ExceptT $ fmap (makeLeftE cannotCopyTemplate) $ E.try $ copyTemplate templateDir subst targetDir where targetDir = commandTargetDir options mTemplateDir = commandTemplateDir options functions = exprPair (commandPropFormat options) templateVarsF = commandExtraVars options -- | Generate a new standalone Copilot monitor that implements the spec in an -- input file, using a subexpression handler. -- -- PRE: The file given is readable, contains a valid file with recognizable -- format, the formulas in the file do not use any identifiers that exist in -- Copilot, or any of @prop@, @clock@, @ftp@, @notPreviousNot@. All identifiers -- used are valid C99 identifiers. The template, if provided, exists and uses -- the variables needed by the standalone application generator. The target -- directory is writable and there's enough disk space to copy the files over. command' :: CommandOptions -> ExprPair -> ExceptT ErrorTriplet IO AppData command' options (ExprPair exprT) = do -- Read spec and complement the specification with any missing/implicit -- definitions. specT <- maybe (return Nothing) (\e -> Just <$> parseInputExpr' e) triggerExprM specF <- maybe (return Nothing) (\f -> Just <$> parseInputFile' f) fpM let spec = specT <|> specF case spec of Nothing -> liftEither $ Left $ commandMissingSpec Just spec' -> commandLogic triggerExprM fpM name typeMaps exprT spec' where triggerExprM = commandConditionExpr options fpM = commandInputFile options name = commandFilename options typeMaps = typeToCopilotTypeMapping (commandTypeMapping options) formatName = commandFormat options propFormatName = commandPropFormat options propVia = commandPropVia options parseInputExpr' e = parseInputExpr e propFormatName propVia exprT parseInputFile' f = parseInputFile f formatName propFormatName propVia exprT -- | Generate the data of a new standalone Copilot monitor that implements the -- spec, using a subexpression handler. commandLogic :: Maybe String -> Maybe FilePath -> String -> [(String, String)] -> ExprPairT a -> Spec a -> ExceptT ErrorTriplet IO AppData commandLogic expr fp name typeMaps exprT input = do let spec = addMissingIdentifiers ids input -- Analyze the spec for incorrect identifiers and convert it to Copilot. -- If there is an error, we change the error to a message we control. let appData = mapLeft commandIncorrectSpec' $ do spec' <- specAnalyze spec res <- spec2Copilot name typeMaps replace print spec' -- Pack the results let (ext, int, reqs, trigs, specN) = res return $ AppData ext int reqs trigs specN liftEither appData where commandIncorrectSpec' = case (expr, fp) of (Nothing, Just fp') -> commandIncorrectSpecF fp' (Just expr', _) -> commandIncorrectSpecE expr' (_, _) -> error "Both expression and file are missing" ExprPairT parse replace print ids def = exprT -- ** Argument processing -- | Options used to customize the conversion of specifications to Copilot -- code. data CommandOptions = CommandOptions { commandConditionExpr :: Maybe String , commandInputFile :: Maybe FilePath -- ^ Input specification file. , commandTargetDir :: FilePath -- ^ Target directory where the -- application should be created. , commandTemplateDir :: Maybe FilePath -- ^ Directory where the template -- is to be found. , commandFormat :: String -- ^ Format of the input file. , commandPropFormat :: String -- ^ Format used for input -- properties. , commandTypeMapping :: [(String, String)] , commandFilename :: String , commandPropVia :: Maybe String -- ^ Use external command to -- pre-process system properties. , commandExtraVars :: Maybe FilePath -- ^ File containing additional -- variables to make available to the -- template. } -- * Mapping of types from input format to Copilot typeToCopilotTypeMapping :: [(String, String)] -> [(String, String)] typeToCopilotTypeMapping types = [ ("bool", "Bool") , ("int", intType) , ("integer", intType) , ("real", realType) , ("string", "String") , ("", "_") ] where intType = fromMaybe "Int64" $ lookup "int" types realType = fromMaybe "Float" $ lookup "real" types -- | Data that may be relevant to generate a ROS application. data AppData = AppData { externs :: String , internals :: String , reqs :: String , triggers :: String , specName :: String } deriving (Generic) instance ToJSON AppData -- | Error message associated to not having a spec of any kind. commandMissingSpec :: ErrorTriplet commandMissingSpec = ErrorTriplet ecMissingSpec msg LocationNothing where msg = "No input specification has been provided." -- | Error message associated to not being able to formalize the input spec. commandIncorrectSpecF :: String -> String -> ErrorTriplet commandIncorrectSpecF file e = ErrorTriplet ecIncorrectSpec msg (LocationFile file) where msg = "The input specification " ++ file ++ " canbot be formalized: " ++ e -- | Error message associated to not being able to formalize the input spec. commandIncorrectSpecE :: String -> String -> ErrorTriplet commandIncorrectSpecE expr e = ErrorTriplet ecIncorrectSpec msg LocationNothing where msg = "The input specification " ++ show expr ++ " cannot be formalized: " ++ e -- ** Error codes -- | Error: there is no input argument. ecMissingSpec :: ErrorCode ecMissingSpec = 1 -- | Error: the input specification cannot be formalized. ecIncorrectSpec :: ErrorCode ecIncorrectSpec = 1 -- | Add to a spec external variables for all identifiers mentioned in -- expressions that are not defined anywhere. addMissingIdentifiers :: (a -> [String]) -> Spec a -> Spec a addMissingIdentifiers f s = s { externalVariables = vars' } where vars' = externalVariables s ++ newVars newVars = map (\n -> ExternalVariableDef n "") newVarNames -- Names that are not defined anywhere newVarNames = identifiers \\ existingNames -- Identifiers being mentioned in the requirements. identifiers = nub $ concatMap (f . requirementExpr) (requirements s) -- Names that are defined in variables. existingNames = map externalVariableName (externalVariables s) ++ map internalVariableName (internalVariables s) mapLeft :: (a -> c) -> Either a b -> Either c b mapLeft f (Left x) = Left (f x) mapLeft _ (Right x) = Right x ogma-core-1.10.0/src/Command/Common.hs0000644000000000000000000004724715064246145015606 0ustar0000000000000000{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -- Copyright 2022 United States Government as represented by the Administrator -- of the National Aeronautics and Space Administration. All Rights Reserved. -- -- Disclaimers -- -- Licensed under the Apache License, Version 2.0 (the "License"); you may -- not use this file except in compliance with the License. You may obtain a -- copy of the License at -- -- https://www.apache.org/licenses/LICENSE-2.0 -- -- Unless required by applicable law or agreed to in writing, software -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the -- License for the specific language governing permissions and limitations -- under the License. -- -- | Shared functions across multiple backends. module Command.Common ( parseInputExpr , parseInputFile , parseVariablesFile , parseRequirementsListFile , openVarDBFiles , openVarDBFilesWithDefault , parseTemplateVarsFile , checkArguments , specExtractExternalVariables , specExtractHandlers , ExprPair(..) , ExprPairT(..) , exprPair , processResult , cannotCopyTemplate , makeLeftE , mergeObjects , locateTemplateDir ) where -- External imports import qualified Control.Exception as E import Control.Monad.Except (ExceptT (..), runExceptT, throwError) import Control.Monad.IO.Class (liftIO) import Data.Aeson (Value (Null, Object), eitherDecode, eitherDecodeFileStrict, object) import Data.Aeson.KeyMap (union) import qualified Data.ByteString.Lazy as L import Data.List (isInfixOf, isPrefixOf) import System.Directory (doesFileExist) import System.FilePath (()) import System.Process (readProcess) -- External imports: auxiliary import Data.ByteString.Extra as B (safeReadFile) import Data.String.Extra (sanitizeLCIdentifier, sanitizeUCIdentifier) -- External imports: ogma import Data.OgmaSpec (Requirement (..), Spec (..), externalVariableName, externalVariables, requirementName, requirementResultType, requirements) import Language.CSVSpec.Parser (parseCSVSpec) import Language.JSONSpec.Parser (parseJSONSpec) import Language.XLSXSpec.Parser (parseXLSXSpec) import Language.XMLSpec.Parser (parseXMLSpec) -- External imports: language ASTs, transformers import qualified Language.Lustre.AbsLustre as Lustre import qualified Language.Lustre.ParLustre as Lustre (myLexer, pBoolSpec) import qualified Language.SMV.AbsSMV as SMV import qualified Language.SMV.ParSMV as SMV (myLexer, pBoolSpec) import Language.SMV.Substitution (substituteBoolExpr) import qualified Language.Trans.Lustre2Copilot as Lustre (boolSpec2Copilot, boolSpecNames) import Language.Trans.SMV2Copilot as SMV (boolSpec2Copilot, boolSpecNames) -- Internal imports: VariableDBs import Command.VariableDB (VariableDB, emptyVariableDB, mergeVariableDB) -- Internal imports: auxiliary import Command.Errors (ErrorTriplet(..), ErrorCode) import Command.Result (Result (..)) import Data.Location (Location (..)) import Paths_ogma_core (getDataDir) -- | Process input specification from a single expression and return its -- abstract representation. parseInputExpr :: String -> String -> Maybe String -> ExprPairT a -> ExceptT ErrorTriplet IO (Spec a) parseInputExpr expr propFormatName propVia exprT = ExceptT $ do let ExprPairT parse replace print ids def = exprT let wrapper = wrapVia propVia parse result <- wrapper expr let spec = do expr' <- result let req = Requirement "triggerCondition" expr' "" Nothing Nothing return $ Spec [] [] [ req ] case spec of Left e -> return $ Left $ cannotReadConditionExpr expr e Right s -> return $ Right s -- | Process input specification, if available, and return its abstract -- representation. parseInputFile :: FilePath -> String -> String -> Maybe String -> ExprPairT a -> ExceptT ErrorTriplet IO (Spec a) parseInputFile fp formatName propFormatName propVia exprT = ExceptT $ do let ExprPairT parse replace print ids def = exprT let wrapper = wrapVia propVia parse -- Obtain format file. -- -- A format name that exists as a file in the disk always takes preference -- over a file format included with Ogma. A file format with a forward -- slash in the name is always assumed to be a user-provided filename. -- Regardless of whether the file is user-provided or known to Ogma, we -- check (again) whether the file exists, and print an error message if -- not. exists <- doesFileExist formatName dataDir <- getDataDir let formatFile | isInfixOf "/" formatName || exists = formatName | otherwise = dataDir "data" "formats" (formatName ++ "_" ++ propFormatName) formatMissing <- not <$> doesFileExist formatFile if formatMissing then return $ Left $ commandIncorrectFormatSpec formatFile else do res <- do format <- readFile formatFile -- All of the following operations use Either to return error -- messages. The use of the monadic bind to pass arguments from one -- function to the next will cause the program to stop at the -- earliest error. if | isPrefixOf "XMLFormat" format -> do let xmlFormat = read format content <- readFile fp parseXMLSpec (wrapper) (def) xmlFormat content -- (fmap (fmap print) . wrapper) (print def) xmlFormat content | isPrefixOf "CSVFormat" format -> do let csvFormat = read format content <- readFile fp parseCSVSpec wrapper def csvFormat content | isPrefixOf "XLSXFormat" format -> do let xlsxFormat = read format content <- L.readFile fp parseXLSXSpec wrapper def xlsxFormat content | otherwise -> do let jsonFormat = read format content <- B.safeReadFile fp case content of Left e -> return $ Left e Right b -> do case eitherDecode b of Left e -> return $ Left e Right v -> parseJSONSpec (wrapper) jsonFormat v case res of Left e -> return $ Left $ cannotOpenInputFile fp Right x -> return $ Right x -- | Process a variable selection file, if available, and return the variable -- names. parseVariablesFile :: Maybe FilePath -> ExceptT ErrorTriplet IO (Maybe [String]) parseVariablesFile Nothing = return Nothing parseVariablesFile (Just fp) = do -- Fail if the file cannot be opened. varNamesE <- liftIO $ E.try $ lines <$> readFile fp case (varNamesE :: Either E.SomeException [String]) of Left _ -> throwError $ cannotOpenVarFile fp Right varNames -> return $ Just varNames -- | Process a requirements / handlers list file, if available, and return the -- handler names. parseRequirementsListFile :: Maybe FilePath -> ExceptT ErrorTriplet IO (Maybe [String]) parseRequirementsListFile Nothing = return Nothing parseRequirementsListFile (Just fp) = ExceptT $ makeLeftE (cannotOpenHandlersFile fp) <$> (E.try $ Just . lines <$> readFile fp) -- | Read a list of variable DBs. openVarDBFiles :: VariableDB -> [FilePath] -> ExceptT ErrorTriplet IO VariableDB openVarDBFiles acc [] = return acc openVarDBFiles acc (x:xs) = do file <- parseVarDBFile (Just x) acc' <- mergeVariableDB acc file openVarDBFiles acc' xs where -- Process a variable database file, if available. parseVarDBFile :: Maybe FilePath -> ExceptT ErrorTriplet IO VariableDB parseVarDBFile Nothing = return emptyVariableDB parseVarDBFile (Just fn) = ExceptT $ makeLeftE' (cannotOpenDB fn) <$> eitherDecodeFileStrict fn -- | Read a list of variable DBs, as well as the default variable DB. openVarDBFilesWithDefault :: [FilePath] -> ExceptT ErrorTriplet IO VariableDB openVarDBFilesWithDefault files = do dataDir <- liftIO getDataDir let defaultDB = dataDir "data" "variable-db.json" openVarDBFiles emptyVariableDB (files ++ [defaultDB]) -- | Process a JSON file with additional template variables to make available -- during template expansion. parseTemplateVarsFile :: Maybe FilePath -> ExceptT ErrorTriplet IO Value parseTemplateVarsFile Nothing = return $ object [] parseTemplateVarsFile (Just fp) = do content <- liftIO $ B.safeReadFile fp let value = eitherDecode =<< content case value of Right x@(Object _) -> return x Right x@Null -> return x Right _ -> throwError (cannotReadObjectTemplateVars fp) _ -> throwError (cannotOpenTemplateVars fp) -- | Check that the arguments provided are sufficient to operate. -- -- The backend provides several modes of operation, which are selected -- by providing different arguments to the `ros` command. -- -- When an input specification file is provided, the variables and requirements -- defined in it are used unless variables or handlers files are provided, in -- which case the latter take priority. -- -- If an input file is not provided, then the user must provide BOTH a variable -- list, and a list of handlers. checkArguments :: Maybe (Spec a) -> Maybe [String] -> Maybe [String] -> Either ErrorTriplet () checkArguments Nothing Nothing Nothing = Left wrongArguments checkArguments Nothing Nothing _ = Left wrongArguments checkArguments Nothing _ Nothing = Left wrongArguments checkArguments _ (Just []) _ = Left wrongArguments checkArguments _ _ (Just []) = Left wrongArguments checkArguments _ _ _ = Right () -- | Extract the variables from a specification, and sanitize them. specExtractExternalVariables :: Maybe (Spec a) -> [String] specExtractExternalVariables Nothing = [] specExtractExternalVariables (Just cs) = map sanitizeLCIdentifier $ map externalVariableName $ externalVariables cs -- | Extract the requirements from a specification, and sanitize them to match -- the names of the handlers used by Copilot. specExtractHandlers :: Maybe (Spec a) -> [(String, Maybe String)] specExtractHandlers Nothing = [] specExtractHandlers (Just cs) = map extractReqData $ requirements cs where extractReqData r = (handlerNameF (requirementName r), requirementResultType r) handlerNameF = ("handler" ++) . sanitizeUCIdentifier -- * Handler for boolean expressions -- | Handler for boolean expressions that knows how to parse them, replace -- variables in them, and convert them to Copilot. -- -- It also contains a default value to be used whenever an expression cannot be -- found in the input file. data ExprPair = forall a . ExprPair { exprTPair :: ExprPairT a } data ExprPairT a = ExprPairT { exprTParse :: String -> Either String a , exprTReplace :: [(String, String)] -> a -> a , exprTPrint :: a -> String , exprTIdents :: a -> [String] , exprTUnknown :: a } -- | Return a handler depending on whether it should be for Lustre boolean -- expressions or for SMV boolean expressions. We default to SMV if not format -- is given. exprPair :: String -> ExprPair exprPair "lustre" = ExprPair $ ExprPairT (Lustre.pBoolSpec . Lustre.myLexer) (\_ -> id) (Lustre.boolSpec2Copilot) (Lustre.boolSpecNames) (Lustre.BoolSpecSignal (Lustre.Ident "undefined")) exprPair "literal" = ExprPair $ ExprPairT Right (\_ -> id) id (const []) "undefined" exprPair "cocospec" = exprPair "lustre" exprPair _ = ExprPair $ ExprPairT (SMV.pBoolSpec . SMV.myLexer) (substituteBoolExpr) (SMV.boolSpec2Copilot) (SMV.boolSpecNames) (SMV.BoolSpecSignal (SMV.Ident "undefined")) -- * Errors -- | Process a computation that can fail with an error code, and turn it into a -- computation that returns a 'Result'. processResult :: Monad m => ExceptT ErrorTriplet m a -> m (Result ErrorCode) processResult m = do r <- runExceptT m case r of Left (ErrorTriplet errorCode msg location) -> return $ Error errorCode msg location _ -> return Success -- ** Error messages -- | Exception handler to deal with the case in which the arguments -- provided are incorrect. wrongArguments :: ErrorTriplet wrongArguments = ErrorTriplet ecWrongArguments msg LocationNothing where msg = "the arguments provided are insufficient: you must provide an input " ++ "specification, or both a variables and a handlers file." -- | Exception handler to deal with the case in which the trigger expression -- cannot be understood. cannotReadConditionExpr :: String -> String -> ErrorTriplet cannotReadConditionExpr expr errorMsg = ErrorTriplet ecCannotReadConditionExpr msg LocationNothing where msg = "cannot parse condition or trigger expression " ++ show expr ++ ":" ++ errorMsg -- | Exception handler to deal with the case in which the input file cannot be -- opened. cannotOpenInputFile :: FilePath -> ErrorTriplet cannotOpenInputFile file = ErrorTriplet ecCannotOpenInputFile msg (LocationFile file) where msg = "cannot open input specification file " ++ file -- | Exception handler to deal with the case in which the variable DB cannot be -- opened. cannotOpenDB :: FilePath -> ErrorTriplet cannotOpenDB file = ErrorTriplet ecCannotOpenDBFile msg (LocationFile file) where msg = "cannot open variable DB file " ++ file -- | Exception handler to deal with the case in which the variable file -- provided by the user cannot be opened. cannotOpenVarFile :: FilePath -> ErrorTriplet cannotOpenVarFile file = ErrorTriplet ecCannotOpenVarFile msg (LocationFile file) where msg = "cannot open variable list file " ++ file -- | Exception handler to deal with the case in which the handlers file cannot -- be opened. cannotOpenHandlersFile :: FilePath -> ErrorTriplet cannotOpenHandlersFile file = ErrorTriplet ecCannotOpenHandlersFile msg (LocationFile file) where msg = "cannot open handlers file " ++ file -- | Error message associated to the format file not being found. commandIncorrectFormatSpec :: FilePath -> ErrorTriplet commandIncorrectFormatSpec formatFile = ErrorTriplet ecIncorrectFormatFile msg (LocationFile formatFile) where msg = "The format specification " ++ formatFile ++ " does not exist or is not " ++ "readable" -- | Exception handler to deal with the case in which the template vars file -- cannot be opened. cannotOpenTemplateVars :: FilePath -> ErrorTriplet cannotOpenTemplateVars file = ErrorTriplet ecCannotOpenTemplateVarsFile msg (LocationFile file) where msg = "Cannot open file with additional template variables: " ++ file -- | Exception handler to deal with the case in which the template vars file -- cannot be opened. cannotReadObjectTemplateVars :: FilePath -> ErrorTriplet cannotReadObjectTemplateVars file = ErrorTriplet ecCannotReadObjectTemplateVarsFile msg (LocationFile file) where msg = "Cannot open file with additional template variables: " ++ file -- | Exception handler to deal with the case of files that cannot be -- copied/generated due lack of space or permissions or some I/O error. cannotCopyTemplate :: ErrorTriplet cannotCopyTemplate = ErrorTriplet ecCannotCopyTemplate msg LocationNothing where msg = "Generation failed during copy/write operation. Check that" ++ " there's free space in the disk and that you have the necessary" ++ " permissions to write in the destination directory." -- ** Error codes -- | Error: wrong arguments provided. ecWrongArguments :: ErrorCode ecWrongArguments = 1 -- | Error: the trigger expression provided by the user cannot be parsed. ecCannotReadConditionExpr :: ErrorCode ecCannotReadConditionExpr = 1 -- | Error: the input specification provided by the user cannot be opened. ecCannotOpenInputFile :: ErrorCode ecCannotOpenInputFile = 1 -- | Error: the variable DB provided by the user cannot be opened. ecCannotOpenDBFile :: ErrorCode ecCannotOpenDBFile = 1 -- | Error: the variable file provided by the user cannot be opened. ecCannotOpenVarFile :: ErrorCode ecCannotOpenVarFile = 1 -- | Error: the handlers file provided by the user cannot be opened. ecCannotOpenHandlersFile :: ErrorCode ecCannotOpenHandlersFile = 1 -- | Error: the format file cannot be opened. ecIncorrectFormatFile :: ErrorCode ecIncorrectFormatFile = 1 -- | Error: the template vars file provided by the user cannot be opened. ecCannotOpenTemplateVarsFile :: ErrorCode ecCannotOpenTemplateVarsFile = 1 -- | Error: the template variables file passed does not contain a JSON object. ecCannotReadObjectTemplateVarsFile :: ErrorCode ecCannotReadObjectTemplateVarsFile = 1 -- | Error: the files cannot be copied/generated due lack of space or -- permissions or some I/O error. ecCannotCopyTemplate :: ErrorCode ecCannotCopyTemplate = 1 -- * Auxiliary Functions -- | Return the path to the template directory. locateTemplateDir :: Maybe FilePath -> FilePath -> ExceptT e IO FilePath locateTemplateDir mTemplateDir name = case mTemplateDir of Just x -> return x Nothing -> liftIO $ do dataDir <- getDataDir return $ dataDir "templates" name -- | Parse a property using an auxiliary program to first translate it, if -- available. -- -- If a program is given, it is first called on the property, and then the -- result is parsed with the parser passed as an argument. If a program is not -- given, then the parser is applied to the given string. wrapVia :: Maybe String -- ^ Auxiliary program to translate the -- property. -> (String -> Either String a) -- ^ Parser used on the result. -> String -- ^ Property to parse. -> IO (Either String a) wrapVia Nothing parse s = return (parse s) wrapVia (Just f) parse s = E.handle (\(e :: E.IOException) -> return $ Left $ show e) $ do out <- readProcess f [] s return $ parse out -- | Merge two JSON objects. -- -- Fails if the values are not objects or null. mergeObjects :: Value -> Value -> Value mergeObjects (Object m1) (Object m2) = Object (union m1 m2) mergeObjects obj Null = obj mergeObjects Null obj = obj mergeObjects _ _ = error "The values passed are not objects" -- | Replace the left Exception in an Either. makeLeftE :: c -> Either E.SomeException b -> Either c b makeLeftE = makeLeftE' -- | Replace the left value in an @Either@. makeLeftE' :: c -> Either a b -> Either c b makeLeftE' c (Left _) = Left c makeLeftE' _ (Right x) = Right x ogma-core-1.10.0/src/Command/CStructs2Copilot.hs0000644000000000000000000000607715064246145017540 0ustar0000000000000000-- Copyright 2020 United States Government as represented by the Administrator -- of the National Aeronautics and Space Administration. All Rights Reserved. -- -- Disclaimers -- -- Licensed under the Apache License, Version 2.0 (the "License"); you may -- not use this file except in compliance with the License. You may obtain a -- copy of the License at -- -- https://www.apache.org/licenses/LICENSE-2.0 -- -- Unless required by applicable law or agreed to in writing, software -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the -- License for the specific language governing permissions and limitations -- under the License. -- -- | Generate Copilot struct definitions and instances from structs defined in -- a C header file. -- -- Working with Copilot structs requires three definitions: the datatype, a -- @Struct@ instance, and a @Typed@ instance. -- -- This module converts the C structs into 'Language.Copilot.CStruct.CStruct's, -- and then converts those 'Language.Copilot.CStruct.CStruct's into Copilot -- (i.e., Haskell) data type declarations and instance declarations. The result -- is then printed to a file. This module makes use of -- "Language.Trans.CStructs2Copilot", which does most of the work. module Command.CStructs2Copilot ( cstructs2Copilot , ErrorCode ) where -- External imports: auxiliary import Data.String.Extra as S ( safeReadFile ) -- Internal imports: auxiliary import Command.Result ( Result (..) ) import Data.Location ( Location (..) ) -- Internal imports: C parsing and AST import qualified Language.C.AbsC as C ( TranslationUnit ) import qualified Language.C.ParC as C ( myLexer, pTranslationUnit ) -- Internal imports: transformation of C structs to Copilot structs import Language.Trans.CStructs2Copilot ( cstructs2CopilotDecls ) -- | Generate Copilot struct definitions and instances from structs defined in -- a C header file. cstructs2Copilot :: FilePath -- ^ Path to a readable, valid C header file -- containing struct definitions. -> IO (Result ErrorCode) cstructs2Copilot fp = do source <- parseCFile fp case cstructs2CopilotDecls =<< source of Right decls -> printDecls decls >> return Success Left msg -> return $ Error ecCStructError msg (LocationFile fp) where -- Parse a C file, returning 'Left' with some message when there is a parse -- error. -- parseCFile :: FilePath -> IO (Either String C.TranslationUnit) parseCFile fp' = do content <- S.safeReadFile fp' return $ C.pTranslationUnit . C.myLexer =<< content -- Print several Haskell declarations to standard output. printDecls :: [ String ] -> IO () printDecls = putStrLn . unlines -- * Error codes -- | Encoding of reasons why the command can fail. -- -- The error code used is 1 for user error. type ErrorCode = Int -- | Error: the C header file cannot be read due to the file being unreadable -- or the format being incorrect. ecCStructError :: ErrorCode ecCStructError = 1 ogma-core-1.10.0/src/Command/Overview.hs0000644000000000000000000001305715064246145016154 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -- Copyright 2024 United States Government as represented by the Administrator -- of the National Aeronautics and Space Administration. All Rights Reserved. -- -- Disclaimers -- -- Licensed under the Apache License, Version 2.0 (the "License"); you may -- not use this file except in compliance with the License. You may obtain a -- copy of the License at -- -- https://www.apache.org/licenses/LICENSE-2.0 -- -- Unless required by applicable law or agreed to in writing, software -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the -- License for the specific language governing permissions and limitations -- under the License. -- -- | Produce an overview of the input files. module Command.Overview ( command , CommandOptions(..) , CommandSummary(..) , ErrorCode ) where -- External imports import Control.Monad.Except (runExceptT) import Data.Aeson (ToJSON (..)) import Data.List (nub, (\\)) import GHC.Generics (Generic) -- External imports: Ogma import Data.OgmaSpec (ExternalVariableDef (..), InternalVariableDef (..), Requirement (..), Spec (..)) -- Internal imports import Command.Common import Command.Errors (ErrorCode, ErrorTriplet(..)) import Command.Result (Result (..)) import Data.Location (Location (..)) import Language.Trans.Spec2Copilot (specAnalyze) -- | Generate overview of a spec given in an input file. -- -- PRE: The file given is readable, contains a valid file with recognizable -- format, the formulas in the file do not use any identifiers that exist in -- Copilot, or any of @prop@, @clock@, @ftp@, @notPreviousNot@. All identifiers -- used are valid C99 identifiers. The template, if provided, exists and uses -- the variables needed by the overview application generator. The target -- directory is writable and there's enough disk space to copy the files over. command :: FilePath -- ^ Path to a file containing a specification -> CommandOptions -- ^ Customization options -> IO (Maybe CommandSummary, Result ErrorCode) command fp options = do let functions = exprPair (commandPropFormat options) copilot <- command' fp options functions return $ commandResult options fp copilot -- | Generate overview of a spec given in an input file. -- -- PRE: The file given is readable, contains a valid file with recognizable -- format, the formulas in the file do not use any identifiers that exist in -- Copilot, or any of @prop@, @clock@, @ftp@, @notPreviousNot@. All identifiers -- used are valid C99 identifiers. The template, if provided, exists and uses -- the variables needed by the overview application generator. The target -- directory is writable and there's enough disk space to copy the files over. command' :: FilePath -> CommandOptions -> ExprPair -> IO (Either String CommandSummary) command' fp options (ExprPair exprT) = do spec <- runExceptT $ parseInputFile' fp let spec' = either (\(ErrorTriplet _ec msg _loc) -> Left msg) Right spec let summary = do spec1 <- spec' spec3 <- specAnalyze $ addMissingIdentifiers ids spec1 return $ CommandSummary (length (externalVariables spec3)) (length (internalVariables spec3)) (length (requirements spec3)) return summary where parseInputFile' f = parseInputFile f formatName propFormatName propVia exprT formatName = commandFormat options propFormatName = commandPropFormat options propVia = commandPropVia options ExprPairT _parse _replace _print ids _def = exprT data CommandSummary = CommandSummary { commandExternalVariables :: Int , commandInternalVariables :: Int , commandRequirements :: Int } deriving (Generic, Show) instance ToJSON CommandSummary -- | Options used to customize the interpretation of input specifications. data CommandOptions = CommandOptions { commandFormat :: String , commandPropFormat :: String , commandPropVia :: Maybe String } -- * Error codes -- | Error: the input file cannot be read due to it being unreadable or the -- format being incorrect. ecOverviewError :: ErrorCode ecOverviewError = 1 -- * Result -- | Process the result of the transformation function. commandResult :: CommandOptions -> FilePath -> Either String a -> (Maybe a, Result ErrorCode) commandResult _options fp result = case result of Left msg -> (Nothing, Error ecOverviewError msg (LocationFile fp)) Right t -> (Just t, Success) -- | Add to a spec external variables for all identifiers mentioned in -- expressions that are not defined anywhere. addMissingIdentifiers :: (a -> [String]) -> Spec a -> Spec a addMissingIdentifiers f s = s { externalVariables = vars' } where vars' = externalVariables s ++ newVars newVars = map (\n -> ExternalVariableDef n "") newVarNames -- Names that are not defined anywhere newVarNames = identifiers \\ existingNames -- Identifiers being mentioned in the requirements. identifiers = nub $ concatMap (f . requirementExpr) (requirements s) -- Names that are defined in variables. existingNames = map externalVariableName (externalVariables s) ++ map internalVariableName (internalVariables s) ogma-core-1.10.0/src/Command/CFSApp.hs0000644000000000000000000002405115064246145015416 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE ScopedTypeVariables #-} -- Copyright 2020 United States Government as represented by the Administrator -- of the National Aeronautics and Space Administration. All Rights Reserved. -- -- Disclaimers -- -- Licensed under the Apache License, Version 2.0 (the "License"); you may -- not use this file except in compliance with the License. You may obtain a -- copy of the License at -- -- https://www.apache.org/licenses/LICENSE-2.0 -- -- Unless required by applicable law or agreed to in writing, software -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the -- License for the specific language governing permissions and limitations -- under the License. -- -- | Create (CFS) -- applications that subscribe to the communication bus and call Copilot when -- new messages arrive. -- -- The applications are created ready to be extracted in the application -- directory in CFS, and they subscribe to a generic monitor. It is the user's -- responsibility to modify the generated Copilot and C code to deal with the -- monitors they'd like to implement, and the data they must manipulate. {- HLINT ignore "Functor law" -} module Command.CFSApp ( command , CommandOptions(..) , ErrorCode ) where -- External imports import Control.Applicative ( liftA2, (<|>) ) import qualified Control.Exception as E import Control.Monad.Except ( ExceptT (..), liftEither ) import Data.Aeson ( ToJSON (..) ) import Data.Maybe ( fromMaybe, mapMaybe, maybeToList ) import GHC.Generics ( Generic ) -- External imports: auxiliary import qualified Command.Standalone -- Internal imports: auxiliary import Command.Result ( Result (..) ) import Data.List.Extra ( stripSuffix ) import Data.String.Extra ( pascalCase ) import System.Directory.Extra ( copyTemplate ) -- Internal imports import Command.Common import Command.Errors (ErrorCode, ErrorTriplet (..)) import Command.VariableDB (Connection (..), TopicDef (..), TypeDef (..), VariableDB, findConnection, findInput, findTopic, findType, findTypeByType) -- | Generate a new CFS application connected to Copilot. command :: CommandOptions -> IO (Result ErrorCode) command options = processResult $ do -- Obtain template dir templateDir <- locateTemplateDir mTemplateDir "copilot-cfs" templateVars <- parseTemplateVarsFile templateVarsF appData <- command' options functions let subst = mergeObjects (toJSON appData) templateVars -- Expand template ExceptT $ fmap (makeLeftE cannotCopyTemplate) $ E.try $ copyTemplate templateDir subst targetDir where targetDir = commandTargetDir options mTemplateDir = commandTemplateDir options functions = exprPair (commandPropFormat options) templateVarsF = commandExtraVars options command' :: CommandOptions -> ExprPair -> ExceptT ErrorTriplet IO AppData command' options (ExprPair exprT) = do -- Open files needed to fill in details in the template. vs <- parseVariablesFile varNameFile rs <- parseRequirementsListFile handlersFile varDB <- openVarDBFilesWithDefault varDBFile specT <- maybe (return Nothing) (\e -> Just <$> parseInputExpr' e) cExpr specF <- maybe (return Nothing) (\f -> Just <$> parseInputFile' f) fp let spec = specT <|> specF liftEither $ checkArguments spec vs rs copilotM <- sequenceA $ (\spec' -> processSpec spec' fp cExpr) <$> spec let varNames = fromMaybe (specExtractExternalVariables spec) vs monitors = maybe (specExtractHandlers spec) (map (\x -> (x, Nothing))) rs let appData = commandLogic varDB varNames monitors' copilotM monitors' = mapMaybe (monitorMap varDB) monitors return appData where cExpr = commandConditionExpr options fp = commandInputFile options varNameFile = commandVariables options varDBFile = maybeToList $ commandVariableDB options handlersFile = commandHandlers options formatName = commandFormat options propFormatName = commandPropFormat options propVia = commandPropVia options parseInputExpr' e = parseInputExpr e propFormatName propVia exprT parseInputFile' f = parseInputFile f formatName propFormatName propVia exprT processSpec spec' expr' fp' = Command.Standalone.commandLogic expr' fp' "copilot" [] exprT spec' -- | Generate a variable substitution map for a cFS application. commandLogic :: VariableDB -> [String] -> [Trigger] -> Maybe Command.Standalone.AppData -> AppData commandLogic varDB varNames handlers copilotM = AppData vars ids infos datas handlers copilotM where -- This is a Data.List.unzip4 (vars, ids, infos, datas) = foldr f ([], [], [], []) varNames f n o@(oVars, oIds, oInfos, oDatas) = case variableMap varDB n of Nothing -> o Just (vars, ids, infos, datas) -> (vars : oVars, ids : oIds, infos : oInfos, datas : oDatas) -- ** Argument processing -- | Options used to customize the conversion of specifications to ROS -- applications. data CommandOptions = CommandOptions { commandConditionExpr :: Maybe String -- ^ Trigger condition. , commandInputFile :: Maybe FilePath -- ^ Input specification file. , commandTargetDir :: FilePath -- ^ Target directory where the -- application should be created. , commandTemplateDir :: Maybe FilePath -- ^ Directory where the template is -- to be found. , commandVariables :: Maybe FilePath -- ^ File containing a list of -- variables to make available to -- Copilot. , commandVariableDB :: Maybe FilePath -- ^ File containing a list of known -- variables with their types and the -- message IDs they can be obtained -- from. , commandHandlers :: Maybe FilePath -- ^ File containing a list of -- handlers used in the Copilot -- specification. The handlers are -- assumed to receive no arguments. , commandFormat :: String -- ^ Format of the input file. , commandPropFormat :: String -- ^ Format used for input properties. , commandPropVia :: Maybe String -- ^ Use external command to -- pre-process system properties. , commandExtraVars :: Maybe FilePath -- ^ File containing additional -- variables to make available to the -- template. } -- | Return the variable information needed to generate declarations -- and subscriptions for a given variable name and variable database. variableMap :: VariableDB -> String -> Maybe (VarDecl, MsgInfoId, MsgInfo, MsgData) variableMap varDB varName = do inputDef <- findInput varDB varName mid <- connectionTopic <$> findConnection inputDef "cfs" topicDef <- findTopic varDB "cfs" mid let typeDef = findType varDB varName "cfs" "C" let typeMsgFromType = typeFromType <$> typeDef typeMsgFromField = typeFromField =<< typeDef let typeVar' = fromMaybe (topicType topicDef) (typeToType <$> typeDef) -- Pick name for the function to process a message ID. let mn = pascalCase $ stripSuffix "_MID" mid return ( VarDecl varName typeVar' , mid , MsgInfo mid mn , MsgData mn typeMsgFromType typeMsgFromField varName typeVar' ) where -- | Return the monitor information needed to generate declarations and -- publishers for the given monitor info, and variable database. monitorMap :: VariableDB -> (String, Maybe String) -> Maybe Trigger monitorMap varDB (monitorName, Nothing) = Just $ Trigger monitorName Nothing Nothing monitorMap varDB (monitorName, Just ty) = do let tyCFS = typeFromType <$> findTypeByType varDB "cfs" "C" ty return $ Trigger monitorName (Just ty) tyCFS -- | The declaration of a variable in C, with a given type and name. data VarDecl = VarDecl { varDeclName :: String , varDeclType :: String } deriving (Generic) instance ToJSON VarDecl -- | The message ID to subscribe to. type MsgInfoId = String -- | A message ID to subscribe to and the name associated to it. The name is -- used to generate a suitable name for the message handler. data MsgInfo = MsgInfo { msgInfoId :: MsgInfoId , msgInfoDesc :: String } deriving (Generic) instance ToJSON MsgInfo -- | Information on the data provided by a message with a given description, -- and the type of the data it carries. data MsgData = MsgData { msgDataDesc :: String , msgDataFromType :: Maybe String , msgDataFromField :: Maybe String , msgDataVarName :: String , msgDataVarType :: String } deriving (Generic) instance ToJSON MsgData -- | The message ID to subscribe to. data Trigger = Trigger { triggerName :: String , triggerType :: Maybe String , triggerMsgType :: Maybe String } deriving (Generic) instance ToJSON Trigger -- | Data that may be relevant to generate a cFS monitoring application. data AppData = AppData { variables :: [VarDecl] , msgIds :: [MsgInfoId] , msgCases :: [MsgInfo] , msgHandlers :: [MsgData] , triggers :: [Trigger] , copilot :: Maybe Command.Standalone.AppData } deriving (Generic) instance ToJSON AppData ogma-core-1.10.0/src/Command/Diagram.hs0000644000000000000000000004147115064246145015713 0ustar0000000000000000{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} -- Copyright 2024 United States Government as represented by the Administrator -- of the National Aeronautics and Space Administration. All Rights Reserved. -- -- Disclaimers -- -- Licensed under the Apache License, Version 2.0 (the "License"); you may -- not use this file except in compliance with the License. You may obtain a -- copy of the License at -- -- https://www.apache.org/licenses/LICENSE-2.0 -- -- Unless required by applicable law or agreed to in writing, software -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the -- License for the specific language governing permissions and limitations -- under the License. -- -- | Transform a state diagram into a Copilot specification. module Command.Diagram ( diagram , DiagramOptions(..) , DiagramFormat(..) , DiagramMode(..) , DiagramPropFormat(..) , ErrorCode ) where -- External imports import Control.Exception as E import Control.Monad (when) import Data.Aeson (object, (.=)) import Data.ByteString.Lazy (toStrict) import qualified Data.ByteString.Lazy as B import Data.Either (isLeft) import Data.Foldable (for_) import Data.Functor.Identity (Identity) import Data.GraphViz (graphEdges) import qualified Data.GraphViz as G import qualified Data.GraphViz.Attributes.Complete as Attributes import Data.GraphViz.Commands.IO (toUTF8) import qualified Data.GraphViz.Parsing as G import Data.GraphViz.PreProcessing (preProcess) import qualified Data.GraphViz.Types.Generalised as Gs import Data.List (intercalate, nub, sort) import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T import Data.Text.Lazy (pack) import qualified Data.Text.Lazy as LT import Data.Void (Void) import System.FilePath (()) import Text.Megaparsec (ErrorFancy (ErrorFail), ParsecT, empty, errorBundlePretty, fancyFailure, many, manyTill, noneOf, parse) import Text.Megaparsec.Char (alphaNumChar, char, digitChar, newline, space1, string) import qualified Text.Megaparsec.Char.Lexer as L -- External imports: auxiliary import Data.ByteString.Extra as B ( safeReadFile ) import System.Directory.Extra ( copyTemplate ) -- External imports: parsing expressions. import qualified Language.Lustre.ParLustre as Lustre (myLexer, pBoolSpec) import qualified Language.SMV.ParSMV as SMV (myLexer, pBoolSpec) -- Internal imports: auxiliary import Command.Result (Result (..)) import Data.Location (Location (..)) import Paths_ogma_core (getDataDir) -- Internal imports: language ASTs, transformers import Language.SMV.Substitution (substituteBoolExpr) import qualified Language.Trans.Lustre2Copilot as Lustre (boolSpec2Copilot, boolSpecNames) import Language.Trans.SMV2Copilot as SMV (boolSpec2Copilot, boolSpecNames) -- | Generate a new Copilot monitor that implements a state machine described -- in a diagram given as an input file. -- -- PRE: The file given is readable, contains a valid file with recognizable -- format, the formulas in the file do not use any identifiers that exist in -- Copilot, or any of @stateMachine@, @externalState@, @noneOf@, -- @checkValidTransitions@, @main@, @spec@, @stateMachine1@, @clock@, @ftp@, -- @notPreviousNot@. All identifiers used are valid C99 identifiers. The -- template, if provided, exists and uses the variables needed by the diagram -- application generator. The target directory is writable and there's enough -- disk space to copy the files over. diagram :: FilePath -- ^ Path to a file containing a diagram -> DiagramOptions -- ^ Customization options -> IO (Result ErrorCode) diagram fp options = do E.handle (return . diagramTemplateError fp) $ do -- Sub-parser for edge expressions. let functions = exprPair (diagramPropFormat options) -- Convert the diagram into elements in a Copilot spec. copilotSpecElems <- diagram' fp options functions -- Convert the elements into a success or error result. let (mOutput, result) = diagramResult fp copilotSpecElems -- If the result is success, expand the template. for_ mOutput $ \(streamDefs, handlerInputs) -> do let subst = object [ "streamDefs" .= pack streamDefs , "specName" .= pack (diagramFilename options) , "input" .= pack (diagramInputVar options) , "state" .= pack (diagramStateVar options) , "handlerInputs" .= pack handlerInputs ] templateDir <- case diagramTemplateDir options of Just x -> return x Nothing -> do dataDir <- getDataDir return $ dataDir "templates" "diagram" let targetDir = diagramTargetDir options copyTemplate templateDir subst targetDir return result -- | Generate a new Copilot monitor that implements a state machine described -- in a diagram given as an input file, using a subexpression handler. -- -- PRE: The file given is readable, contains a valid file with recognizable -- format, the formulas in the file do not use any identifiers that exist in -- Copilot, or any of @stateMachine@, @externalState@, @noneOf@, -- @checkValidTransitions@, @main@, @spec@, @stateMachine1@, @clock@, @ftp@, -- @notPreviousNot@. All identifiers used are valid C99 identifiers. The -- template, if provided, exists and uses the variables needed by the diagram -- application generator. The target directory is writable and there's enough -- disk space to copy the files over. diagram' :: FilePath -> DiagramOptions -> ExprPair -> IO (Either String (String, String)) diagram' fp options exprP = do contentEither <- B.safeReadFile fp return $ do -- All of the following operations use Either to return error messages. The -- use of the monadic bind to pass arguments from one function to the next -- will cause the program to stop at the earliest error. diagFileContent <- contentEither -- Abtract representation of a state machine diagram. diagramR <- parseDiagram (diagramFormat options) diagFileContent exprP return $ diagramToCopilot diagramR (diagramMode options) -- | Options used to customize the conversion of diagrams to Copilot code. data DiagramOptions = DiagramOptions { diagramTargetDir :: FilePath , diagramTemplateDir :: Maybe FilePath , diagramFormat :: DiagramFormat , diagramPropFormat :: DiagramPropFormat , diagramFilename :: String , diagramMode :: DiagramMode , diagramStateVar :: String , diagramInputVar :: String } -- | Modes of operation. data DiagramMode = CheckState -- ^ Check if given state matches expectation | ComputeState -- ^ Compute expected state | CheckMoves -- ^ Check if transitioning to a state would be -- possible. deriving (Eq, Show) -- | Diagram formats supported. data DiagramFormat = Mermaid | Dot deriving (Eq, Show) -- | Property formats supported. data DiagramPropFormat = Lustre | Inputs | Literal | SMV deriving (Eq, Show) -- * Error codes -- | Encoding of reasons why the command can fail. -- -- The error code used is 1 for user error. type ErrorCode = Int -- | Error: the input file cannot be read due to it being unreadable or the -- format being incorrect. ecDiagramError :: ErrorCode ecDiagramError = 1 -- | Error: diagram component generation failed during the copy/write -- process. ecDiagramTemplateError :: ErrorCode ecDiagramTemplateError = 2 -- * Result -- | Process the result of the transformation function. diagramResult :: FilePath -> Either String a -> (Maybe a, Result ErrorCode) diagramResult fp result = case result of Left msg -> (Nothing, Error ecDiagramError msg (LocationFile fp)) Right t -> (Just t, Success) -- | Report an error when trying to open or copy the template. diagramTemplateError :: FilePath -> E.SomeException -> Result ErrorCode diagramTemplateError fp exception = Error ecDiagramTemplateError msg (LocationFile fp) where msg = "Diagram monitor generation failed during copy/write operation. Check" ++ " that there's free space in the disk and that you have the necessary" ++ " permissions to write in the destination directory. " ++ show exception -- * Handler for boolean expressions in edges or transitions between states. -- | Handler for boolean expressions that knows how to parse them, replace -- variables in them, and convert them to Copilot. data ExprPair = forall a . ExprPair { _exprParse :: String -> Either String a , _exprReplace :: [(String, String)] -> a -> a , _exprPrint :: a -> String , _exprIdents :: a -> [String] } -- | Return a handler depending on the format used for edge or transition -- properties. exprPair :: DiagramPropFormat -> ExprPair exprPair Lustre = ExprPair (Lustre.pBoolSpec . Lustre.myLexer) (\_ -> id) Lustre.boolSpec2Copilot Lustre.boolSpecNames exprPair Inputs = ExprPair ((Right . read) :: String -> Either String Int) (\_ -> id) (\x -> "input == " ++ show x) (const []) exprPair Literal = ExprPair Right (\_ -> id) id (const []) exprPair SMV = ExprPair (SMV.pBoolSpec . SMV.myLexer) substituteBoolExpr SMV.boolSpec2Copilot SMV.boolSpecNames -- | Parse and print a value using an auxiliary Expression Pair. -- -- Fails if the value has no valid parse. exprPairShow :: ExprPair -> String -> String exprPairShow (ExprPair parseProp _replace printProp _ids) = printProp . fromRight' . parseProp -- * Diagrams -- | Internal representation for diagrams. newtype Diagram = Diagram { diagramTransitions :: [(Int, String, Int)] } deriving (Show, Eq) -- * Diagram parsers -- | Generic function to parse a diagram. parseDiagram :: DiagramFormat -- ^ Format of the input file -> B.ByteString -- ^ Contents of the diagram -> ExprPair -- ^ Subparser for conditions or edge -- expressions -> Either String Diagram parseDiagram Dot = parseDiagramDot parseDiagram Mermaid = parseDiagramMermaid -- ** Dot parser -- | Parse a DOT / Graphviz diagram. parseDiagramDot :: B.ByteString -> ExprPair -> Either String Diagram parseDiagramDot contents exprP = do let contentsUTF8 = toUTF8 contents dg <- fst $ G.runParser G.parse $ preProcess contentsUTF8 return $ makeDiagram dg where makeDiagram :: Gs.DotGraph LT.Text -> Diagram makeDiagram g = Diagram links where links = map edgeToLink (graphEdges g) edgeToLink edge = ( read (LT.unpack o) , exprPairShow exprP (LT.unpack e) , read (LT.unpack d) ) where o = G.fromNode edge d = G.toNode edge e = getLabel (G.edgeAttributes edge) -- Extract the label from a list of attributes. If no label is -- found, it's assumed that the condition is the literal true. getLabel [] = "true" getLabel ((Attributes.Label (Attributes.StrLabel l)) : _) = l getLabel (_ : as) = getLabel as -- ** Mermaid parser -- | Parse a mermaid diagram. parseDiagramMermaid :: B.ByteString -> ExprPair -> Either String Diagram parseDiagramMermaid txtDia exprP = case parsingResult of Left e -> Left (errorBundlePretty e) Right x -> Right x where txt = T.decodeUtf8 (toStrict txtDia) parsingResult = parse (spaces *> pDiagram exprP) "" txt -- | Type for parser for memaid diagrams. type MermaidParser = ParsecT Void Text Identity -- | Parser for a mermaid diagram. -- -- This parser depends on an auxiliary parser for the expressions associated to -- the edges or connections between states. pDiagram :: ExprPair -> MermaidParser Diagram pDiagram exprP = do _ <- string "graph" <* spaces _name <- T.pack <$> manyTill alphaNumChar (char ';') _ <- newline transitions <- many (pTransition exprP) pure $ Diagram transitions -- | Parser for an edge in a state diagram. -- -- This parser depends on an auxiliary parser for the expressions associated to -- the edges or connections between states. pTransition :: ExprPair -> MermaidParser (Int, String, Int) pTransition ep@(ExprPair { _exprParse = parseProp }) = do _ <- spaces stateFrom <- many digitChar _ <- string "-->|" edge <- many (noneOf ("|" :: [Char])) let x = parseProp edge when (isLeft x) $ fancyFailure $ Set.singleton $ ErrorFail $ "Edge property has incorrect format: " ++ show edge _ <- char '|' stateTo <- many digitChar _ <- char ';' _ <- newline return (read stateFrom, exprPairShow ep edge, read stateTo) -- | Consume spaces spaces :: MermaidParser () spaces = L.space space1 empty empty -- * Backend -- | Convert the diagram into a set of Copilot definitions, and a list of -- arguments for the top-level handler. diagramToCopilot :: Diagram -> DiagramMode -> (String, String) diagramToCopilot diag mode = (machine, arguments) where machine = unlines [ "stateMachineProp :: Stream Bool" , "stateMachineProp = " ++ propExpr , "" , "stateMachine1 :: Stream Word8" , "stateMachine1 = stateMachineGF (initialState, finalState, noInput, " ++ "transitions, badState)" , "" , "-- Check" , "initialState :: Word8" , "initialState = " ++ show initialState , "" , "-- Check" , "finalState :: Word8" , "finalState = " ++ show finalState , "" , "noInput :: Stream Bool" , "noInput = false" , "" , "badState :: Word8" , "badState = " ++ show badState , "" , "transitions = " ++ showTransitions ] -- Elements of the spec. propExpr = case mode of CheckState -> "stateMachine1 == externalState" ComputeState -> "true" CheckMoves -> "true" initialState = minimum states finalState = maximum states badState = maximum states + 1 -- Arguments for the handler. arguments = "[ " ++ intercalate ", " (map ("arg " ++) argExprs) ++ " ]" argExprs = case mode of CheckState -> [ "stateMachine1", "externalState", "input" ] ComputeState -> [ "stateMachine1", "externalState", "input" ] CheckMoves -> map stateCheckExpr states stateCheckExpr stateId = "(checkValidTransition transitions externalState " ++ show stateId ++ ")" -- States and transitions from the diagram. transitions = diagramTransitions diag states = nub $ sort $ concat [ [x, y] | (x, _, y) <- transitions ] showTransitions :: String showTransitions = "[" ++ showTransitions' transitions showTransitions' :: [(Int, String, Int)] -> String showTransitions' [] = "]" showTransitions' (x1:x2:xs) = showTransition x1 ++ ", " ++ showTransitions' (x2:xs) showTransitions' (x2:[]) = showTransition x2 ++ "]" showTransition :: (Int, String, Int) -> String showTransition (a, b, c) = "(" ++ show a ++ ", " ++ b ++ ", " ++ show c ++ ")" -- * Auxiliary functions -- | Unsafe fromRight. Fails if the value is a 'Left'. fromRight' :: Either a b -> b fromRight' (Right v) = v fromRight' _ = error "fromRight' applied to Left value." ogma-core-1.10.0/src/Command/Errors.hs0000644000000000000000000000210315064246145015610 0ustar0000000000000000-- Copyright 2022 United States Government as represented by the Administrator -- of the National Aeronautics and Space Administration. All Rights Reserved. -- -- Disclaimers -- -- Licensed under the Apache License, Version 2.0 (the "License"); you may -- not use this file except in compliance with the License. You may obtain a -- copy of the License at -- -- https://www.apache.org/licenses/LICENSE-2.0 -- -- Unless required by applicable law or agreed to in writing, software -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the -- License for the specific language governing permissions and limitations -- under the License. -- -- | Types to encapsulate information useful for error reporting. module Command.Errors ( ErrorTriplet(..) , ErrorCode ) where import Data.Location (Location) -- | A triplet containing error information. data ErrorTriplet = ErrorTriplet ErrorCode String Location -- | Encoding of reasons why the command can fail. type ErrorCode = Int ogma-core-1.10.0/src/Command/Result.hs0000644000000000000000000000245215064246145015621 0ustar0000000000000000-- Copyright 2020 United States Government as represented by the Administrator -- of the National Aeronautics and Space Administration. All Rights Reserved. -- -- Disclaimers -- -- Licensed under the Apache License, Version 2.0 (the "License"); you may -- not use this file except in compliance with the License. You may obtain a -- copy of the License at -- -- https://www.apache.org/licenses/LICENSE-2.0 -- -- Unless required by applicable law or agreed to in writing, software -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the -- License for the specific language governing permissions and limitations -- under the License. -- -- | A datatype representing the type of the results of processing input files. module Command.Result ( Result (Success, Error) , isSuccess , isError ) where -- Internal imports import Data.Location ( Location ) -- | Result of the global process data Result a = Success | Error a String Location -- | 'True' if the result is a success, 'False' otherwise. isSuccess :: Result a -> Bool isSuccess Success = True isSuccess _ = False -- | 'True' if the result is an error, 'False' otherwise. isError :: Result a -> Bool isError = not . isSuccess ogma-core-1.10.0/src/Command/CStructs2MsgHandlers.hs0000644000000000000000000000514615064246145020332 0ustar0000000000000000-- Copyright 2020 United States Government as represented by the Administrator -- of the National Aeronautics and Space Administration. All Rights Reserved. -- -- Disclaimers -- -- Licensed under the Apache License, Version 2.0 (the "License"); you may -- not use this file except in compliance with the License. You may obtain a -- copy of the License at -- -- https://www.apache.org/licenses/LICENSE-2.0 -- -- Unless required by applicable law or agreed to in writing, software -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the -- License for the specific language governing permissions and limitations -- under the License. -- -- | Generate C methods that process NASA Core Flight System messages dealing -- with the structs defined in a header file. -- -- This module makes use of "Language.Trans.CStructs2MsgHandlers", which does -- most of the work. module Command.CStructs2MsgHandlers ( cstructs2MsgHandlers , ErrorCode ) where -- External imports: auxiliary import Data.String.Extra as S ( safeReadFile ) -- Internal imports: auxiliary import Command.Result ( Result (..) ) import Data.Location ( Location (..) ) -- Internal imports: C parsing and AST import qualified Language.C.AbsC as C ( TranslationUnit ) import qualified Language.C.ParC as C ( myLexer, pTranslationUnit ) -- Internal imports: transformation of C structs to handling methods. import qualified Language.Trans.CStructs2MsgHandlers as T ( cstructs2MsgHandlers ) -- | Print message handlers that copy data and make it available to Copilot. cstructs2MsgHandlers :: FilePath -- ^ Path to a readable, valid C header file -- containing struct definitions. -> IO (Result ErrorCode) cstructs2MsgHandlers fp = do result <- parseCFile fp case T.cstructs2MsgHandlers =<< result of Right content -> putStrLn content >> return Success Left msg -> return $ Error ecCStructError msg (LocationFile fp) where -- Parse a C file, returning 'Left' with some message when there is a parse -- error. -- parseCFile :: FilePath -> IO (Either String C.TranslationUnit) parseCFile fp' = do content <- S.safeReadFile fp' return $ C.pTranslationUnit . C.myLexer =<< content -- * Error codes -- | Encoding of reasons why the command can fail. -- -- The error code used is 1 for user error. type ErrorCode = Int -- | Error: the C header file cannot be read due to the file being unreadable -- or the format being incorrect. ecCStructError :: ErrorCode ecCStructError = 1