ogma-core-1.14.0/0000755000000000000000000000000015204000371011624 5ustar0000000000000000ogma-core-1.14.0/ogma-core.cabal0000644000000000000000000001707715204000371014475 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.14.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/cfs/Dockerfile templates/cfs/copilot/CMakeLists.txt templates/cfs/copilot/fsw/for_build/Makefile templates/cfs/copilot/fsw/mission_inc/copilot_cfs_perfids.h templates/cfs/copilot/fsw/platform_inc/copilot_cfs_msgids.h templates/cfs/copilot/fsw/src/Properties.hs templates/cfs/copilot/fsw/src/copilot_cfs_msg.h templates/cfs/copilot/fsw/src/copilot_cfs.c templates/cfs/copilot/fsw/src/copilot_cfs_version.h templates/cfs/copilot/fsw/src/copilot_cfs.h templates/cfs/copilot/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/report/Report.md 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.Report Command.Result Command.ROSApp Command.Standalone Data.Location Language.Trans.CStruct2CopilotStruct Language.Trans.CStructs2Copilot Language.Trans.CStructs2MsgHandlers Language.Trans.Diagram2Copilot Language.Trans.Lustre2Copilot Language.Trans.Spec2Copilot Language.Trans.SMV2Copilot other-modules: Paths_ogma_core Command.Common Command.Errors Command.VariableDB Copilot.Core.Analysis Copilot.Language.Reify.Extra Data.Aeson.Extra Data.Diagram Data.Diagram.Analysis Data.Diagram.Parser Data.Diagram.Parser.Dot Data.Diagram.Parser.Mermaid Data.Either.Extra Data.ExprPair Data.Spec.Analysis Data.Spec.Extra Data.Spec.Parser Language.YAMLSpec.Parser 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 , copilot-core >= 4.6.1 && < 4.8 , copilot-language >= 4.6.1 && < 4.8 , copilot-theorem >= 4.6.1 && < 4.8 , directory >= 1.3.1.5 && < 1.4 , filepath >= 1.4.2 && < 1.6 , graphviz >= 2999.20 && < 2999.21 , hint >= 0.9.0 && < 1.10 , megaparsec >= 8.0.0 && < 9.8 , mtl >= 2.2.2 && < 2.4 , process >= 1.6 && < 1.7 , text >= 1.2.3.1 && < 2.2 , vector >= 0.12.0.1 && < 0.14 , yaml >= 0.11.7.0 && < 0.12 , ogma-extra >= 1.14.0 && < 1.15 , ogma-language-c >= 1.14.0 && < 1.15 , ogma-language-copilot >= 1.14.0 && < 1.15 , ogma-language-csv >= 1.14.0 && < 1.15 , ogma-language-jsonspec >= 1.14.0 && < 1.15 , ogma-language-lustre >= 1.14.0 && < 1.15 , ogma-language-smv >= 1.14.0 && < 1.15 , ogma-language-xlsx >= 1.14.0 && < 1.15 , ogma-language-xmlspec >= 1.14.0 && < 1.15 , ogma-spec >= 1.14.0 && < 1.15 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.17 , 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.14.0/LICENSE0000644000000000000000000002613715204000371012642 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.14.0/CHANGELOG.md0000644000000000000000000001777615204000371013457 0ustar0000000000000000# Revision history for ogma-core ## [1.14.0] - 2026-05-21 * Version bump (1.14.0) (#425). * Bump upper version constraints on Copilot packages (#377). * Lower upper version bound on `megaparsec` (#380). * Bump upper version constraint on Quickcheck (#382). * Adjust `Common.Diagram` module to use `Command.Common.ExprPair` (#384). * Add support for reading diagrams to overview command (#386). * Augment overview command to formally analyze diagrams (#388). * Move functions related to `Either` type to dedicated module (#391). * Move function related to JSON objects to dedicated module (#393). * Move definitions related to `ExprPair` type to dedicated module (#395). * Move functions related to Copilot specs to dedicated modules (#397). * Rename module to more accurately reflect intent (#399). * Move auxiliary function into new auxiliary module (#401). * Split `Command.CommonDiagram` into smaller, more cohesive modules (#403). * Simplify internal definition `showTransitions` (#405). * Add diagram query functions to `Data.Diagram` (#407). * Factorize translation of diagrams to Copilot into separate module (#409). * Remove unnecessary arguments in code generated by diagram backend (#411). * Move functions related to reading specs to dedicated module (#413). * Make standalone, app backends support working directly with diagrams (#415). * Add support for reading specs from YAML files (#417). * Fix order of arguments in calls to internal function (#419). * Adjust standalone, app backends to support multiple input specs (#421). * Introduce report command (#423). ## [1.13.0] - 2026-03-21 * Version bump (1.13.0) (#373). * Remove unused functions from diagram template (#351). * Add dockerfile to cFS template (#353). * Augment overview command to formally analyze specs (#356). * Augment overview command to determine consistency of specs (#366). * Expand extra definitions in Copilot specs in templates (#368). ## [1.12.0] - 2026-01-21 * Version bump 1.12.0 (#336). * Add support for state machine mermaid diagrams (#328). * Add support for sequence diagrams in Mermaid (#330). ## [1.11.0] - 2025-11-21 * Version bump 1.11.0 (#325). * Make state machine code return the current state (#317). * Negate condition in state machine monitor (#318). ## [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.14.0/Setup.hs0000644000000000000000000000005615204000371013261 0ustar0000000000000000import Distribution.Simple main = defaultMain ogma-core-1.14.0/data/0000755000000000000000000000000015204000371012535 5ustar0000000000000000ogma-core-1.14.0/data/variable-db.json0000644000000000000000000000762615204000371015613 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.14.0/data/formats/0000755000000000000000000000000015204000371014210 5ustar0000000000000000ogma-core-1.14.0/data/formats/xml-md_smv0000644000000000000000000000136115204000371016217 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.14.0/data/formats/xml-reqif_lustre0000644000000000000000000000231515204000371017436 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.14.0/data/formats/xml-reqif_smv0000644000000000000000000000231515204000371016725 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.14.0/data/formats/fdb_smv0000644000000000000000000000107215204000371015553 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.14.0/data/formats/xml-md_lustre0000644000000000000000000000136115204000371016730 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.14.0/data/formats/fcs_smv0000644000000000000000000000115615204000371015576 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.14.0/data/formats/fdb_lustre0000644000000000000000000000107415204000371016266 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.14.0/data/formats/fcs_lustre0000644000000000000000000000116515204000371016307 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.14.0/templates/0000755000000000000000000000000015204000371013622 5ustar0000000000000000ogma-core-1.14.0/templates/cfs/0000755000000000000000000000000015204000371014375 5ustar0000000000000000ogma-core-1.14.0/templates/cfs/Dockerfile0000644000000000000000000000172615204000371016375 0ustar0000000000000000FROM ubuntu:22.04 RUN apt-get update ENV DEBIAN_FRONTEND=noninteractive RUN apt-get install --yes \ alex \ cabal-install \ cmake \ gcc-multilib \ ghc \ git \ happy \ libz-dev \ pkg-config ENV PATH="$HOME/.cabal/bin:$HOME/.ghcup/bin":$PATH WORKDIR /root # Obtain cFS RUN git clone https://github.com/nasa/cfs.git cfs WORKDIR /root/cfs RUN git checkout v6.7.0a RUN git submodule update --init --recursive # Copy Copilot app with other cFS apps ADD copilot /root/cfs/apps/copilot # Copy default setup, list of CPUs and applications RUN cp cfe/cmake/Makefile.sample Makefile RUN cp -r cfe/cmake/sample_defs . # Enable Ogma-generated cFS app in cFS RUN sed -i -e 's/\(SET(TGT1_APPLIST.*\))/\1 copilot)/g' sample_defs/targets.cmake RUN sed -i -e '0,/^!/s//CFE_APP, \/cf\/copilot_cfs.so, COPILOT_AppMain, COPILOT_APP, 50, 16384, 0x0, 0;\n&/' sample_defs/cpu1_cfe_es_startup.scr RUN make SIMULATION=native prep RUN make install ogma-core-1.14.0/templates/cfs/copilot/0000755000000000000000000000000015204000371016046 5ustar0000000000000000ogma-core-1.14.0/templates/cfs/copilot/CMakeLists.txt0000644000000000000000000000314515204000371020611 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.14.0/templates/cfs/copilot/fsw/0000755000000000000000000000000015204000371016645 5ustar0000000000000000ogma-core-1.14.0/templates/cfs/copilot/fsw/for_build/0000755000000000000000000000000015204000371020612 5ustar0000000000000000ogma-core-1.14.0/templates/cfs/copilot/fsw/for_build/Makefile0000644000000000000000000000560515204000371022260 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.14.0/templates/cfs/copilot/fsw/mission_inc/0000755000000000000000000000000015204000371021157 5ustar0000000000000000ogma-core-1.14.0/templates/cfs/copilot/fsw/mission_inc/copilot_cfs_perfids.h0000644000000000000000000000075515204000371025357 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.14.0/templates/cfs/copilot/fsw/src/0000755000000000000000000000000015204000371017434 5ustar0000000000000000ogma-core-1.14.0/templates/cfs/copilot/fsw/src/copilot_cfs_msg.h0000644000000000000000000000200315204000371022752 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.14.0/templates/cfs/copilot/fsw/src/copilot_cfs_events.h0000644000000000000000000000131015204000371023470 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.14.0/templates/cfs/copilot/fsw/src/copilot_cfs.h0000644000000000000000000000252015204000371022110 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.14.0/templates/cfs/copilot/fsw/src/copilot_cfs_version.h0000644000000000000000000000117215204000371023657 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.14.0/templates/cfs/copilot/fsw/src/Properties.hs0000644000000000000000000000432515204000371022130 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_extra_defs}} {{{.}}} {{/copilot_extra_defs}} {{{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 -- Initial state, final state, no transition signal, transitions, bad state type StateMachineGF a = (a, a, Stream Bool, [(a, Stream Bool, a)], a) stateMachineGF :: (Eq a, Typed a) => StateMachineGF a -> Stream a stateMachineGF (initial, final, noInputData, transitions, bad) = state where state = ifThenElses transitions previousState = [initial] ++ state -- ifThenElses :: [(a, Stream Bool, a)] -> Stream a ifThenElses [] = ifThenElse (previousState == constant final && noInputData) (constant final) (constant bad) ifThenElses ((s1, i, s2):ss) = ifThenElse (previousState == constant s1 && i) (constant s2) (ifThenElses ss) -- | 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.14.0/templates/cfs/copilot/fsw/src/copilot_cfs.c0000644000000000000000000001274715204000371022117 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.14.0/templates/cfs/copilot/fsw/platform_inc/0000755000000000000000000000000015204000371021322 5ustar0000000000000000ogma-core-1.14.0/templates/cfs/copilot/fsw/platform_inc/copilot_cfs_msgids.h0000644000000000000000000000106115204000371025343 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.14.0/templates/ros/0000755000000000000000000000000015204000371014425 5ustar0000000000000000ogma-core-1.14.0/templates/ros/screenrc0000644000000000000000000000150715204000371016157 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.14.0/templates/ros/Dockerfile0000644000000000000000000000127715204000371016426 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.14.0/templates/ros/copilot/0000755000000000000000000000000015204000371016076 5ustar0000000000000000ogma-core-1.14.0/templates/ros/copilot/CMakeLists.txt0000644000000000000000000000136415204000371020642 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.14.0/templates/ros/copilot/package.xml0000644000000000000000000000120515204000371020211 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.14.0/templates/ros/copilot/src/0000755000000000000000000000000015204000371016665 5ustar0000000000000000ogma-core-1.14.0/templates/ros/copilot/src/Copilot.hs0000644000000000000000000000415715204000371020641 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_extra_defs}} {{{.}}} {{/copilot_extra_defs}} {{{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 -- Initial state, final state, no transition signal, transitions, bad state type StateMachineGF a = (a, a, Stream Bool, [(a, Stream Bool, a)], a) stateMachineGF :: (Eq a, Typed a) => StateMachineGF a -> Stream a stateMachineGF (initial, final, noInputData, transitions, bad) = state where state = ifThenElses transitions previousState = [initial] ++ state -- ifThenElses :: [(a, Stream Bool, a)] -> Stream a ifThenElses [] = ifThenElse (previousState == constant final && noInputData) (constant final) (constant bad) ifThenElses ((s1, i, s2):ss) = ifThenElse (previousState == constant s1 && i) (constant s2) (ifThenElses ss) -- | 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.14.0/templates/ros/copilot/src/copilot_logger.cpp0000644000000000000000000000376215204000371022411 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.14.0/templates/ros/copilot/src/copilot_monitor.cpp0000644000000000000000000000637515204000371022624 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.14.0/templates/ros/test_requirements/0000755000000000000000000000000015204000371020207 5ustar0000000000000000ogma-core-1.14.0/templates/ros/test_requirements/CMakeLists.txt0000644000000000000000000000125415204000371022751 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.14.0/templates/ros/test_requirements/package.xml0000644000000000000000000000121715204000371022325 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.14.0/templates/ros/test_requirements/src/0000755000000000000000000000000015204000371020776 5ustar0000000000000000ogma-core-1.14.0/templates/ros/test_requirements/src/test_requirements.cpp0000644000000000000000000001254215204000371025270 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.14.0/templates/fprime/0000755000000000000000000000000015204000371015104 5ustar0000000000000000ogma-core-1.14.0/templates/fprime/Copilot.hpp0000644000000000000000000000375215204000371017235 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.14.0/templates/fprime/instance-copilot0000644000000000000000000000013315204000371020277 0ustar0000000000000000 instance copilotMonitor: Ref.Copilot base id 0x2700 \ queue size Default.QUEUE_SIZE ogma-core-1.14.0/templates/fprime/Dockerfile0000644000000000000000000000343315204000371017101 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.14.0/templates/fprime/Copilot.fpp0000644000000000000000000000401315204000371017222 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.14.0/templates/fprime/CMakeLists.txt0000644000000000000000000000043415204000371017645 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.14.0/templates/fprime/Copilot.cpp0000644000000000000000000000456115204000371017227 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.14.0/templates/standalone/0000755000000000000000000000000015204000371015752 5ustar0000000000000000ogma-core-1.14.0/templates/standalone/Copilot.hs0000644000000000000000000000371615204000371017726 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) {{#copilot_extra_defs}} {{{.}}} {{/copilot_extra_defs}} {{{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 -- Initial state, final state, no transition signal, transitions, bad state type StateMachineGF a = (a, a, Stream Bool, [(a, Stream Bool, a)], a) stateMachineGF :: (Eq a, Typed a) => StateMachineGF a -> Stream a stateMachineGF (initial, final, noInputData, transitions, bad) = state where state = ifThenElses transitions previousState = [initial] ++ state -- ifThenElses :: [(a, Stream Bool, a)] -> Stream a ifThenElses [] = ifThenElse (previousState == constant final && noInputData) (constant final) (constant bad) ifThenElses ((s1, i, s2):ss) = ifThenElse (previousState == constant s1 && i) (constant s2) (ifThenElses ss) -- | 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.14.0/templates/diagram/0000755000000000000000000000000015204000371015226 5ustar0000000000000000ogma-core-1.14.0/templates/diagram/Copilot.hs0000644000000000000000000000346415204000371017202 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 {{{triggers}}} 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 = ifThenElses transitions previousState = [initialState] ++ state ifThenElses :: [(Word8, Stream Bool, Word8)] -> Stream Word8 ifThenElses [] = ifThenElse (previousState == constant finalState && noInputData) (constant finalState) (constant badState) ifThenElses ((s1,i,s2):ss) = ifThenElse (previousState == constant s1 && i) (constant s2) (ifThenElses ss) ogma-core-1.14.0/templates/report/0000755000000000000000000000000015204000371015135 5ustar0000000000000000ogma-core-1.14.0/templates/report/Report.md0000644000000000000000000000312715204000371016735 0ustar0000000000000000{{#commandDiagramsAny}} # Diagrams {{#commandDiagramList}} ## Diagram The diagram: - Has {{summaryDiagramNumStates}} states. {{#summaryDiagramDeterministic}} - Is deterministic. {{/summaryDiagramDeterministic}} {{^summaryDiagramDeterministic}} - Is not deterministic. {{/summaryDiagramDeterministic}} {{/commandDiagramList}} {{/commandDiagramsAny}} {{#commandRequirementsAny}} # Requirements ## Summary The project has {{commandRequirements}} requirements in total. Of these requirements: - {{commandRequirementsTrue}} requirements are constantly or always true. - {{commandRequirementsFalse}} requirements are constantly or always false. {{#commandRequirementsConsistent}} No inconsistencies detected in the requirements. {{/commandRequirementsConsistent}} {{^commandRequirementsConsistent}} The requirements are not mutually consistent: there is no way for all requirements to be true at the same time. {{/commandRequirementsConsistent}} The requirements mention: - {{commandExternalVariables}} external variables. - {{commandInternalVariables}} internal variables. ## Detailed list {{#commandRequirementList}} ### {{summaryRequirementName}} **Description:** {{summaryRequirementDesc}} **Properties:** {{#summaryRequirementTrue}} - The requirement is always true or vacuously true. {{/summaryRequirementTrue}} {{#summaryRequirementFalse}} - The requirement is always false or vacuously false. {{/summaryRequirementFalse}} {{^summaryRequirementTrue}} {{^summaryRequirementFalse}} - None. {{/summaryRequirementFalse}} {{/summaryRequirementTrue}} {{/commandRequirementList}} {{/commandRequirementsAny}} ogma-core-1.14.0/tests/0000755000000000000000000000000015204000371012766 5ustar0000000000000000ogma-core-1.14.0/tests/commands-fcs-error-parsing-failed-2.json0000644000000000000000000000467415204000371022417 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.14.0/tests/Main.hs0000644000000000000000000001316115204000371014210 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 , commandInputFiles = [ 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 , commandInputFiles = [ 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.14.0/tests/commands-fcs-error-parsing-failed-1.json0000644000000000000000000000471315204000371022410 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.14.0/tests/reduced_geofence_msgs_bad.h0000644000000000000000000000051115204000371020241 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.14.0/tests/reduced_geofence_msgs.h0000644000000000000000000000050615204000371017437 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.14.0/tests/fdb-example1.json0000644000000000000000000002257515204000371016141 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.14.0/tests/commands-fcs-error-parsing-failed-3.json0000644000000000000000000000474515204000371022417 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.14.0/tests/fcs_good.json0000644000000000000000000000502215204000371015443 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.14.0/src/0000755000000000000000000000000015204000371012413 5ustar0000000000000000ogma-core-1.14.0/src/Language/0000755000000000000000000000000015204000371014136 5ustar0000000000000000ogma-core-1.14.0/src/Language/Trans/0000755000000000000000000000000015204000371015225 5ustar0000000000000000ogma-core-1.14.0/src/Language/Trans/CStruct2CopilotStruct.hs0000644000000000000000000001557315204000371022004 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.14.0/src/Language/Trans/SMV2Copilot.hs0000644000000000000000000002116215204000371017644 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.14.0/src/Language/Trans/CStructs2Copilot.hs0000644000000000000000000001532315204000371020753 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.14.0/src/Language/Trans/Lustre2Copilot.hs0000644000000000000000000002050415204000371020454 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.14.0/src/Language/Trans/Spec2Copilot.hs0000644000000000000000000002150515204000371020072 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.14.0/src/Language/Trans/CStructs2MsgHandlers.hs0000644000000000000000000000470715204000371021555 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.14.0/src/Language/Trans/Diagram2Copilot.hs0000644000000000000000000000774415204000371020555 0ustar0000000000000000-- 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 Language.Trans.Diagram2Copilot ( DiagramMode(..) , diagram2CopilotSpec , diagram2Copilot ) where -- External imports import Data.List (intercalate, nub, sort) -- Internal imports: auxiliary import Data.Diagram (Diagram (..), diagramBadState, diagramFinalState, diagramInitialState) -- | 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) -- | Convert the diagram into a set of Copilot definitions, and a list of -- indented trigger definitions to include in the Copilot spec. diagram2CopilotSpec :: Diagram -> DiagramMode -> (String, String) diagram2CopilotSpec diag mode = (machine, triggers) where machine = unlines [ "stateMachineS :: Stream Word8" , "stateMachineS = stateMachineGF stateMachine1" , "" , "stateMachineProp :: Stream Bool" , "stateMachineProp = " ++ propExpr , "" ] ++ diagram2Copilot diag -- Elements of the spec. propExpr = case mode of CheckState -> "stateMachineS /= externalState" ComputeState -> "true" CheckMoves -> "true" triggers = " trigger \"handler\" stateMachineProp " ++ arguments -- Arguments for the handler. arguments = "[ " ++ intercalate ", " (map ("arg " ++) argExprs) ++ " ]" argExprs = case mode of CheckState -> [ "stateMachineS" ] ComputeState -> [ "stateMachineS" ] 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 ] -- | Convert the diagram into a set of Copilot definitions. diagram2Copilot :: Diagram -> String diagram2Copilot diag = unlines [ "stateMachine1 :: ( Word8" , " , Word8" , " , Stream Bool" , " , [(Word8, Stream Bool, Word8)]" , " , Word8" , " )" , "stateMachine1 =" , " (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 ] where initialState = diagramInitialState diag finalState = diagramFinalState diag badState = diagramBadState diag transitions = diagramTransitions diag showTransitions :: String showTransitions = "[" ++ intercalate ", " (map showTransition transitions) ++ "]" showTransition :: (Int, String, Int) -> String showTransition (a, b, c) = "(" ++ show a ++ ", " ++ b ++ ", " ++ show c ++ ")" ogma-core-1.14.0/src/Language/YAMLSpec/0000755000000000000000000000000015204000371015513 5ustar0000000000000000ogma-core-1.14.0/src/Language/YAMLSpec/Parser.hs0000644000000000000000000002111715204000371017305 0ustar0000000000000000{-# 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. -- | Parser for Ogma specs stored in YAML files. module Language.YAMLSpec.Parser where -- External imports import Control.Monad.Except (ExceptT (..), runExceptT) import Control.Monad.IO.Class (liftIO) import Data.Aeson (Value (..)) import Data.Aeson.Key (fromString) import qualified Data.Aeson.KeyMap as M import qualified Data.ByteString as BS import Data.Char (isSpace) import Data.List (intercalate) import Data.Text (unpack) import qualified Data.Vector as V import qualified Data.Yaml as Y -- External imports: ogma-spec import Data.Either.Extra (mapLeft) import Data.OgmaSpec (ExternalVariableDef (..), InternalVariableDef (..), Requirement (..), Spec (..)) -- | Field names of a spec listed in a YAML file. data YAMLFormat = YAMLFormat { specInternalVars :: Maybe String , specInternalVarId :: String , specInternalVarExpr :: String , specInternalVarType :: Maybe String , specExternalVars :: Maybe String , specExternalVarId :: String , specExternalVarType :: Maybe String , specRequirements :: Maybe String , specRequirementId :: Maybe String , specRequirementDesc :: Maybe String , specRequirementExpr :: String , specRequirementResultType :: Maybe String , specRequirementResultExpr :: Maybe String } deriving (Read) -- | Parse a spec from a YAML file. parseYAMLSpec :: forall a . (String -> IO (Either String a)) -> YAMLFormat -> BS.ByteString -> IO (Either String (Spec a)) parseYAMLSpec parseExpr yamlFormat bs = runExceptT $ do value <- except $ mapLeft Y.prettyPrintParseException $ Y.decodeEither' bs let values :: [Value] values = maybe [] (objectFieldValueList value) (specInternalVars yamlFormat) internalVarDef :: Value -> Either String InternalVariableDef internalVarDef value = do let msg = "internal variable name" varId <- valueToString msg =<< listToEither msg (objectFieldValues (specInternalVarId yamlFormat) value) let msg = "internal variable type" varType <- maybe (Right "") (\e -> valueToString msg =<< (listToEither msg (objectFieldValues e value))) (specInternalVarType yamlFormat) let msg = "internal variable expr" varExpr <- valueToString msg =<< listToEither msg (objectFieldValues (specInternalVarExpr yamlFormat) value) return $ InternalVariableDef { internalVariableName = varId , internalVariableType = varType , internalVariableExpr = varExpr } internalVariableDefs <- except $ mapM internalVarDef values let values :: [Value] values = maybe [] (objectFieldValueList value) (specExternalVars yamlFormat) externalVarDef :: Value -> Either String ExternalVariableDef externalVarDef value = do let msg = "external variable name" varId <- valueToString msg =<< listToEither msg (objectFieldValues (specExternalVarId yamlFormat) value) let msg = "external variable type" varType <- maybe (Right "") (\e -> valueToString msg =<< (listToEither msg (objectFieldValues e value))) (specExternalVarType yamlFormat) return $ ExternalVariableDef { externalVariableName = varId , externalVariableType = varType } externalVariableDefs <- except $ mapM externalVarDef values let values :: [Value] values = maybe [value] (objectFieldValueList value) (specRequirements yamlFormat) requirementDef value = do let msg = "Requirement name" reqId <- except $ maybe (Right "") (\e -> valueToString msg =<< (listToEither msg (objectFieldValues e value))) (specRequirementId yamlFormat) let msg = "Requirement expression" reqExpr <- except $ valueToString msg =<< listToEither msg (objectFieldValues (specRequirementExpr yamlFormat) value) reqExpr' <- ExceptT $ parseExpr reqExpr let msg = "Requirement description" reqDesc <- except $ maybe (Right "") (\e -> valueToString msg =<< (listToEither msg (objectFieldValues e value))) (specRequirementDesc yamlFormat) let reqDesc' = cleanString reqDesc let msg = "Requirement result type" ty :: Maybe (Either String String) ty = (\e -> valueToString msg =<< (listToEither msg (objectFieldValues e value))) <$> (specRequirementResultType yamlFormat) reqResType <- except $ maybeEither ty let msg = "Requirement result expression" resultExpr :: Maybe (Either String String) resultExpr = (\e -> valueToString msg =<< (listToEither msg (objectFieldValues e value))) <$> (specRequirementResultExpr yamlFormat) reqResExpr <- except $ maybeEither resultExpr reqResExpr' <- ExceptT $ case reqResExpr of Nothing -> return $ Right Nothing Just x -> fmap Just <$> parseExpr x return $ Requirement { requirementName = reqId , requirementExpr = reqExpr' , requirementDescription = reqDesc' , requirementResultType = reqResType , requirementResultExpr = reqResExpr' } requirements <- mapM requirementDef values return $ Spec internalVariableDefs externalVariableDefs requirements -- * Auxiliary functions -- ** JSON functions -- | Convert a string JSON value into a 'String'. valueToString :: String -> Value -> Either String String valueToString msg (String x) = Right $ unpack x valueToString msg _ = Left $ "The YAML value provided for " ++ msg ++ " does not contain a string" -- | Object the values associated to a key of an object. -- -- If the values are an array, it returns the values in the array directly. objectFieldValueList :: Value -> String -> [Value] objectFieldValueList (Object o) key = case M.lookup (fromString key) o of Just (Array arr) -> V.toList arr Just v -> [v] Nothing -> [] objectFieldValueList _ _ = [] -- | Object the values associated to a key of an object. -- -- If the values are an array, it returns the values in the array directly. objectFieldValues :: String -> Value -> [Value] objectFieldValues key (Object o) = maybe [] (:[]) $ M.lookup (fromString key) o objectFieldValues _ _ = [] -- ** Either-related auxiliary functions -- | Convert a string into an Either value. -- -- Fails if there more or less than one value in the list. listToEither :: String -> [a] -> Either String a listToEither _ [x] = Right x listToEither msg [] = Left $ "Failed to find a value for " ++ msg listToEither msg _ = Left $ "Unexpectedly found multiple values for " ++ msg -- | Wrap an 'Either' value in an @ExceptT m@ monad. except :: Monad m => Either e a -> ExceptT e m a except = ExceptT . return -- | Swap the order in a Maybe and an Either monad. maybeEither :: Maybe (Either a b) -> Either a (Maybe b) maybeEither Nothing = Right Nothing maybeEither (Just e) = fmap Just e -- ** String-related auxiliary functions -- | Remove trailing spaces and lines from a multi-line string. cleanString :: String -> String cleanString = unlines' . dropWhile null . dropWhileEnd null . map strip . lines where strip = dropWhile isSpace . dropWhileEnd isSpace dropWhileEnd x = reverse . dropWhile x . reverse -- | Concatenate a list of strings into one string, separated by a line ending. -- -- This variant of 'unlines' does not add a line break at the end of the last -- line. unlines' :: [String] -> String unlines' = intercalate "\n" ogma-core-1.14.0/src/Data/0000755000000000000000000000000015204000371013264 5ustar0000000000000000ogma-core-1.14.0/src/Data/ExprPair.hs0000644000000000000000000000741215204000371015356 0ustar0000000000000000{-# LANGUAGE ExistentialQuantification #-} -- 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. -- -- | Abstraction for expressions used in specifications. module Data.ExprPair ( ExprPair(..) , ExprPairT(..) , exprPair , exprPairShow ) where -- External imports 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) -- | Existential wrapper over abstraction to handle expressions used in -- specifications. -- -- The abstraction provides mechanisms to parse expressions, replace variables -- in them, render them in a known format or notation, and find identifiers in -- them, and it provides a default value to use when an expression is needed. data ExprPair = forall a . ExprPair { exprTPair :: ExprPairT a } -- | Abstraction to handle expressions used in specifications. -- -- The abstraction provides mechanisms to parse expressions, replace variables -- in them, render them in a known format or notation, and find identifiers in -- them, and it provides a default value to use when an expression is needed. data ExprPairT a = ExprPairT { exprTParse :: String -> Either String a , exprTReplace :: [(String, String)] -> a -> a , exprTPrint :: a -> String , exprTIdents :: a -> [String] , exprTUnknown :: a } -- | Return 'ExprPair' for a given language (e.g., Lustre, SMV). -- -- The language name must be lowercase. -- -- We default to SMV if no format is given. -- -- The format literal returns an ExprPair that uses Strings as the base type -- and keeps them unchanged. 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")) -- | Parse and print a value using an auxiliary Expression Pair. -- -- Fails if the value has no valid parse. exprPairShow :: ExprPair -> String -> String exprPairShow (ExprPair exprP) = printProp . fromRight' . parseProp where ExprPairT parseProp _replace printProp _ids _unknown = exprP -- | 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.14.0/src/Data/Diagram.hs0000644000000000000000000000347115204000371015171 0ustar0000000000000000-- 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. -- -- | Diagrams. module Data.Diagram ( Diagram(..) , diagramStates , diagramNumStates , diagramInitialState , diagramFinalState , diagramBadState ) where -- External imports import Data.List (nub, sort) -- | Internal representation for diagrams. newtype Diagram = Diagram { diagramTransitions :: [(Int, String, Int)] } deriving (Show, Eq) -- | States in a diagram. diagramStates :: Diagram -> [Int] diagramStates diagram = nub $ sort $ concat [ [s, d] | (s, _, d) <- diagramTransitions diagram ] -- | Number of states in a diagram. diagramNumStates :: Diagram -> Int diagramNumStates = length . diagramStates -- | Initial state of a diagram. diagramInitialState :: Diagram -> Int diagramInitialState = minimum . diagramStates -- | Final state of a diagram. -- -- PRE: The diagram obtains one and only one final state. diagramFinalState :: Diagram -> Int diagramFinalState = maximum . diagramStates -- | Return a state value that does not represent any state in the diagram. diagramBadState :: Diagram -> Int diagramBadState diag = maximum (diagramStates diag) + 1 ogma-core-1.14.0/src/Data/Location.hs0000644000000000000000000000242015204000371015366 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.14.0/src/Data/Aeson/0000755000000000000000000000000015204000371014331 5ustar0000000000000000ogma-core-1.14.0/src/Data/Aeson/Extra.hs0000644000000000000000000000241715204000371015754 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. -- -- | Auxiliary functions for working with JSON values. module Data.Aeson.Extra ( mergeObjects ) where -- External imports import Data.Aeson (Value (Null, Object)) import Data.Aeson.KeyMap (union) -- | Merge two JSON values. -- -- 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" ogma-core-1.14.0/src/Data/Diagram/0000755000000000000000000000000015204000371014630 5ustar0000000000000000ogma-core-1.14.0/src/Data/Diagram/Analysis.hs0000644000000000000000000001213315204000371016747 0ustar0000000000000000-- 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. -- -- | Formal analysis of diagrams. module Data.Diagram.Analysis ( analyzeDiagram , AnalysisResult(..) ) where -- External imports import qualified Copilot.Core as Core -- Internal imports: auxiliary import Copilot.Core.Analysis (exprIsConstant) import Copilot.Language.Reify.Extra (reifySpec) import Data.Diagram (Diagram (..), diagramNumStates) import Language.Trans.Diagram2Copilot (diagram2Copilot) -- * Analysis of Specs -- | Result of analyzing a diagram. data AnalysisResult = AnalysisResult { numStates :: Int -- ^ Number of states in the diagram. , deterministic :: Bool -- ^ True if the diagram is deterministic. } -- | Formally analyze a diagram. analyzeDiagram :: Diagram -> IO AnalysisResult analyzeDiagram diagram = do let nStates = diagramNumStates diagram coreSpec <- reifySpec defaultSpecImports $ showDiagram diagram let properties = zip ["deterministic"] propertyGuards propertyGuards = map Core.triggerGuard $ Core.specTriggers coreSpec constantProperties <- mapM (uncurry $ exprIsConstant coreSpec) properties let numTrue = length $ filter fst constantProperties let diagramDeterministic = numTrue > 0 return $ AnalysisResult nStates diagramDeterministic -- | Default imports for a 'Spec' that was converted into a 'Copilot.Spec'. defaultSpecImports :: [(String, Maybe String)] defaultSpecImports = [ ("Control.Monad.Writer", Nothing) , ("Copilot.Language", Nothing) , ("Copilot.Language.Spec", Nothing) , ("Data.Functor.Identity", Nothing) , ("Data.List", Just "L") , ("Prelude", Just "P") ] -- | Render a 'Diagram' as a Haskell definition of a 'Copilot.Spec'. -- -- The shown 'Copilot.Spec' has a top-level triggers for the properties we are -- interested in, as well as several auxiliary definitions. showDiagram :: Diagram -> String showDiagram diagram = unlines $ [ "do let" ] ++ map (" " ++) (lines auxiliaryDefinitions) ++ map (" " ++) (lines input) ++ map (" " ++) (lines diagramDefinitions) ++ [ " trigger \"deterministic\" (isDeterministic stateMachine1) []" ] where input = unlines [ "input :: Stream Word8" , "input = extern \"input\" Nothing" ] diagramDefinitions = diagram2Copilot diagram -- | Auxiliary definitions needed in the spec. auxiliaryDefinitions :: String auxiliaryDefinitions = unlines [ "stateMachine :: (Eq a, Typed a)" , " => (a, a, Stream Bool, [(a, Stream Bool, a)], a)" , " -> Stream a" , "stateMachine (initial, final, noInputData, transitions, bad) =" , " state" , " where" , " state = ifThenElses transitions" , " previousState = [initial] ++ state" , "" , " -- ifThenElses :: [(a, Stream Bool, a)] -> Stream a" , " ifThenElses [] =" , " ifThenElse" , " (previousState == constant final && noInputData)" , " (constant final)" , " (constant bad)" , "" , " ifThenElses ((s1, i, s2):ss) =" , " ifThenElse" , " (previousState == constant s1 && i)" , " (constant s2)" , " (ifThenElses ss)" , "" , "isDeterministic :: (Ord a, Eq a, Typed a)" , " => (a, a, Stream Bool, [(a, Stream Bool, a)], a)" , " -> Stream Bool" , "isDeterministic (_, _, _, ts, _) = all $" , " map" , " (\\s -> all (map not $ pairwise $ transitionsFrom s))" , " states" , " where" , " states = L.nub $ L.sort $ concat $" , " map (\\(s1, _, s2) -> [s1, s2]) ts" , "" , " transitionsFrom s = [ t | (s1, t, _) <- ts, s P.== s1 ]" , "" , "completeMachine :: (Ord a, Eq a, Typed a)" , " => (a, a, Stream Bool, [(a, Stream Bool, a)], a)" , " -> Stream Bool" , "completeMachine (_, _, _, ts, _) = all $" , " map (\\s -> or $ transitionsFrom s) states" , " where" , " states = L.nub $ L.sort $ concat $" , " map (\\(s1, _, s2) -> [s1, s2]) ts" , " transitionsFrom s = [ t | (s1, t, _) <- ts, s P.== s1 ]" , "" , "all [] = true" , "all (x:xs) = x && all xs" , "" , "or [] = false" , "or (x:xs) = x || or xs" , "" , "pairwise :: [ Stream Bool ] -> [ Stream Bool ]" , "pairwise [] = []" , "pairwise (x:[]) = []" , "pairwise (x1:xs) =" , " (map (\\x2 -> (x1 && x2)) xs) P.++ pairwise xs" ] ogma-core-1.14.0/src/Data/Diagram/Parser.hs0000644000000000000000000000600315204000371016417 0ustar0000000000000000-- 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. -- -- | Parsing of diagrams. module Data.Diagram.Parser ( DiagramFormat(..) , readDiagram ) where -- External imports import Control.Monad.Except (ExceptT (..)) import qualified Data.ByteString.Lazy as B -- External imports: auxiliary import Data.ByteString.Extra as B (safeReadFile) -- Internal imports: auxiliary import Command.Errors (ErrorCode, ErrorTriplet (..)) import Data.Diagram (Diagram) import Data.Diagram.Parser.Dot (parseDiagramDot) import Data.Diagram.Parser.Mermaid (parseDiagramMermaid) import Data.Either.Extra (mapLeft) import Data.ExprPair (ExprPair) import Data.Location (Location (..)) -- | Diagram formats supported. data DiagramFormat = Mermaid | Dot deriving (Eq, Show) -- | Read a diagram from a file. readDiagram :: FilePath -- ^ File containing diagram -> DiagramFormat -- ^ Format of the input file -> ExprPair -- ^ Subparser for conditions -- or edge expressions -> ExceptT ErrorTriplet IO Diagram readDiagram fp format exprP = ExceptT $ do contentEither <- B.safeReadFile fp let diagramE = do -- The following functions use Either to return errors. The use of -- (>>=) to chain functions makes the program stop at the earliest -- error. diagFileContent <- contentEither -- Abtract representation of a state machine diagram. parseDiagram format diagFileContent exprP pure $ mapLeft (\msg -> ErrorTriplet ecCannotReadDiagram msg (LocationFile fp)) diagramE --- | 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 -- ** Error codes -- | Error: the diagram cannot be read due to an error opening the file or -- parsing the file. ecCannotReadDiagram :: ErrorCode ecCannotReadDiagram = 1 ogma-core-1.14.0/src/Data/Diagram/Parser/0000755000000000000000000000000015204000371016064 5ustar0000000000000000ogma-core-1.14.0/src/Data/Diagram/Parser/Dot.hs0000644000000000000000000000477415204000371017162 0ustar0000000000000000{-# 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. -- -- | Parsing of diagrams from Dot files. module Data.Diagram.Parser.Dot ( parseDiagramDot ) where -- External imports import qualified Data.ByteString.Lazy as B 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 qualified Data.Text.Lazy as LT -- Internal imports: auxiliary import Data.Diagram (Diagram (..)) import Data.ExprPair (ExprPair, exprPairShow) -- | 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 ogma-core-1.14.0/src/Data/Diagram/Parser/Mermaid.hs0000644000000000000000000001357015204000371020004 0ustar0000000000000000{-# 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. -- -- | Parsing of diagrams from Mermaid files. module Data.Diagram.Parser.Mermaid ( parseDiagramMermaid ) where -- External imports import Control.Monad (void, when) import Data.ByteString.Lazy (toStrict) import qualified Data.ByteString.Lazy as B import Data.Either (isLeft) import Data.Functor.Identity (Identity) 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.Void (Void) import Text.Megaparsec (ErrorFancy (ErrorFail), ParsecT, choice, 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 -- Internal imports: auxiliary import Data.Diagram (Diagram (..)) import Data.ExprPair (ExprPair (..), ExprPairT (..), exprPairShow) -- | 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 mermaid diagrams. pDiagram :: ExprPair -> MermaidParser Diagram pDiagram exprP = pGraphDiagram exprP <|> pStateDiagram exprP <|> pSequenceDiagram exprP -- | Parser for a mermaid diagram. -- -- This parser depends on an auxiliary parser for the expressions associated to -- the edges or connections between states. pGraphDiagram :: ExprPair -> MermaidParser Diagram pGraphDiagram exprP = do _ <- string "graph" <* spaces _name <- T.pack <$> manyTill alphaNumChar (char ';') _ <- newline transitions <- many (pGraphTransition 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. pGraphTransition :: ExprPair -> MermaidParser (Int, String, Int) pGraphTransition ep@(ExprPair (ExprPairT { exprTParse = 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) -- | Parser for Mermaid diagrams of type stateDiagram-v2. pStateDiagram :: ExprPair -> MermaidParser Diagram pStateDiagram exprPair = do _ <- string "stateDiagram-v2" <* spaces transitions <- many (pStateTransition exprPair) pure $ Diagram transitions -- | Parser for transition label in stateDiagram-v2 mermaid diagram. pStateTransition :: ExprPair -> MermaidParser (Int, String, Int) pStateTransition ep@(ExprPair (ExprPairT { exprTParse = parseProp })) = do _ <- spaces from <- read <$> many digitChar _ <- spaces string "-->" _ <- spaces to <- read <$> many digitChar _ <- spaces _ <- char ':' _ <- spaces edge <- many (noneOf ("\n" :: [Char])) let x = parseProp edge when (isLeft x) $ fancyFailure $ Set.singleton $ ErrorFail $ "Edge property has incorrect format: " ++ show edge _ <- newline pure $ (from, exprPairShow ep edge, to) -- | Parser for Mermaid diagrams of type sequenceDiagram. pSequenceDiagram :: ExprPair -> MermaidParser Diagram pSequenceDiagram exprPair = do spaces _ <- string "sequenceDiagram" spaces conditions <- many (pSequenceTransition exprPair) let transitions = zipWith (\t idx -> (idx, t, idx + 1)) conditions [0..] pure $ Diagram transitions -- | Parser for a connection, message or transition in a sequence diagram. -- -- This parser depends on an auxiliary parser for the expressions associated to -- the connections or messages between elements. pSequenceTransition :: ExprPair -> MermaidParser String pSequenceTransition ep@(ExprPair (ExprPairT { exprTParse = parseProp })) = do spaces stateFrom <- many digitChar spaces pSequenceArrow spaces stateTo <- many digitChar spaces _ <- char ':' spaces edge <- many (noneOf ("\n" :: [Char])) let x = parseProp edge when (isLeft x) $ fancyFailure $ Set.singleton $ ErrorFail $ "Edge property has incorrect format: " ++ show edge _ <- newline pure (exprPairShow ep edge) -- | Parser for arrow in sequence diagram. pSequenceArrow :: MermaidParser () pSequenceArrow = void $ choice [ string "->>" , string "-->>" , string "-)" ] -- | Consume spaces spaces :: MermaidParser () spaces = L.space space1 empty empty ogma-core-1.14.0/src/Data/Either/0000755000000000000000000000000015204000371014504 5ustar0000000000000000ogma-core-1.14.0/src/Data/Either/Extra.hs0000644000000000000000000000232515204000371016125 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. -- -- | Auxiliary functions for working with values of type 'Either'. module Data.Either.Extra ( makeLeft , mapLeft ) where -- | Replace the left value in an @Either@. makeLeft :: c -> Either a b -> Either c b makeLeft c (Left _) = Left c makeLeft _ (Right x) = Right x -- | Apply a transformation only to the 'Left' values of an 'Either'. -- -- Left counterpart of 'fmap'. mapLeft :: (a -> c) -> Either a b -> Either c b mapLeft f (Left x) = Left (f x) mapLeft _ (Right x) = Right x ogma-core-1.14.0/src/Data/Spec/0000755000000000000000000000000015204000371014156 5ustar0000000000000000ogma-core-1.14.0/src/Data/Spec/Analysis.hs0000644000000000000000000002341715204000371016304 0ustar0000000000000000-- 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. -- | Formally analyze specifications and provide information about them. module Data.Spec.Analysis ( AnalysisResult(..) , specAnalyze ) where -- External imports import qualified Copilot.Core as Core import Data.List (intercalate, lookup) import Data.Maybe (fromMaybe) -- External imports: auxiliary import Data.String.Extra (sanitizeLCIdentifier, sanitizeUCIdentifier) -- External imports: ogma-spec import Data.OgmaSpec (ExternalVariableDef (..), InternalVariableDef (..), Requirement (..), Spec (..)) -- Internal imports import Copilot.Core.Analysis (exprIsConstant) import Copilot.Language.Reify.Extra (reifySpec) -- * Analysis of Specs -- | Result of analyzing a specification. data AnalysisResult = AnalysisResult { numAlwaysTrue :: Int -- ^ Number of always true requirements. , numAlwaysFalse :: Int -- ^ Number of always false requirements. , alwaysTrueReq :: [String] -- ^ List of always true requirements. , alwaysFalseReq :: [String] -- ^ List of always false requirements. , consistent :: Bool -- ^ Whether requirements are mutually -- consistent. } -- | Formally analyze a specification for redundancies, conflicts, etc. specAnalyze :: [(String, String)] -- Type substitution table -> ([(String, String)] -> a -> a) -- Expr substitution function -> (a -> String) -- Expr show function -> Spec a -- Specification -> IO (Either String AnalysisResult) specAnalyze typeMaps exprTransform showExpr spec = do let structuredSpec = spec2Copilot typeMaps exprTransform showExpr spec coreSpec <- reifySpec defaultSpecImports $ showSpec structuredSpec let properties = zip propertyNames propertyGuards propertyNames = map (\(_, p, _, _, _) -> p) $ copilotProperties structuredSpec propertyGuards = map Core.triggerGuard $ Core.specTriggers coreSpec constantProperties <- mapM (uncurry $ exprIsConstant coreSpec) properties let constantProperties' = zip propertyNames constantProperties let numTrue = length $ filter fst constantProperties numFalse = length $ filter snd constantProperties trueReqs = map fst $ filter (fst . snd) constantProperties' falseReqs = map fst $ filter (snd . snd) constantProperties' let negatedConjunction = Core.Op1 Core.Not $ foldr (Core.Op2 Core.And) true propertyGuards true = Core.Const Core.Bool True provedNegatedConjunction <- exprIsConstant coreSpec "ogma_inc" negatedConjunction -- The requirements are considered consistent if it was *not* possible to -- prove that their conjunction is always false. let consistent = not $ fst provedNegatedConjunction return $ Right $ AnalysisResult numTrue numFalse trueReqs falseReqs consistent -- * Auxiliary -- ** Structured Copilot specifications -- | A structured Copilot specification. data CopilotSpec = CopilotSpec { copilotProperties :: [(String, String, String, String, String)] -- ^ Requirement name, property name, handler name, -- implementation and arguments. , copilotAuxDefs :: [(String, String, String)] -- ^ Name, type, implementation } -- | Given a 'Spec', return a structured version the corresponding Copilot spec -- that differentiates between the auxiliary definitions (inputs, outputs) and -- the properties or requirements to check. -- -- 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 :: [(String, String)] -- Type substitution table -> ([(String, String)] -> a -> a) -- Expr substitution function -> (a -> String) -- Expr show function -> Spec a -- Specification -> CopilotSpec spec2Copilot typeMaps exprTransform showExpr spec = CopilotSpec reqs auxDefs where -- Encoding of requirements as boolean streams reqs :: [(String, String, String, String, String)] reqs = map reqToDecl (requirements spec) where reqToDecl i = ( reqName , propName , handlerName , reqBody nameSubstitutions , handlerArg ) where reqName = requirementName i propName = safeMap nameSubstitutions (requirementName i) handlerName = "handler" ++ sanitizeUCIdentifier (requirementName i) -- Definition implementation. We use an auxiliary function to -- transform the implementation into Copilot, applying a -- substitution. reqBody subs = showExpr (exprTransform subs (requirementExpr i)) handlerArg = case (requirementResultType i, requirementResultExpr i) of (Just _, Just ex) -> "[ arg (" ++ showExpr ex ++ " ) ]" _ -> "[]" auxDefs :: [(String, String, String)] auxDefs = externs ++ internals externs :: [(String, String, String)] externs = map externVarToDecl (externalVariables spec) where externVarToDecl i = (propName, streamType, implementation) where propName = safeMap nameSubstitutions (externalVariableName i) streamType = "Stream " ++ "(" ++ valueType ++ ")" valueType = safeMap typeMaps (externalVariableType i) implementation = "extern" ++ " " ++ show (externalVariableName i) ++ " " ++ "Nothing" -- Internal stream definitions internals :: [(String, String, String)] internals = map internalVarToDecl (internalVariables spec) where internalVarToDecl i = (propName, streamType, implementation) where propName = safeMap nameSubstitutions (internalVariableName i) streamType = "Stream " ++ "(" ++ valueType ++ ")" valueType = safeMap typeMaps (internalVariableType i) implementation = internalVariableExpr i nameSubstitutions = internalVariableMap ++ externalVariableMap ++ 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 -- | Render a 'CopilotSpec' as a Haskell definition of a 'Copilot.Spec', -- listing the elements in the spec with the necessary indentation. -- -- The shown 'Copilot.Spec' has a list of top-level triggers, as well as -- several auxiliary definitions. showSpec :: CopilotSpec -> String showSpec spec = template ++ "\n" ++ extra ++ "\n" ++ triggers where -- Initial template used for analysis purposes. template :: String template = unlines [ "do let" , "" , " clock :: Stream Int64" , " clock = [0] ++ (clock + 1)" , "" , " 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" ] extra = unlines $ intercalate [""] $ map formatDef $ copilotAuxDefs spec triggers = unlines $ intercalate [""] $ map formatTrigger $ copilotProperties spec formatDef (n, t, i) = map (" " ++) [ n ++ " :: " ++ t, n ++ " = " ++ i ] formatTrigger (_, _, h, g, a) = map (" " ++) [ "trigger " ++ show h ++ " (" ++ g ++ ") " ++ a ] -- | Default imports for a 'Spec' that was converted into a 'Copilot.Spec'. defaultSpecImports :: [(String, Maybe String)] defaultSpecImports = [ ("Control.Monad.Writer", Nothing) , ("Copilot.Language", Nothing) , ("Copilot.Language.Spec", Nothing) , ("Data.Functor.Identity", Nothing) , ("Language.Copilot", Nothing) , ("Copilot.Library.PTLTL", Just "PTLTL") , ("Prelude", Just "P") ] -- ** Auxiliary list functions -- | Substitute a key based on a given substitution table from key to -- alternative key. -- -- They key is left unchanged if it cannot be found in the substitution table. safeMap :: Eq k => [(k, k)] -> k -> k safeMap ls k = fromMaybe k $ lookup k ls ogma-core-1.14.0/src/Data/Spec/Parser.hs0000644000000000000000000002047115204000371015752 0ustar0000000000000000{-# LANGUAGE MultiWayIf #-} {-# 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. -- -- | Parsing of specs. module Data.Spec.Parser ( readInputExpr , readInputFile ) where -- External imports import qualified Control.Exception as E import Control.Monad.Except (ExceptT (..)) import Data.Aeson (eitherDecode) import qualified Data.ByteString.Lazy as L import Data.List (isInfixOf, isPrefixOf, nub, (\\)) 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 (ExternalVariableDef (..), InternalVariableDef (..), Requirement (..), Spec (..)) import Language.CSVSpec.Parser (parseCSVSpec) import Language.JSONSpec.Parser (parseJSONSpec) import Language.XLSXSpec.Parser (parseXLSXSpec) import Language.XMLSpec.Parser (parseXMLSpec) import Language.YAMLSpec.Parser (parseYAMLSpec) -- Internal imports: auxiliary import Command.Errors (ErrorTriplet(..), ErrorCode) import Data.Diagram (Diagram) import Data.Either.Extra (mapLeft) import Data.ExprPair (ExprPairT(..)) import Data.Location (Location (..)) import Paths_ogma_core (getDataDir) -- | Process input specification from a single expression and return its -- abstract representation. readInputExpr :: String -> String -> Maybe String -> ExprPairT a -> ExceptT ErrorTriplet IO (Spec a) readInputExpr 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 ] -- Return the spec, transforming the error message if applicable. pure $ mapLeft (cannotReadConditionExpr expr) spec --- | Process input specification, if available, and return its abstract --- representation. readInputFile :: FilePath -> String -> String -> Maybe String -> ExprPairT a -> ExceptT ErrorTriplet IO (Spec a) readInputFile 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 | isPrefixOf "YAMLFormat" format -> do let yamlFormat = read format content <- B.safeReadFile fp case content of Left e -> return $ Left e Right b -> parseYAMLSpec wrapper yamlFormat (L.toStrict b) | 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 -- | 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 -- | 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" -- ** Error codes -- | 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 format file cannot be opened. ecIncorrectFormatFile :: ErrorCode ecIncorrectFormatFile = 1 -- | 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 ogma-core-1.14.0/src/Data/Spec/Extra.hs0000644000000000000000000000343515204000371015602 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. -- -- | Auxiliary functions for working with values of type 'Spec'. module Data.Spec.Extra ( addMissingIdentifiers ) where -- External imports import Data.List (nub, (\\)) -- External imports: ogma import Data.OgmaSpec (ExternalVariableDef (..), InternalVariableDef (..), Requirement (..), Spec (..)) -- | 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.14.0/src/Command/0000755000000000000000000000000015204000371013771 5ustar0000000000000000ogma-core-1.14.0/src/Command/FPrimeApp.hs0000644000000000000000000002235615204000371016160 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) import Data.Aeson.Extra (mergeObjects) import Data.ExprPair (ExprPair(..), exprPair) import Data.Location (Location (..)) import Data.Spec.Parser (readInputExpr) -- | 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 . InputFileSpec <$> readInputExpr' e) cExpr specF <- if null fpA then return Nothing else do fpA' <- mapM readInputFile' fpA let fpA'' = combineInputFiles fpA' if length fpA'' > 1 then liftEither $ Left commandMultipleInputTypes else pure $ Just $ head fpA'' let spec = specT <|> specF liftEither $ checkArguments spec vs rs copilotM <- sequenceA $ (\spec' -> processSpec spec' cExpr fpA) <$> spec let varNames = fromMaybe (defaultVarNames spec) vs monitors = maybe (defaultMonitors 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 fpA = commandInputFiles options varNameFile = commandVariables options varDBFile = maybeToList $ commandVariableDB options handlersFile = commandHandlers options formatName = commandFormat options propFormatName = commandPropFormat options propVia = commandPropVia options readInputExpr' e = readInputExpr e propFormatName propVia exprT readInputFile' f = parseInputFile f formatName propFormatName propVia exprT processSpec spec' expr' fp' = Command.Standalone.commandLogic expr' fp' "copilot" [] exprT spec' defaultVarNames spec = case spec of Just (InputFileSpec spec') -> specExtractExternalVariables (Just spec') Just (InputFileDiagram _) -> [] Nothing -> specExtractExternalVariables Nothing defaultMonitors spec = case spec of Just (InputFileSpec spec') -> specExtractHandlers (Just spec') Just (InputFileDiagram _) -> [ ("handler", Just "uint8_t" ) ] Nothing -> specExtractHandlers Nothing -- ** Argument processing -- | Options used to customize the conversion of specifications to F' -- applications. data CommandOptions = CommandOptions { commandConditionExpr :: Maybe String -- ^ Trigger condition. , commandInputFiles :: [FilePath] -- ^ Input specification files. , 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 -- | Error message associated to having multiple input files of incompatible -- types. commandMultipleInputTypes :: ErrorTriplet commandMultipleInputTypes = ErrorTriplet ecMultipleInputTypes msg LocationNothing where msg = "Too many inputs provided. Provide one diagram or multiple specs." -- | Error: multiple inputs of incompatible types. ecMultipleInputTypes :: ErrorCode ecMultipleInputTypes = 1 ogma-core-1.14.0/src/Command/VariableDB.hs0000644000000000000000000002512215204000371016262 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.14.0/src/Command/ROSApp.hs0000644000000000000000000002634715204000371015445 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) import Data.Aeson.Extra (mergeObjects) import Data.ExprPair (ExprPair(..), exprPair) import Data.Location (Location (..)) import Data.Spec.Parser (readInputExpr) -- | 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 . InputFileSpec <$> readInputExpr' e) cExpr specF <- if null fpA then return Nothing else do fpA' <- mapM readInputFile' fpA let fpA'' = combineInputFiles fpA' if length fpA'' > 1 then liftEither $ Left commandMultipleInputTypes else pure $ Just $ head fpA'' let spec = specT <|> specF liftEither $ checkArguments spec vs rs copilotM <- sequenceA $ (\spec' -> processSpec spec' cExpr fpA) <$> spec let varNames = fromMaybe (defaultVarNames spec) vs monitors = maybe (defaultMonitors 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 fpA = commandInputFiles options varNameFile = commandVariables options varDBFile = maybeToList $ commandVariableDB options handlersFile = commandHandlers options formatName = commandFormat options propFormatName = commandPropFormat options propVia = commandPropVia options readInputExpr' e = readInputExpr e propFormatName propVia exprT readInputFile' f = parseInputFile f formatName propFormatName propVia exprT processSpec spec' expr' fp' = Command.Standalone.commandLogic expr' fp' "copilot" [] exprT spec' defaultVarNames spec = case spec of Just (InputFileSpec spec') -> specExtractExternalVariables (Just spec') Just (InputFileDiagram _) -> [] Nothing -> specExtractExternalVariables Nothing defaultMonitors spec = case spec of Just (InputFileSpec spec') -> specExtractHandlers (Just spec') Just (InputFileDiagram _) -> [ ("handler", Just "uint8_t" ) ] Nothing -> specExtractHandlers Nothing 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. , commandInputFiles :: [FilePath] -- ^ Input specification files. , 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 -- | Error message associated to having multiple input files of incompatible -- types. commandMultipleInputTypes :: ErrorTriplet commandMultipleInputTypes = ErrorTriplet ecMultipleInputTypes msg LocationNothing where msg = "Too many inputs provided. Provide one diagram or multiple specs." -- | Error: multiple inputs of incompatible types. ecMultipleInputTypes :: ErrorCode ecMultipleInputTypes = 1 ogma-core-1.14.0/src/Command/Standalone.hs0000644000000000000000000002370215204000371016421 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.Maybe (fromMaybe) import GHC.Generics (Generic) -- External imports: Ogma import System.Directory.Extra (copyTemplate) -- Internal imports import Command.Common import Command.Errors (ErrorCode, ErrorTriplet(..)) import Command.Result (Result (..)) import Data.Aeson.Extra (mergeObjects) import Data.Either.Extra (mapLeft) import Data.ExprPair (ExprPair(..), ExprPairT(..), exprPair) import Data.Location (Location (..)) import Data.Spec.Extra (addMissingIdentifiers) import Data.Spec.Parser (readInputExpr) import Language.Trans.Diagram2Copilot (DiagramMode (..), diagram2CopilotSpec) 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 . InputFileSpec <$> readInputExpr' e) triggerExprM specF <- if null fpA then return Nothing else do fpA' <- mapM readInputFile' fpA let fpA'' = combineInputFiles fpA' if length fpA'' > 1 then liftEither $ Left commandMultipleInputTypes else pure $ Just $ head fpA'' let spec = specT <|> specF case spec of Nothing -> liftEither $ Left $ commandMissingSpec Just spec' -> commandLogic triggerExprM fpA name typeMaps exprT spec' where triggerExprM = commandConditionExpr options fpA = commandInputFiles options name = commandFilename options typeMaps = typeToCopilotTypeMapping (commandTypeMapping options) formatName = commandFormat options propFormatName = commandPropFormat options propVia = commandPropVia options readInputExpr' e = readInputExpr e propFormatName propVia exprT readInputFile' 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 -> [FilePath] -> String -> [(String, String)] -> ExprPairT a -> InputFile a -> ExceptT ErrorTriplet IO AppData commandLogic expr fps name typeMaps exprT (InputFileDiagram d) = return $ AppData [] int [] trigs name where (int, trigs) = diagram2CopilotSpec d ComputeState commandLogic expr fps name typeMaps exprT (InputFileSpec 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, fps) of (Nothing, []) -> error "Both expression and file are missing" (Nothing, fps') -> commandIncorrectSpecF (Just expr', _) -> commandIncorrectSpecE expr' 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 , commandInputFiles :: [FilePath] -- ^ Input specification file(s). , 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 having multiple input files of incompatible -- types. commandMultipleInputTypes :: ErrorTriplet commandMultipleInputTypes = ErrorTriplet ecMultipleInputTypes msg LocationNothing where msg = "Too many inputs provided. Provide one diagram or multiple specs." -- | Error message associated to not being able to formalize the input spec. commandIncorrectSpecF :: String -> ErrorTriplet commandIncorrectSpecF e = ErrorTriplet ecIncorrectSpec msg LocationNothing where msg = "The input specification(s) 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: multiple inputs of incompatible types. ecMultipleInputTypes :: ErrorCode ecMultipleInputTypes = 1 -- | Error: the input specification cannot be formalized. ecIncorrectSpec :: ErrorCode ecIncorrectSpec = 1 ogma-core-1.14.0/src/Command/Common.hs0000644000000000000000000003256115204000371015564 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 ( InputFile(..) , combineInputFiles , parseInputFile , parseVariablesFile , parseRequirementsListFile , openVarDBFiles , openVarDBFilesWithDefault , parseTemplateVarsFile , checkArguments , specExtractExternalVariables , specExtractHandlers , processResult , cannotCopyTemplate , makeLeftE , 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 System.FilePath (()) -- 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) -- Internal imports: VariableDBs import Command.VariableDB (VariableDB, emptyVariableDB, mergeVariableDB) -- Internal imports: auxiliary import Command.Errors (ErrorTriplet(..), ErrorCode) import Command.Result (Result (..)) import Data.Diagram (Diagram) import Data.Diagram.Parser (DiagramFormat (..), readDiagram) import Data.Either.Extra (makeLeft) import Data.ExprPair (ExprPair (..), ExprPairT (..)) import Data.Location (Location (..)) import Data.Spec.Parser (readInputFile) import Paths_ogma_core (getDataDir) -- | File containing information to be processed by Ogma (e.g., specification, -- diagram). data InputFile a = InputFileDiagram Diagram | InputFileSpec (Spec a) -- | Merge a list of input files into a smaller list of input files. -- -- PRE: If there is more than one input file, all input files are specs. combineInputFiles :: [InputFile a] -> [InputFile a] combineInputFiles [] = [] combineInputFiles [x] = [x] combineInputFiles xs | any isInputDiagram xs = [] | otherwise = [ InputFileSpec $ foldr1 mergeSpecs $ map getSpec xs ] where -- True if the given argument is a diagram. isInputDiagram :: InputFile a -> Bool isInputDiagram (InputFileDiagram _) = True isInputDiagram _ = False -- Merge two specifications. mergeSpecs :: Spec a -> Spec a -> Spec a mergeSpecs s1 s2 = Spec { internalVariables = internalVariables s1 ++ internalVariables s2 , externalVariables = externalVariables s2 ++ externalVariables s2 , requirements = requirements s1 ++ requirements s2 } -- Unsafely unwrap the spec in an input file. -- -- PRE: The argument input file contains a spec. getSpec :: InputFile a -> Spec a getSpec (InputFileSpec s) = s getSpec _ = error "The input file provided is not a spec" -- | Process input file, it contains a valid diagram or specification, and -- return its abstract representation. parseInputFile :: FilePath -> String -> String -> Maybe String -> ExprPairT a -> ExceptT ErrorTriplet IO (InputFile a) parseInputFile fp formatName propFormatName propVia exprT | isDiagramFormat formatName = InputFileDiagram <$> readDiagram fp diagramFormat (ExprPair exprT) | otherwise = InputFileSpec <$> readInputFile fp formatName propFormatName propVia exprT where isDiagramFormat :: String -> Bool isDiagramFormat fName = fName `elem` [ "dot", "mermaid" ] diagramFormat :: DiagramFormat diagramFormat | formatName == "dot" = Dot | formatName == "mermaid" = Mermaid | otherwise = error $ "diagramFormat: Not a diagram format " ++ show formatName -- | 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 $ makeLeft (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 (InputFile 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 -- * 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 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 -- | 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 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 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 -- | Replace the left Exception in an Either. makeLeftE :: c -> Either E.SomeException b -> Either c b makeLeftE = makeLeft ogma-core-1.14.0/src/Command/CStructs2Copilot.hs0000644000000000000000000000607715204000371017525 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.14.0/src/Command/Overview.hs0000644000000000000000000001423315204000371016136 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 GHC.Generics (Generic) -- External imports: Ogma import Data.OgmaSpec (Spec (..)) -- Internal imports import Command.Common (InputFile(..), parseInputFile) import Command.Errors (ErrorCode, ErrorTriplet (..)) import Command.Result (Result (..)) import Data.Diagram.Analysis (AnalysisResult (..), analyzeDiagram) import Data.ExprPair (ExprPair(..), ExprPairT(..), exprPair) import Data.Location (Location (..)) import qualified Data.Spec.Analysis as SpecAnalysis import Data.Spec.Extra (addMissingIdentifiers) import qualified Language.Trans.Spec2Copilot as Spec2Copilot -- | 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 res <- runExceptT $ parseInputFile fp formatName propFormatName propVia exprT case res of Left (ErrorTriplet _ s _) -> return $ Left s Right (InputFileDiagram diagramR) -> do analysisResult <- analyzeDiagram diagramR pure $ Right $ CommandSummaryDiagram (numStates analysisResult) (deterministic analysisResult) Right (InputFileSpec spec') -> do let specCompleted = addMissingIdentifiers ids spec' specAnalyzed = Spec2Copilot.specAnalyze specCompleted specFormalAnalysis <- SpecAnalysis.specAnalyze [] replace printExpr specCompleted pure $ do numExterns <- length . externalVariables <$> specAnalyzed numInternal <- length . internalVariables <$> specAnalyzed numReqs <- length . requirements <$> specAnalyzed numTrues <- SpecAnalysis.numAlwaysTrue <$> specFormalAnalysis numFalses <- SpecAnalysis.numAlwaysFalse <$> specFormalAnalysis consistent <- SpecAnalysis.consistent <$> specFormalAnalysis pure $ CommandSummaryRequirement numExterns numInternal numReqs numTrues numFalses consistent where formatName = commandFormat options propFormatName = commandPropFormat options propVia = commandPropVia options ExprPairT _parse replace printExpr ids _def = exprT data CommandSummary = CommandSummaryRequirement { commandExternalVariables :: Int , commandInternalVariables :: Int , commandRequirements :: Int , commandRequirementsTrue :: Int , commandRequirementsFalse :: Int , commandRequirementsConsistent :: Bool } | CommandSummaryDiagram { commandNumStates :: Int , commandDeterministic :: Bool } 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) ogma-core-1.14.0/src/Command/CFSApp.hs0000644000000000000000000002645115204000371015411 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) import Data.Aeson.Extra (mergeObjects) import Data.ExprPair (ExprPair(..), exprPair) import Data.Location (Location (..)) import Data.Spec.Parser (readInputExpr) -- | Generate a new CFS application connected to Copilot. command :: CommandOptions -> IO (Result ErrorCode) command options = processResult $ do -- Obtain template dir templateDir <- locateTemplateDir mTemplateDir "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 . InputFileSpec <$> readInputExpr' e) cExpr specF <- if null fpA then return Nothing else do fpA' <- mapM readInputFile' fpA let fpA'' = combineInputFiles fpA' if length fpA'' > 1 then liftEither $ Left commandMultipleInputTypes else pure $ Just $ head fpA'' let spec = specT <|> specF liftEither $ checkArguments spec vs rs copilotM <- sequenceA $ (\spec' -> processSpec spec' cExpr fpA) <$> spec let varNames = fromMaybe (defaultVarNames spec) vs monitors = maybe (defaultMonitors spec) (map (\x -> (x, Nothing))) rs let appData = commandLogic varDB varNames monitors' copilotM monitors' = mapMaybe (monitorMap varDB) monitors return appData where cExpr = commandConditionExpr options fpA = commandInputFiles options varNameFile = commandVariables options varDBFile = maybeToList $ commandVariableDB options handlersFile = commandHandlers options formatName = commandFormat options propFormatName = commandPropFormat options propVia = commandPropVia options readInputExpr' e = readInputExpr e propFormatName propVia exprT readInputFile' f = parseInputFile f formatName propFormatName propVia exprT processSpec spec' expr' fp' = Command.Standalone.commandLogic expr' fp' "copilot" [] exprT spec' defaultVarNames spec = case spec of Just (InputFileSpec spec') -> specExtractExternalVariables (Just spec') Just (InputFileDiagram _) -> [] Nothing -> specExtractExternalVariables Nothing defaultMonitors spec = case spec of Just (InputFileSpec spec') -> specExtractHandlers (Just spec') Just (InputFileDiagram _) -> [ ("handler", Just "uint8_t" ) ] Nothing -> specExtractHandlers Nothing -- | 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. , commandInputFiles :: [FilePath] -- ^ Input specification files. , 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 -- | Error message associated to having multiple input files of incompatible -- types. commandMultipleInputTypes :: ErrorTriplet commandMultipleInputTypes = ErrorTriplet ecMultipleInputTypes msg LocationNothing where msg = "Too many inputs provided. Provide one diagram or multiple specs." -- | Error: multiple inputs of incompatible types. ecMultipleInputTypes :: ErrorCode ecMultipleInputTypes = 1 ogma-core-1.14.0/src/Command/Diagram.hs0000644000000000000000000002041615204000371015674 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.Except (runExceptT) import Data.Aeson (object, (.=)) import Data.Foldable (for_) import Data.Text.Lazy (pack) import System.FilePath (()) -- External imports: auxiliary import System.Directory.Extra ( copyTemplate ) -- External imports: parsing expressions. 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) -- Internal imports: auxiliary import Command.Errors (ErrorTriplet (..)) import Command.Result (Result (..)) import Data.Diagram.Parser (DiagramFormat (..), readDiagram) import Data.ExprPair (ExprPair (..), ExprPairT (..)) import Data.Location (Location (..)) import Paths_ogma_core (getDataDir) -- Internal imports: language ASTs, transformers import Language.SMV.Substitution (substituteBoolExpr) import Language.Trans.Diagram2Copilot (DiagramMode (..), diagram2CopilotSpec) 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@, @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, triggers) -> do let subst = object [ "streamDefs" .= pack streamDefs , "specName" .= pack (diagramFilename options) , "input" .= pack (diagramInputVar options) , "state" .= pack (diagramStateVar options) , "triggers" .= pack triggers ] 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@, @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 diagramE <- runExceptT $ readDiagram fp (diagramFormat options) exprP case diagramE of Left (ErrorTriplet _ec msg _loc) -> pure $ Left msg Right diagramR -> pure $ Right $ diagram2CopilotSpec 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 } -- | 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. -- | Return a handler depending on the format used for edge or transition -- properties. exprPair :: DiagramPropFormat -> ExprPair exprPair Lustre = ExprPair $ ExprPairT (Lustre.pBoolSpec . Lustre.myLexer) (\_ -> id) Lustre.boolSpec2Copilot Lustre.boolSpecNames (Lustre.BoolSpecSignal (Lustre.Ident "undefined")) exprPair Inputs = ExprPair $ ExprPairT ((Right . read) :: String -> Either String Int) (\_ -> id) (\x -> "input == " ++ show x) (const []) (-1) exprPair Literal = ExprPair $ ExprPairT Right (\_ -> id) id (const []) "undefined" exprPair SMV = ExprPair $ ExprPairT (SMV.pBoolSpec . SMV.myLexer) substituteBoolExpr SMV.boolSpec2Copilot SMV.boolSpecNames (SMV.BoolSpecSignal (SMV.Ident "undefined")) -- * Backend ogma-core-1.14.0/src/Command/Errors.hs0000644000000000000000000000210315204000371015575 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.14.0/src/Command/Report.hs0000644000000000000000000002242215204000371015602 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} -- 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 a report of the diagrams and requirements in the input files. module Command.Report ( command , CommandOptions(..) , CommandSummary(..) , ErrorCode ) where -- External imports import qualified Control.Exception as E import Control.Monad.Except (ExceptT (..), liftEither, withExceptT) import Control.Monad.IO.Class (liftIO) import Data.Aeson (ToJSON (..)) import GHC.Generics (Generic) -- External imports: Ogma import Data.OgmaSpec (Requirement (..), Spec (..)) import Data.String.Extra (sanitizeUCIdentifier) import System.Directory.Extra (copyTemplate) -- Internal imports import Command.Common (InputFile (..), cannotCopyTemplate, locateTemplateDir, makeLeftE, parseInputFile, processResult) import Command.Errors (ErrorCode, ErrorTriplet (..)) import Command.Result (Result (..)) import Data.Diagram.Analysis (AnalysisResult (..), analyzeDiagram) import Data.ExprPair (ExprPair (..), ExprPairT (..), exprPair) import Data.Location (Location (..)) import qualified Data.Spec.Analysis as SpecAnalysis import Data.Spec.Extra (addMissingIdentifiers) import qualified Language.Trans.Spec2Copilot as Spec2Copilot -- | Generate report of a spec or diagram 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@. The template, -- if provided, exists and uses the variables needed by the report 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 "report" let functions = exprPair (commandPropFormat options) reportData <- command' options functions -- Expand template ExceptT $ fmap (makeLeftE cannotCopyTemplate) $ E.try $ copyTemplate templateDir (toJSON reportData) targetDir where targetDir = commandTargetDir options mTemplateDir = commandTemplateDir options -- | Generate report of a spec or diagram 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@. The template, -- if provided, exists and uses the variables needed by the report application -- generator. The target directory is writable and there's enough disk space to -- copy the files over. command' :: CommandOptions -> ExprPair -> ExceptT ErrorTriplet IO CommandSummary command' options (ExprPair exprT) = do res <- parseInputFile fp formatName propFormatName propVia exprT case res of InputFileDiagram diagramR -> do analysisResult <- liftIO $ analyzeDiagram diagramR let diagramDetails = DiagramDetails (numStates analysisResult) (deterministic analysisResult) pure $ CommandSummary { commandExternalVariables = 0 , commandInternalVariables = 0 , commandRequirementsAny = False , commandRequirements = 0 , commandRequirementsTrue = 0 , commandRequirementsFalse = 0 , commandRequirementsConsistent = True , commandRequirementList = [] , commandDiagramsAny = True , commandDiagrams = 1 , commandDiagramList = [diagramDetails] } InputFileSpec spec -> withExceptT commandCannotAnalyzeF $ do let specCompleted = addMissingIdentifiers ids spec specAnalyzed <- liftEither $ Spec2Copilot.specAnalyze specCompleted specFormalAnalysis <- ExceptT $ SpecAnalysis.specAnalyze [] replace printExpr specCompleted let numExterns = length $ externalVariables specAnalyzed numInternal = length $ internalVariables specAnalyzed numReqs = length reqList reqList = requirements specAnalyzed reqListDetails = map reqDetailsF reqList reqDetailsF x = RequirementDetails (requirementName x) (requirementDescription x) (requirementNameAsProp (requirementName x) `elem` trueReqs) (requirementNameAsProp (requirementName x) `elem` falseReqs) numTrues = SpecAnalysis.numAlwaysTrue specFormalAnalysis numFalses = SpecAnalysis.numAlwaysFalse specFormalAnalysis trueReqs = SpecAnalysis.alwaysTrueReq specFormalAnalysis falseReqs = SpecAnalysis.alwaysFalseReq specFormalAnalysis consistent = SpecAnalysis.consistent specFormalAnalysis pure $ CommandSummary { commandExternalVariables = numExterns , commandInternalVariables = numInternal , commandRequirementsAny = numReqs > 0 , commandRequirements = numReqs , commandRequirementsTrue = numTrues , commandRequirementsFalse = numFalses , commandRequirementsConsistent = consistent , commandRequirementList = reqListDetails , commandDiagramsAny = False , commandDiagrams = 0 , commandDiagramList = [] } where fp = commandInputFile options formatName = commandFormat options propFormatName = commandPropFormat options propVia = commandPropVia options ExprPairT _parse replace printExpr ids _def = exprT -- | Options used to customize the interpretation of input specifications and -- the resulting report. data CommandOptions = CommandOptions { commandTargetDir :: String , commandTemplateDir :: Maybe String , commandInputFile :: String , commandFormat :: String , commandPropFormat :: String , commandPropVia :: Maybe String } -- | Summary of the files read. data CommandSummary = CommandSummary { commandExternalVariables :: Int , commandInternalVariables :: Int , commandRequirementsAny :: Bool , commandRequirements :: Int , commandRequirementsTrue :: Int , commandRequirementsFalse :: Int , commandRequirementsConsistent :: Bool , commandRequirementList :: [RequirementDetails] , commandDiagramsAny :: Bool , commandDiagrams :: Int , commandDiagramList :: [DiagramDetails] } deriving (Generic, Show) instance ToJSON CommandSummary -- | Information to include in a report about a requirement. data RequirementDetails = RequirementDetails { summaryRequirementName :: String , summaryRequirementDesc :: String , summaryRequirementTrue :: Bool , summaryRequirementFalse :: Bool } deriving (Generic, Show) instance ToJSON RequirementDetails -- | Information to include in a report about a diagram. data DiagramDetails = DiagramDetails { summaryDiagramNumStates :: Int , summaryDiagramDeterministic :: Bool } deriving (Generic, Show) instance ToJSON DiagramDetails -- * Errors -- | Error message associated to not being able to formalize the input spec. commandCannotAnalyzeF :: String -> ErrorTriplet commandCannotAnalyzeF e = ErrorTriplet ecCannotAnalyzeError msg LocationNothing where msg = "The input specification(s) cannot be analyzed: " ++ e -- ** Error codes -- | Error: the input file cannot be analyzed. ecCannotAnalyzeError :: ErrorCode ecCannotAnalyzeError = 1 -- * Auxiliary functions -- | Name of a requirement when used as a property or handler in a -- Copilot specification. requirementNameAsProp :: String -> String requirementNameAsProp x = "prop" ++ sanitizeUCIdentifier x ogma-core-1.14.0/src/Command/Result.hs0000644000000000000000000000245215204000371015606 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.14.0/src/Command/CStructs2MsgHandlers.hs0000644000000000000000000000514615204000371020317 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 ogma-core-1.14.0/src/Copilot/0000755000000000000000000000000015204000371014024 5ustar0000000000000000ogma-core-1.14.0/src/Copilot/Core/0000755000000000000000000000000015204000371014714 5ustar0000000000000000ogma-core-1.14.0/src/Copilot/Core/Analysis.hs0000644000000000000000000000425615204000371017042 0ustar0000000000000000-- 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. -- | Formally analyze Copilot Core specifications. module Copilot.Core.Analysis ( exprIsConstant ) where -- External imports import qualified Copilot.Core as Core import Copilot.Theorem.What4 (SatResult (..), Solver (Z3), prove) import Data.List (lookup) -- | Determine if a boolean expression is always 'True' or always 'False'. -- -- The first boolean in the result is 'True' if the expression can be proven -- always 'True'. The second boolean in the expression is 'True' is the -- expression can be proven always 'False'. -- -- They values in the tuple cannot both 'True' at the same time. exprIsConstant :: Core.Spec -> Core.Name -> Core.Expr Bool -> IO (Bool, Bool) exprIsConstant spec name expr = do r1 <- propIsValid spec name (Core.Forall expr) r2 <- propIsValid spec name (Core.Forall (Core.Op1 Core.Not expr)) pure (r1, r2) -- | 'True' if the Copilot 'Prop' with the given name and expression is -- constantly 'True', or valid, and 'False' otherwise (not always 'True' or -- unknown). propIsValid :: Core.Spec -> Core.Name -> Core.Prop -> IO Bool propIsValid spec name expr = maybe False isValid . lookup name <$> prove Z3 spec' where spec' = spec { Core.specProperties = prop' : Core.specProperties spec } prop' = Core.Property name expr isValid :: SatResult -> Bool isValid Valid = True isValid _ = False ogma-core-1.14.0/src/Copilot/Language/0000755000000000000000000000000015204000371015547 5ustar0000000000000000ogma-core-1.14.0/src/Copilot/Language/Reify/0000755000000000000000000000000015204000371016625 5ustar0000000000000000ogma-core-1.14.0/src/Copilot/Language/Reify/Extra.hs0000644000000000000000000000316615204000371020252 0ustar0000000000000000-- 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. -- | Typechecking of Copilot specs. module Copilot.Language.Reify.Extra ( reifySpec ) where -- External imports import qualified Copilot.Core as Core import qualified Copilot.Language as Copilot import qualified Copilot.Language.Reify as Copilot import qualified Language.Haskell.Interpreter as HI -- | Read a specification from a 'String' and reify it. -- -- This function receives a list of possibly qualified imports. reifySpec :: [(String, Maybe String)] -> String -> IO Core.Spec reifySpec imports specText = do coreSpecE <- HI.runInterpreter $ do HI.setImportsQ imports copilotSpec <- HI.interpret specText (HI.as :: Copilot.Spec) HI.liftIO $ Copilot.reify copilotSpec case coreSpecE of Left err -> do putStrLn $ "Error: " ++ show err error $ show err Right coreSpec -> return coreSpec