From 1ee00eddd1a2ba2a81c297f0ae81698788749687 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 11 Dec 2024 11:41:31 +0000 Subject: [PATCH 1/8] ogma-core: Use template expansion to generate standalone monitoring application. Refs #189. The standalone backend uses a fixed template to generate the Copilot monitor. That template does not fit all use cases, so we are finding users heavily modifying the output (which is hard to keep up with when there are changes), or not using ogma altogether for that reason. This commit modifies the ogma-core standalone command to use mustache to generate the Copilot monitor via a template and variable expansion. We introduce a new template that uses variables, and we modify the cabal file to include the files that make up the default template as data files that are copied over during installation. To be able to generate the files, we need to introduce a target directory option for the standalone command. --- ogma-core/ogma-core.cabal | 1 + ogma-core/src/Command/Standalone.hs | 76 ++++++++--- ogma-core/src/Language/Trans/Spec2Copilot.hs | 128 ++++--------------- ogma-core/templates/standalone/Copilot.hs | 40 ++++++ 4 files changed, 126 insertions(+), 119 deletions(-) create mode 100644 ogma-core/templates/standalone/Copilot.hs diff --git a/ogma-core/ogma-core.cabal b/ogma-core/ogma-core.cabal index e493068..ee6499e 100644 --- a/ogma-core/ogma-core.cabal +++ b/ogma-core/ogma-core.cabal @@ -71,6 +71,7 @@ data-files: templates/copilot-cfs/CMakeLists.txt templates/fprime/Copilot.hpp templates/fprime/Dockerfile templates/fprime/instance-copilot + templates/standalone/Copilot.hs data/formats/fcs_smv data/formats/fcs_cocospec data/formats/fdb_smv diff --git a/ogma-core/src/Command/Standalone.hs b/ogma-core/src/Command/Standalone.hs index 5d96314..a5221f1 100644 --- a/ogma-core/src/Command/Standalone.hs +++ b/ogma-core/src/Command/Standalone.hs @@ -1,4 +1,5 @@ {-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE OverloadedStrings #-} -- Copyright 2020 United States Government as represented by the Administrator -- of the National Aeronautics and Space Administration. All Rights Reserved. -- @@ -38,15 +39,18 @@ module Command.Standalone where -- External imports -import Data.Aeson (decode, eitherDecode) -import Data.ByteString.Lazy (fromStrict, pack) +import Control.Exception as E +import Data.Aeson (decode, eitherDecode, object, (.=)) +import Data.ByteString.Lazy (fromStrict) import Data.Foldable (for_) import Data.List (nub, (\\)) import Data.Maybe (fromMaybe) import System.FilePath (()) +import Data.Text.Lazy (pack) -- External imports: auxiliary -import Data.ByteString.Extra as B ( safeReadFile ) +import Data.ByteString.Extra as B ( safeReadFile ) +import System.Directory.Extra ( copyTemplate ) -- Internal imports: auxiliary import Command.Result (Result (..)) @@ -73,38 +77,58 @@ import Language.Trans.SMV2Copilot as SMV (boolSpec2Copilot, boolSpecNames) import Language.Trans.Spec2Copilot (spec2Copilot, specAnalyze) --- | Print the contents of a Copilot module that implements the spec in an +-- | 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. +-- 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. standalone :: FilePath -- ^ Path to a file containing a specification -> StandaloneOptions -- ^ Customization options -> IO (Result ErrorCode) standalone fp options = do + E.handle (return . standaloneTemplateError options fp) $ do + -- Obtain template dir + dataDir <- getDataDir + let templateDir = dataDir "templates" "standalone" - let functions = exprPair (standalonePropFormat options) + let functions = exprPair (standalonePropFormat options) - copilot <- standalone' fp options functions + copilot <- standalone' fp options functions - let (mOutput, result) = standaloneResult options fp copilot + let (mOutput, result) = standaloneResult options fp copilot - for_ mOutput putStrLn - return result + for_ mOutput $ \(externs, internals, reqs, triggers, specName) -> do + let subst = object $ + [ "externs" .= pack externs + , "internals" .= pack internals + , "reqs" .= pack reqs + , "triggers" .= pack triggers + , "specName" .= pack specName + ] --- | Print the contents of a Copilot module that implements the spec in an + let targetDir = standaloneTargetDir options + + copyTemplate templateDir subst targetDir + + return result + +-- | 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. +-- 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. standalone' :: FilePath -> StandaloneOptions -> ExprPair - -> IO (Either String String) + -> IO (Either String (String, String, String, String, String)) standalone' fp options (ExprPair parse replace print ids) = do let name = standaloneFilename options typeMaps = typeToCopilotTypeMapping options @@ -135,7 +159,8 @@ standalone' fp options (ExprPair parse replace print ids) = do -- | Options used to customize the conversion of specifications to Copilot -- code. data StandaloneOptions = StandaloneOptions - { standaloneFormat :: String + { standaloneTargetDir :: FilePath + , standaloneFormat :: String , standalonePropFormat :: String , standaloneTypeMapping :: [(String, String)] , standaloneFilename :: String @@ -153,17 +178,36 @@ type ErrorCode = Int ecStandaloneError :: ErrorCode ecStandaloneError = 1 +-- | Error: standalone component generation failed during the copy/write +-- process. +ecStandaloneTemplateError :: ErrorCode +ecStandaloneTemplateError = 2 + -- * Result -- | Process the result of the transformation function. standaloneResult :: StandaloneOptions -> FilePath - -> Either String String - -> (Maybe String, Result ErrorCode) + -> Either String a + -> (Maybe a, Result ErrorCode) standaloneResult options fp result = case result of Left msg -> (Nothing, Error ecStandaloneError msg (LocationFile fp)) Right t -> (Just t, Success) +-- | Report an error when trying to open or copy the template +standaloneTemplateError :: StandaloneOptions + -> FilePath + -> E.SomeException + -> Result ErrorCode +standaloneTemplateError options fp exception = + Error ecStandaloneTemplateError msg (LocationFile fp) + where + msg = + "Standlone 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 + -- * Mapping of types from input format to Copilot typeToCopilotTypeMapping :: StandaloneOptions -> [(String, String)] typeToCopilotTypeMapping options = diff --git a/ogma-core/src/Language/Trans/Spec2Copilot.hs b/ogma-core/src/Language/Trans/Spec2Copilot.hs index 8a75ca6..57254e0 100644 --- a/ogma-core/src/Language/Trans/Spec2Copilot.hs +++ b/ogma-core/src/Language/Trans/Spec2Copilot.hs @@ -1,4 +1,5 @@ -- 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 @@ -36,7 +37,7 @@ module Language.Trans.Spec2Copilot where -- External imports -import Data.List ( intersect, lookup, union ) +import Data.List ( intercalate, intersect, lookup, union ) import Data.Maybe ( fromMaybe ) -- External imports: auxiliary @@ -56,46 +57,17 @@ spec2Copilot :: String -- Spec / target file name -> ([(String, String)] -> a -> a) -- Expr subsitution function -> (a -> String) -- Expr show function -> Spec a -- Specification - -> Either String String + -> Either String (String, String, String, String, String) spec2Copilot specName typeMaps exprTransform showExpr spec = - pure $ unlines $ concat - [ imports - , externs - , internals - , reqs - , clock - , ftp - , pre - , tpre - , notPreviousNot - , copilotSpec - , main' - ] + pure (externs, internals, reqs, triggers, specName) where - -- Import header block - imports :: [String] - imports = - [ "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)" - , "" - ] - -- Extern streams - externs = concatMap externVarToDecl - (externalVariables spec) + externs = unlines' + $ intercalate [""] + $ map externVarToDecl + (externalVariables spec) where externVarToDecl i = [ propName ++ " :: Stream " @@ -110,14 +82,15 @@ spec2Copilot specName typeMaps exprTransform showExpr spec = ++ show (externalVariableName i) ++ " " ++ "Nothing" - , "" ] where propName = safeMap nameSubstitutions (externalVariableName i) -- Internal stream definitions - internals = concatMap internalVarToDecl - (internalVariables spec) + internals = unlines' + $ intercalate [""] + $ map internalVarToDecl + (internalVariables spec) where internalVarToDecl i = (\implem -> [ propName @@ -129,20 +102,19 @@ spec2Copilot specName typeMaps exprTransform showExpr spec = , propName ++ " = " ++ implem - - , "" ]) implementation where propName = safeMap nameSubstitutions (internalVariableName i) implementation = (internalVariableExpr i) -- Encoding of requirements as boolean streams - reqs :: [String] - reqs = concatMap reqToDecl (requirements spec) + reqs :: String + reqs = unlines' + $ intercalate [""] + $ map reqToDecl (requirements spec) where reqToDecl i = [ reqComment, reqSignature , reqBody nameSubstitutions - , "" ] where reqName = safeMap nameSubstitutions (requirementName i) @@ -165,58 +137,10 @@ spec2Copilot specName typeMaps exprTransform showExpr spec = (showExpr (exprTransform subs (requirementExpr i))) - -- Auxiliary streams: clock - clock :: [String] - clock = [ "" - , "-- | Clock that increases in one-unit steps." - , "clock :: Stream Int64" - , "clock = [0] ++ (clock + 1)" - , "" - ] - - -- Auxiliary streams: first time point - ftp :: [String] - ftp = [ "" - , "-- | First Time Point" - , "ftp :: Stream Bool" - , "ftp = [True] ++ false" - , "" - ] - - -- Auxiliary streams: pre - pre = [ "" - , "pre :: Stream Bool -> Stream Bool" - , "pre = ([False] ++)" - ] - - -- Auxiliary streams: tpre - tpre = [ "" - , "tpre :: Stream Bool -> Stream Bool" - , "tpre = ([True] ++)" - ] - - -- Auxiliary streams: notPreviousNot - notPreviousNot :: [String] - notPreviousNot = [ "" - , "notPreviousNot :: Stream Bool -> Stream Bool" - , "notPreviousNot = not . PTLTL.previous . not" - ] - - -- Main specification - copilotSpec :: [String] - copilotSpec = [ "" - , "-- | Complete specification. Calls C handler functions" - ++ " when" - , "-- properties are violated." - , "spec :: Spec" - , "spec = do" - ] - ++ triggers - ++ [ "" ] + -- Main specification triggers + triggers :: String + triggers = unlines' $ fmap reqTrigger (requirements spec) where - triggers :: [String] - triggers = fmap reqTrigger (requirements spec) - reqTrigger :: Requirement a -> String reqTrigger r = " trigger " ++ show handlerName ++ " (not " ++ propName ++ ") " ++ "[]" @@ -224,14 +148,6 @@ spec2Copilot specName typeMaps exprTransform showExpr spec = handlerName = "handler" ++ sanitizeUCIdentifier (requirementName r) propName = safeMap nameSubstitutions (requirementName r) - -- Main program that compiles specification to C in two files (code and - -- header). - main' :: [String] - main' = [ "" - , "main :: IO ()" - , "main = reify spec >>= compile \"" ++ specName ++ "\"" - ] - -- Map from a variable name to its desired identifier in the code -- generated. internalVariableMap = @@ -318,3 +234,9 @@ specAnalyze spec -- 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" diff --git a/ogma-core/templates/standalone/Copilot.hs b/ogma-core/templates/standalone/Copilot.hs new file mode 100644 index 0000000..69329c9 --- /dev/null +++ b/ogma-core/templates/standalone/Copilot.hs @@ -0,0 +1,40 @@ +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) + +{{{externs}}} +{{{internals}}} +{{{reqs}}} + +-- | Clock that increases in one-unit steps. +clock :: Stream Int64 +clock = [0] ++ (clock + 1) + +-- | First Time Point +ftp :: Stream Bool +ftp = [True] ++ false + +pre :: Stream Bool -> Stream Bool +pre = ([False] ++) + +tpre :: Stream Bool -> Stream Bool +tpre = ([True] ++) + +notPreviousNot :: Stream Bool -> Stream Bool +notPreviousNot = not . PTLTL.previous . not + +-- | Complete specification. Calls C handler functions when properties are +-- violated. +spec :: Spec +spec = do +{{{triggers}}} + +main :: IO () +main = reify spec >>= compile "{{{specName}}}" From 8408589eebb12a19f61fcfb750ee57f606e6110c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 23 Dec 2024 15:44:24 +0000 Subject: [PATCH 2/8] ogma-core: Adjust tests to provide target directory to standalone command. Refs #189. The standalone backend uses a fixed template to generate the Copilot monitor. That template does not fit all use cases, so we are finding users heavily modifying the output (which is hard to keep up with when there are changes), or not using ogma altogether for that reason. A prior commit introduced, in the standalone command, support for custom templates. Unlike the prior implementation of the standalone command, which printed the output to standard output, the new interface puts the result in a file (or several files) included with the template. To implement this new functionality, we have added an argument to specify a target directory for the generated standalone application, where the files will be copied to. This commit modifies the tests for the standalone command to provide a temporary directory as destination. We default to the temporary directory of the host system. Since this is only used for testing and not during normal operation, and the ogma implementation is open source, we consider this safe from a security standpoint. --- ogma-core/ogma-core.cabal | 1 + ogma-core/tests/Main.hs | 5 +++++ 2 files changed, 6 insertions(+) diff --git a/ogma-core/ogma-core.cabal b/ogma-core/ogma-core.cabal index ee6499e..54c0108 100644 --- a/ogma-core/ogma-core.cabal +++ b/ogma-core/ogma-core.cabal @@ -144,6 +144,7 @@ test-suite unit-tests build-depends: base + , directory , HUnit , QuickCheck , test-framework diff --git a/ogma-core/tests/Main.hs b/ogma-core/tests/Main.hs index 4565d21..d7defa9 100644 --- a/ogma-core/tests/Main.hs +++ b/ogma-core/tests/Main.hs @@ -5,6 +5,7 @@ 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) @@ -101,11 +102,13 @@ testFretComponentSpec2Copilot :: FilePath -- ^ Path to a FRET/JSON requirements -> Bool -> IO () testFretComponentSpec2Copilot file success = do + targetDir <- getTemporaryDirectory let opts = StandaloneOptions { standaloneFormat = "fcs" , standalonePropFormat = "smv" , standaloneTypeMapping = [("int", "Int64"), ("real", "Float")] , standaloneFilename = "fret" + , standaloneTargetDir = targetDir } result <- standalone file opts @@ -133,11 +136,13 @@ testFretReqsDBCoCoSpec2Copilot :: FilePath -- ^ Path to a FRET/JSON -> Bool -> IO () testFretReqsDBCoCoSpec2Copilot file success = do + targetDir <- getTemporaryDirectory let opts = StandaloneOptions { standaloneFormat = "fdb" , standalonePropFormat = "cocospec" , standaloneTypeMapping = [] , standaloneFilename = "fret" + , standaloneTargetDir = targetDir } result <- standalone file opts From 879cd577f7f69d2b74602953f5c4db74e1cf1d5b Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 11 Dec 2024 11:47:00 +0000 Subject: [PATCH 3/8] ogma-cli: Add CLI argument to standalone command to set target directory. Refs #189. The standalone backend uses a fixed template to generate the Copilot monitor. That template does not fit all use cases, so we are finding users heavily modifying the output (which is hard to keep up with when there are changes), or not using ogma altogether for that reason. A prior commit introduced, in the standalone command, support for custom templates. Unlike the prior implementation of the standalone command, which printed the output to standard output, the new interface puts the result in a file (or several files) included with the template. To implement this new functionality, we have added an argument to specify a target directory for the generated standalone application, where the files will be copied to. This commit exposes that new parameter to set the target directory to the user in the CLI. --- ogma-cli/src/CLI/CommandStandalone.hs | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) diff --git a/ogma-cli/src/CLI/CommandStandalone.hs b/ogma-cli/src/CLI/CommandStandalone.hs index b4cd737..7cafc44 100644 --- a/ogma-cli/src/CLI/CommandStandalone.hs +++ b/ogma-cli/src/CLI/CommandStandalone.hs @@ -58,7 +58,8 @@ import qualified Command.Standalone -- | Options to generate Copilot from specification. data CommandOpts = CommandOpts - { standaloneFileName :: FilePath + { standaloneTargetDir :: FilePath + , standaloneFileName :: FilePath , standaloneFormat :: String , standalonePropFormat :: String , standaloneTypes :: [String] @@ -71,7 +72,8 @@ command c = standalone (standaloneFileName c) internalCommandOpts where internalCommandOpts :: Command.Standalone.StandaloneOptions internalCommandOpts = Command.Standalone.StandaloneOptions - { Command.Standalone.standaloneFormat = standaloneFormat c + { Command.Standalone.standaloneTargetDir = standaloneTargetDir c + , Command.Standalone.standaloneFormat = standaloneFormat c , Command.Standalone.standalonePropFormat = standalonePropFormat c , Command.Standalone.standaloneTypeMapping = types , Command.Standalone.standaloneFilename = standaloneTarget c @@ -98,6 +100,13 @@ commandDesc = commandOptsParser :: Parser CommandOpts commandOptsParser = CommandOpts <$> strOption + ( long "target-dir" + <> metavar "DIR" + <> showDefault + <> value "copilot" + <> help strStandaloneTargetDirDesc + ) + <*> strOption ( long "file-name" <> metavar "FILENAME" <> help strStandaloneFilenameDesc @@ -133,6 +142,10 @@ commandOptsParser = CommandOpts <> value "monitor" ) +-- | Target dir flag description. +strStandaloneTargetDirDesc :: String +strStandaloneTargetDirDesc = "Target directory" + -- | Filename flag description. strStandaloneFilenameDesc :: String strStandaloneFilenameDesc = "File with properties or requirements" From 6b07492bdf598dc1c2169c5bcf2739eb6a401f35 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 24 Dec 2024 01:10:25 +0000 Subject: [PATCH 4/8] ogma-core: Enable customizing template directory in standalone command. Refs #189. The standalone backend uses a fixed template to generate the Copilot monitor. That template does not fit all use cases, so we are finding users heavily modifying the output (which is hard to keep up with when there are changes), or not using ogma altogether for that reason. A prior commit introduced, in the standalone command, the ability to use mustache to expand variables in a template. This commit modifies the standalone command to accept an additional argument that points to a user-provided directory with a custom template. --- ogma-core/src/Command/Standalone.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/ogma-core/src/Command/Standalone.hs b/ogma-core/src/Command/Standalone.hs index a5221f1..f727433 100644 --- a/ogma-core/src/Command/Standalone.hs +++ b/ogma-core/src/Command/Standalone.hs @@ -92,8 +92,11 @@ standalone :: FilePath -- ^ Path to a file containing a specification standalone fp options = do E.handle (return . standaloneTemplateError options fp) $ do -- Obtain template dir - dataDir <- getDataDir - let templateDir = dataDir "templates" "standalone" + templateDir <- case standaloneTemplateDir options of + Just x -> return x + Nothing -> do + dataDir <- getDataDir + return $ dataDir "templates" "standalone" let functions = exprPair (standalonePropFormat options) @@ -160,6 +163,7 @@ standalone' fp options (ExprPair parse replace print ids) = do -- code. data StandaloneOptions = StandaloneOptions { standaloneTargetDir :: FilePath + , standaloneTemplateDir :: Maybe FilePath , standaloneFormat :: String , standalonePropFormat :: String , standaloneTypeMapping :: [(String, String)] From b4c11bd0fc024c05635222665f20297d491cd2fa Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 24 Dec 2024 01:16:50 +0000 Subject: [PATCH 5/8] ogma-core: Adjust tests to provide template directory to standalone command. Refs #189. The standalone backend uses a fixed template to generate the Copilot monitor. That template does not fit all use cases, so we are finding users heavily modifying the output (which is hard to keep up with when there are changes), or not using ogma altogether for that reason. A prior commit introduced, in the standalone command, support for custom templates and, with it, the ability to pass a custom directory containing a standalone application template. This commit modifies the tests for the standalone command to provide no custom template directory, to use the default included with Ogma. --- ogma-core/tests/Main.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/ogma-core/tests/Main.hs b/ogma-core/tests/Main.hs index d7defa9..716d635 100644 --- a/ogma-core/tests/Main.hs +++ b/ogma-core/tests/Main.hs @@ -109,6 +109,7 @@ testFretComponentSpec2Copilot file success = do , standaloneTypeMapping = [("int", "Int64"), ("real", "Float")] , standaloneFilename = "fret" , standaloneTargetDir = targetDir + , standaloneTemplateDir = Nothing } result <- standalone file opts @@ -143,6 +144,7 @@ testFretReqsDBCoCoSpec2Copilot file success = do , standaloneTypeMapping = [] , standaloneFilename = "fret" , standaloneTargetDir = targetDir + , standaloneTemplateDir = Nothing } result <- standalone file opts From a8e81650bfcb6d1c5f76c43488bbe6c9d1cdf6e2 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 24 Dec 2024 01:14:59 +0000 Subject: [PATCH 6/8] ogma-cli: Add CLI argument to standalone command to set auxiliary template source directory. Refs #189. The standalone backend uses a fixed template to generate the Copilot monitor. That template does not fit all use cases, so we are finding users heavily modifying the output (which is hard to keep up with when there are changes), and or not using ogma altogether for that reason. A recent commit introduced into ogma-core the ability to use a custom template and expand variables using mustache. This commit exposes that new parameter to the user in the CLI. --- ogma-cli/src/CLI/CommandStandalone.hs | 27 ++++++++++++++++++++------- 1 file changed, 20 insertions(+), 7 deletions(-) diff --git a/ogma-cli/src/CLI/CommandStandalone.hs b/ogma-cli/src/CLI/CommandStandalone.hs index 7cafc44..108e4a6 100644 --- a/ogma-cli/src/CLI/CommandStandalone.hs +++ b/ogma-cli/src/CLI/CommandStandalone.hs @@ -43,7 +43,7 @@ module CLI.CommandStandalone where -- External imports -import Options.Applicative (Parser, help, long, metavar, many, short, +import Options.Applicative (Parser, help, long, many, metavar, optional, short, showDefault, strOption, switch, value) -- External imports: command results @@ -58,12 +58,13 @@ import qualified Command.Standalone -- | Options to generate Copilot from specification. data CommandOpts = CommandOpts - { standaloneTargetDir :: FilePath - , standaloneFileName :: FilePath - , standaloneFormat :: String - , standalonePropFormat :: String - , standaloneTypes :: [String] - , standaloneTarget :: String + { standaloneTargetDir :: FilePath + , standaloneTemplateDir :: Maybe FilePath + , standaloneFileName :: FilePath + , standaloneFormat :: String + , standalonePropFormat :: String + , standaloneTypes :: [String] + , standaloneTarget :: String } -- | Transform an input specification into a Copilot specification. @@ -73,6 +74,7 @@ command c = standalone (standaloneFileName c) internalCommandOpts internalCommandOpts :: Command.Standalone.StandaloneOptions internalCommandOpts = Command.Standalone.StandaloneOptions { Command.Standalone.standaloneTargetDir = standaloneTargetDir c + , Command.Standalone.standaloneTemplateDir = standaloneTemplateDir c , Command.Standalone.standaloneFormat = standaloneFormat c , Command.Standalone.standalonePropFormat = standalonePropFormat c , Command.Standalone.standaloneTypeMapping = types @@ -106,6 +108,13 @@ commandOptsParser = CommandOpts <> value "copilot" <> help strStandaloneTargetDirDesc ) + <*> optional + ( strOption + ( long "template-dir" + <> metavar "DIR" + <> help strStandaloneTemplateDirArgDesc + ) + ) <*> strOption ( long "file-name" <> metavar "FILENAME" @@ -146,6 +155,10 @@ commandOptsParser = CommandOpts strStandaloneTargetDirDesc :: String strStandaloneTargetDirDesc = "Target directory" +-- | Template dir flag description. +strStandaloneTemplateDirArgDesc :: String +strStandaloneTemplateDirArgDesc = "Directory holding standalone source template" + -- | Filename flag description. strStandaloneFilenameDesc :: String strStandaloneFilenameDesc = "File with properties or requirements" From e716247024522f6a26f1a7fc4503777187860782 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 24 Dec 2024 01:18:59 +0000 Subject: [PATCH 7/8] ogma-core: Document changes in CHANGELOG. Refs #189. --- ogma-core/CHANGELOG.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/ogma-core/CHANGELOG.md b/ogma-core/CHANGELOG.md index cd51e53..7417feb 100644 --- a/ogma-core/CHANGELOG.md +++ b/ogma-core/CHANGELOG.md @@ -1,9 +1,10 @@ # Revision history for ogma-core -## [1.X.Y] - 2024-12-04 +## [1.X.Y] - 2024-12-23 * 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). ## [1.5.0] - 2024-11-21 From 9c76554ab695e98ed05a01caad099f0347519358 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 24 Dec 2024 01:19:24 +0000 Subject: [PATCH 8/8] ogma-cli: Document changes in CHANGELOG. Refs #189. --- ogma-cli/CHANGELOG.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/ogma-cli/CHANGELOG.md b/ogma-cli/CHANGELOG.md index f005cbe..dbd0af8 100644 --- a/ogma-cli/CHANGELOG.md +++ b/ogma-cli/CHANGELOG.md @@ -1,9 +1,10 @@ # Revision history for ogma-cli -## [1.X.Y] - 2024-11-26 +## [1.X.Y] - 2024-12-23 * Update contribution guidelines (#161). * Provide ability to customize template in fprime command (#185). +* Provide ability to customize template in standalone command (#189). ## [1.5.0] - 2024-11-21