diff --git a/ogma-cli/CHANGELOG.md b/ogma-cli/CHANGELOG.md index 5b17da9f..b0177a40 100644 --- a/ogma-cli/CHANGELOG.md +++ b/ogma-cli/CHANGELOG.md @@ -1,8 +1,9 @@ # Revision history for ogma-cli -## [1.X.Y] - 2024-11-11 +## [1.X.Y] - 2024-11-20 * Provide ability to customize template in cfs command (#157). +* Provide ability to customize template in ros command (#162). ## [1.4.1] - 2024-09-21 diff --git a/ogma-cli/README.md b/ogma-cli/README.md index b6623550..0227b91c 100644 --- a/ogma-cli/README.md +++ b/ogma-cli/README.md @@ -236,9 +236,10 @@ the data needed by the monitors and report any violations. At present, support for ROS app generation is considered preliminary. ROS applications are generated using the Ogma command `ros`, which receives -four main arguments: +five main arguments: - `--app-target-dir DIR`: location where the ROS application files must be stored. +- `--app-template-dir DIR`: location of the ROS application template to use. - `--variable-file FILENAME`: a file containing a list of variables that must be made available to the monitor. - `--variable-db FILENAME`: a file containing a database of known variables, @@ -299,6 +300,74 @@ and the last step of the script `.github/workflows/repo-ghc-8.6-cabal-2.4-ros.yml`, which generates a ROS monitor with multiple variables and compiles the resulting code. +### Template Customization + +By default, Ogma uses a pre-defined template to generate the ROS monitoring +package. It's possible to customize the output by providing a directory with a +set of files with a ROS package template, which Ogma will use instead. + +To choose this feature, one must call Ogma's `ros` command with the argument +`--app-template-dir DIR`, where `DIR` is the path to a directory containing a +ROS 2 package template. For example, assuming that the directory `my_template` +contains a custom ROS package template, one can execute: + +``` +$ ogma ros --app-template-dir my_template/ --handlers filename --variable-file variables --variable-db ros-variable-db --app-target-dir ros_demo +``` + +Ogma will copy the files in that directory to the target path, filling in +several holes with specific information. For the monitoring node, the variables +are: + +- `{{variablesS}}`: this will be replaced by a list of variable declarations, + one for each global variable that holds information read from the ROS +software bus that must be made accessible to the monitoring code. + +- `{{msgSubscriptionsS}}`: this will be replaced by a list of calls to + `create_subscription`, subscribing to the necessary information coming in the +software bus. + +- `{{msgPublisherS}}`: this will be replaced by a list of calls to + `create_publisher`, to create topics to report property violations on the +software bus. + +- `{{msgHandlerInClassS}}`: this will be replaced by the functions that will be + called to report a property violation via one of the property violation +topics (publishers). + +- `{{msgCallbacks}}`: this will be replaced by function definitions of the + functions that will be called to actually update the variables with +information coming from the software bus, and re-evaluate the monitors. + +- `{{msgSubscriptionDeclrs}}`: this will be replaced by declarations of + subscriptions used in `{{msgSubscriptionsS}}`. + +- `{{msgPublisherDeclrs}}`: this will be replaced by declarations of publishers + used in `{{msgPublishersS}}`. + +- `{{msgHandlerGlobalS}}`: this will be replaced by top-level functions that + call the handlers from the single monitoring class instance (singleton). + +Ogma will also generate a logging node that can be used for debugging purposes, +to print property violations to a log. This second node listens to the messages +published by the monitoring node in the software bus. For that node, the +variables used are: + +- `{{logMsgSubscriptionsS}}`: this will be replaced by a list of calls to + `create_subscription`, subscribing to the necessary information coming in the +software bus. + +- `{{logMsgCallbacks}}`: this will be replaced by function definitions of the + functions called to report the violations in the log. These functions are +used as handlers to incoming messages in the subscriptions. + +- `{{logMsgSubscriptionDeclrs}}`: this will be replaced by declarations of + subscriptions used in `{{logMsgSubscriptionsS}}`. + +We understand that this level of customization may be insufficient for your +application. If that is the case, feel free to reach out to our team to discuss +how we could make the template expansion system more versatile. + ### Current limitations The user must place the code generated by Copilot monitors in two files, diff --git a/ogma-cli/src/CLI/CommandROSApp.hs b/ogma-cli/src/CLI/CommandROSApp.hs index 9fac9ba3..2762c86f 100644 --- a/ogma-cli/src/CLI/CommandROSApp.hs +++ b/ogma-cli/src/CLI/CommandROSApp.hs @@ -56,11 +56,12 @@ import Command.ROSApp ( ErrorCode, rosApp ) -- | Options needed to generate the ROS application. data CommandOpts = CommandOpts - { rosAppTarget :: String - , rosAppFRETFile :: Maybe String - , rosAppVarNames :: Maybe String - , rosAppVarDB :: Maybe String - , rosAppHandlers :: Maybe String + { rosAppTarget :: String + , rosAppTemplateDir :: Maybe String + , rosAppFRETFile :: Maybe String + , rosAppVarNames :: Maybe String + , rosAppVarDB :: Maybe String + , rosAppHandlers :: Maybe String } -- | Create (ROS) applications @@ -72,6 +73,7 @@ command :: CommandOpts -> IO (Result ErrorCode) command c = rosApp (rosAppTarget c) + (rosAppTemplateDir c) (rosAppFRETFile c) (rosAppVarNames c) (rosAppVarDB c) @@ -94,6 +96,13 @@ commandOptsParser = CommandOpts <> value "ros" <> help strROSAppDirArgDesc ) + <*> optional + ( strOption + ( long "app-template-dir" + <> metavar "DIR" + <> help strROSAppTemplateDirArgDesc + ) + ) <*> optional ( strOption ( long "fret-file-name" @@ -127,6 +136,11 @@ commandOptsParser = CommandOpts strROSAppDirArgDesc :: String strROSAppDirArgDesc = "Target directory" +-- | Argument template directory to ROS app generation command +strROSAppTemplateDirArgDesc :: String +strROSAppTemplateDirArgDesc = + "Directory holding ROS application source template" + -- | Argument FRET CS to ROS app generation command strROSAppFRETFileNameArgDesc :: String strROSAppFRETFileNameArgDesc = diff --git a/ogma-core/CHANGELOG.md b/ogma-core/CHANGELOG.md index 00dca11d..b068afac 100644 --- a/ogma-core/CHANGELOG.md +++ b/ogma-core/CHANGELOG.md @@ -1,9 +1,10 @@ # Revision history for ogma-core -## [1.X.Y] - 2024-11-13 +## [1.X.Y] - 2024-11-20 * 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). ## [1.4.1] - 2024-09-21 diff --git a/ogma-core/ogma-core.cabal b/ogma-core/ogma-core.cabal index 891e3e8b..ad264143 100644 --- a/ogma-core/ogma-core.cabal +++ b/ogma-core/ogma-core.cabal @@ -62,7 +62,8 @@ data-files: templates/copilot-cfs/CMakeLists.txt templates/copilot-cfs/fsw/src/copilot_cfs_events.h templates/ros/Dockerfile templates/ros/copilot/CMakeLists.txt - templates/ros/copilot/src/.keep + templates/ros/copilot/src/copilot_logger.cpp + templates/ros/copilot/src/copilot_monitor.cpp templates/ros/copilot/package.xml templates/fprime/CMakeLists.txt templates/fprime/Dockerfile @@ -106,10 +107,7 @@ library base >= 4.11.0.0 && < 5 , aeson >= 2.0.0.0 && < 2.2 , bytestring - , Cabal >= 2.4 && < 3.10 - , directory >= 1.3.1.0 && < 1.4 , filepath - , microstache >= 1.0 && < 1.1 , mtl , text >= 1.2.3.1 && < 2.1 diff --git a/ogma-core/src/Command/CFSApp.hs b/ogma-core/src/Command/CFSApp.hs index 59bd5ce7..1c5b35f1 100644 --- a/ogma-core/src/Command/CFSApp.hs +++ b/ogma-core/src/Command/CFSApp.hs @@ -47,23 +47,16 @@ module Command.CFSApp -- External imports import qualified Control.Exception as E -import Control.Monad (filterM, forM_) -import Data.Aeson (Value (..), decode, object, (.=)) -import qualified Data.ByteString.Lazy as B +import Data.Aeson (decode, object, (.=)) import Data.List (find) import Data.Text (Text) import Data.Text.Lazy (pack, unpack) -import Data.Text.Lazy.Encoding (encodeUtf8) -import Distribution.Simple.Utils (getDirectoryContentsRecursive) -import System.Directory (createDirectoryIfMissing, - doesFileExist) -import System.FilePath (makeRelative, splitFileName, ()) -import Text.Microstache (compileMustacheFile, - compileMustacheText, renderMustache) +import System.FilePath ( () ) -- Internal imports: auxiliary -import Command.Result ( Result (..) ) -import Data.Location ( Location (..) ) +import Command.Result ( Result (..) ) +import Data.Location ( Location (..) ) +import System.Directory.Extra ( copyTemplate ) -- Internal imports import Paths_ogma_core ( getDataDir ) @@ -303,48 +296,3 @@ ecCannotEmptyVarList = 1 -- permissions or some I/O error. ecCannotCopyTemplate :: ErrorCode ecCannotCopyTemplate = 1 - --- * Generic template handling - --- | Copy a template directory into a target location, expanding variables --- provided in a map in a JSON value, both in the file contents and in the --- filepaths themselves. -copyTemplate :: FilePath -> Value -> FilePath -> IO () -copyTemplate templateDir subst targetDir = do - - -- Get all files (not directories) in the template dir. To keep a directory, - -- create an empty file in it (e.g., .keep). - tmplContents <- map (templateDir ) . filter (`notElem` ["..", "."]) - <$> getDirectoryContentsRecursive templateDir - tmplFiles <- filterM doesFileExist tmplContents - - -- Copy files to new locations, expanding their name and contents as - -- mustache templates. - forM_ tmplFiles $ \fp -> do - - -- New file name in target directory, treating file - -- name as mustache template. - let fullPath = targetDir newFP - where - -- If file name has mustache markers, expand, otherwise use - -- relative file path - newFP = either (const relFP) - (unpack . (`renderMustache` subst)) - fpAsTemplateE - - -- Local file name within template dir - relFP = makeRelative templateDir fp - - -- Apply mustache substitutions to file name - fpAsTemplateE = compileMustacheText "fp" (pack relFP) - - -- File contents, treated as a mustache template. - contents <- encodeUtf8 <$> (`renderMustache` subst) - <$> compileMustacheFile fp - - -- Create target directory if necessary - let dirName = fst $ splitFileName fullPath - createDirectoryIfMissing True dirName - - -- Write expanded contents to expanded file path - B.writeFile fullPath contents diff --git a/ogma-core/src/Command/ROSApp.hs b/ogma-core/src/Command/ROSApp.hs index 9528b34f..9c673706 100644 --- a/ogma-core/src/Command/ROSApp.hs +++ b/ogma-core/src/Command/ROSApp.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} -- Copyright 2022 United States Government as represented by the Administrator -- of the National Aeronautics and Space Administration. All Rights Reserved. -- @@ -46,15 +47,16 @@ module Command.ROSApp import qualified Control.Exception as E import Control.Monad.Except (ExceptT, liftEither, liftIO, runExceptT, throwError) -import Data.Aeson (eitherDecode) +import Data.Aeson (eitherDecode, object, (.=)) import Data.List (find, intersperse) import Data.Maybe (fromMaybe) +import Data.Text.Lazy (pack) import System.FilePath (()) -- External imports: auxiliary import Data.ByteString.Extra as B (safeReadFile) import Data.String.Extra (sanitizeLCIdentifier, sanitizeUCIdentifier) -import System.Directory.Extra (copyDirectoryRecursive) +import System.Directory.Extra (copyTemplate) -- External imports: ogma import Data.OgmaSpec (Spec, externalVariableName, externalVariables, @@ -73,6 +75,7 @@ import Paths_ogma_core ( getDataDir ) -- | Generate a new ROS application connected to Copilot. rosApp :: FilePath -- ^ Target directory where the application -- should be created. + -> Maybe FilePath -- ^ Directory where the template is to be found. -> Maybe FilePath -- ^ FRET Component specification file. -> Maybe FilePath -- ^ File containing a list of variables to make -- available to Copilot. @@ -83,7 +86,7 @@ rosApp :: FilePath -- ^ Target directory where the application -- Copilot specification. The handlers are assumed -- to receive no arguments. -> IO (Result ErrorCode) -rosApp targetDir fretCSFile varNameFile varDBFile handlersFile = +rosApp targetDir mTemplateDir fretCSFile varNameFile varDBFile handlersFile = processResult $ do cs <- parseOptionalFRETCS fretCSFile vs <- parseOptionalVariablesFile varNameFile @@ -95,13 +98,15 @@ rosApp targetDir fretCSFile varNameFile varDBFile handlersFile = let varNames = fromMaybe (fretCSExtractExternalVariables cs) vs monitors = fromMaybe (fretCSExtractHandlers cs) rs - e <- liftIO $ rosApp' targetDir varNames varDB monitors + e <- liftIO $ rosApp' targetDir mTemplateDir varNames varDB monitors liftEither e -- | Generate a new ROS application connected to Copilot, by copying the -- template and filling additional necessary files. rosApp' :: FilePath -- ^ Target directory where the -- application should be created. + -> Maybe FilePath -- ^ Directory where the template + -- is to be found. -> [String] -- ^ List of variable names -- (data sources). -> [(String, String, String, String)] -- ^ List of variables with their @@ -112,14 +117,14 @@ rosApp' :: FilePath -- ^ Target directory where the -- to the monitors (or -- requirements monitored). -> IO (Either ErrorTriplet ()) -rosApp' targetDir varNames varDB monitors = +rosApp' targetDir mTemplateDir varNames varDB monitors = E.handle (return . Left . cannotCopyTemplate) $ do -- Obtain template dir - dataDir <- getDataDir - let templateDir = dataDir "templates" "ros" - - -- Expand template - copyDirectoryRecursive templateDir targetDir + templateDir <- case mTemplateDir of + Just x -> return x + Nothing -> do + dataDir <- getDataDir + return $ dataDir "templates" "ros" let f n o@(oVars, oIds, oInfos, oDatas) = case variableMap varDB n of @@ -135,21 +140,29 @@ rosApp' targetDir varNames varDB monitors = let (vars, ids, infos, datas) = foldr f ([], [], [], []) varNames - let rosFileName = - targetDir "copilot" "src" "copilot_monitor.cpp" - rosFileContents = - unlines $ - rosMonitorContents varNames vars ids infos datas monitors - - writeFile rosFileName rosFileContents - - let rosFileName = - targetDir "copilot" "src" "copilot_logger.cpp" - rosFileContents = - unlines $ - rosLoggerContents varNames vars ids infos datas monitors - - writeFile rosFileName rosFileContents + let (variablesS, msgSubscriptionS, msgPublisherS, + msgHandlerInClassS, msgCallbacks, msgSubscriptionDeclrs, + msgPublisherDeclrs, msgHandlerGlobalS) = + rosMonitorComponents varNames vars ids infos datas monitors + + (logMsgSubscriptionS, logMsgCallbacks, logMsgSubscriptionDeclrs) = + rosLoggerComponents varNames vars ids infos datas monitors + + subst = object $ + [ "variablesS" .= pack variablesS + , "msgSubscriptionS" .= pack msgSubscriptionS + , "msgPublisherS" .= pack msgPublisherS + , "msgHandlerInClassS" .= pack msgHandlerInClassS + , "msgCallbacks" .= pack msgCallbacks + , "msgSubscriptionDeclrs" .= pack msgSubscriptionDeclrs + , "msgPublisherDeclrs" .= pack msgPublisherDeclrs + , "msgHandlerGlobalS" .= pack msgHandlerGlobalS + , "logMsgSubscriptionS" .= pack logMsgSubscriptionS + , "logMsgCallbacks" .= pack logMsgCallbacks + , "logMsgSubscriptionDeclrs" .= pack logMsgSubscriptionDeclrs + ] + + copyTemplate templateDir subst targetDir return $ Right () @@ -301,52 +314,24 @@ data MsgData = MsgData -- * ROS apps content -- | Return the contents of the main ROS application. -rosMonitorContents :: [String] -- Variables - -> [VarDecl] - -> [MsgInfoId] - -> [MsgInfo] - -> [MsgData] - -> [String] -- Monitors - -> [String] -rosMonitorContents varNames variables msgIds msgNames msgDatas monitors = - [ "#include " - , "#include " - , "" - , "#include \"rclcpp/rclcpp.hpp\"" - , "" - , typeIncludes - , copilotIncludes - , "using std::placeholders::_1;" - , "" - , variablesS - , "class CopilotRV : public rclcpp::Node {" - , " public:" - , " CopilotRV() : Node(\"copilotrv\") {" +rosMonitorComponents + :: [String] -- Variables + -> [VarDecl] + -> [MsgInfoId] + -> [MsgInfo] + -> [MsgData] + -> [String] -- Monitors + -> (String, String, String, String, String, String, String, String) +rosMonitorComponents varNames variables msgIds msgNames msgDatas monitors = + ( variablesS , msgSubscriptionS , msgPublisherS - , " }" - , "" , msgHandlerInClassS - , " // Needed so we can report messages to the log." - , " static CopilotRV& getInstance() {" - , " static CopilotRV instance;" - , " return instance;" - , " }" - , "" - , " private:" , msgCallbacks , msgSubscriptionDeclrs , msgPublisherDeclrs - , "};" - , "" , msgHandlerGlobalS - , "int main(int argc, char* argv[]) {" - , " rclcpp::init(argc, argv);" - , " rclcpp::spin(std::make_shared());" - , " rclcpp::shutdown();" - , " return 0;" - , "}" - ] + ) where @@ -369,27 +354,6 @@ rosMonitorContents varNames variables msgIds msgNames msgDatas monitors = publisher = monitor ++ "_publisher_" - typeIncludes = unlines - [ "#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 " - ] - - copilotIncludes = unlines - [ "#include \"monitor.h\"" - , "#include \"monitor.c\"" - ] - variablesS = unlines $ map toVarDecl variables toVarDecl varDecl = varDeclType' varDecl ++ " " ++ varDeclName varDecl ++ ";" @@ -515,50 +479,18 @@ rosMonitorContents varNames variables msgIds msgNames msgDatas monitors = publisher = nm ++ "_publisher_" -- | Return the contents of the logger ROS application. -rosLoggerContents :: [String] -- Variables - -> [VarDecl] - -> [MsgInfoId] - -> [MsgInfo] - -> [MsgData] - -> [String] -- Monitors - -> [String] -rosLoggerContents varNames variables msgIds msgNames msgDatas monitors = - rosFileContents +rosLoggerComponents :: [String] -- Variables + -> [VarDecl] + -> [MsgInfoId] + -> [MsgInfo] + -> [MsgData] + -> [String] -- Monitors + -> (String, String, String) +rosLoggerComponents varNames variables msgIds msgNames msgDatas monitors = + (msgSubscriptionS, msgCallbacks, msgSubscriptionDeclrs) where - rosFileContents = - [ "#include " - , "#include " - , "" - , "#include \"rclcpp/rclcpp.hpp\"" - , "" - , typeIncludes - , "using std::placeholders::_1;" - , "" - , "class CopilotLogger : public rclcpp::Node {" - , " public:" - , " CopilotLogger() : Node(\"copilotlogger\") {" - , msgSubscriptionS - , " }" - , "" - , " private:" - , msgCallbacks - , msgSubscriptionDeclrs - , "};" - , "" - , "int main(int argc, char* argv[]) {" - , " rclcpp::init(argc, argv);" - , " rclcpp::spin(std::make_shared());" - , " rclcpp::shutdown();" - , " return 0;" - , "}" - ] - - typeIncludes = unlines - [ "#include \"std_msgs/msg/empty.hpp\"" - ] - msgSubscriptionS = unlines $ concat $ intersperse [""] diff --git a/ogma-core/templates/ros/copilot/src/.keep b/ogma-core/templates/ros/copilot/src/.keep deleted file mode 100644 index e69de29b..00000000 diff --git a/ogma-core/templates/ros/copilot/src/copilot_logger.cpp b/ogma-core/templates/ros/copilot/src/copilot_logger.cpp new file mode 100644 index 00000000..fbda764f --- /dev/null +++ b/ogma-core/templates/ros/copilot/src/copilot_logger.cpp @@ -0,0 +1,27 @@ +#include +#include + +#include "rclcpp/rclcpp.hpp" + +#include "std_msgs/msg/empty.hpp" +using std::placeholders::_1; + +class CopilotLogger : public rclcpp::Node { + public: + CopilotLogger() : Node("copilotlogger") { +{{{logMsgSubscriptionS}}} + } + + private: +{{{logMsgCallbacks}}} +{{{logMsgSubscriptionDeclrs}}} +}; + +int main(int argc, char* argv[]) { + rclcpp::init(argc, argv); + rclcpp::spin(std::make_shared()); + rclcpp::shutdown(); + return 0; +} + + diff --git a/ogma-core/templates/ros/copilot/src/copilot_monitor.cpp b/ogma-core/templates/ros/copilot/src/copilot_monitor.cpp new file mode 100644 index 00000000..2d495fa0 --- /dev/null +++ b/ogma-core/templates/ros/copilot/src/copilot_monitor.cpp @@ -0,0 +1,52 @@ +#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 +#include "monitor.h" +#include "monitor.c" + +using std::placeholders::_1; + +{{{variablesS}}} +class CopilotRV : public rclcpp::Node { + public: + CopilotRV() : Node("copilotrv") { +{{{msgSubscriptionS}}} +{{{msgPublisherS}}} + } + +{{{msgHandlerInClassS}}} + // Needed so we can report messages to the log. + static CopilotRV& getInstance() { + static CopilotRV instance; + return instance; + } + + private: +{{{msgCallbacks}}} +{{{msgSubscriptionDeclrs}}} +{{{msgPublisherDeclrs}}} +}; + +{{{msgHandlerGlobalS}}} +int main(int argc, char* argv[]) { + rclcpp::init(argc, argv); + rclcpp::spin(std::make_shared()); + rclcpp::shutdown(); + return 0; +} + diff --git a/ogma-extra/CHANGELOG.md b/ogma-extra/CHANGELOG.md index defe47b1..dcc31e24 100644 --- a/ogma-extra/CHANGELOG.md +++ b/ogma-extra/CHANGELOG.md @@ -1,5 +1,9 @@ # Revision history for ogma-extra +## [1.X.Y] - 2024-11-20 + +* Introduce template expansion functionality (#162). + ## [1.4.1] - 2024-09-21 * Version bump 1.4.1 (#155). diff --git a/ogma-extra/ogma-extra.cabal b/ogma-extra/ogma-extra.cabal index c4ca300a..0c7c9b19 100644 --- a/ogma-extra/ogma-extra.cabal +++ b/ogma-extra/ogma-extra.cabal @@ -68,11 +68,14 @@ library System.Directory.Extra build-depends: - base >= 4.11.0.0 && < 5 + base >= 4.11.0.0 && < 5 + , aeson >= 2.0.0.0 && < 2.2 , bytestring , Cabal , directory , filepath + , microstache >= 1.0 && < 1.1 + , text >= 1.2.3.1 && < 2.1 hs-source-dirs: src diff --git a/ogma-extra/src/System/Directory/Extra.hs b/ogma-extra/src/System/Directory/Extra.hs index eb276012..01ebfdc4 100644 --- a/ogma-extra/src/System/Directory/Extra.hs +++ b/ogma-extra/src/System/Directory/Extra.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} -- Copyright 2020 United States Government as represented by the Administrator -- of the National Aeronautics and Space Administration. All Rights Reserved. -- @@ -32,17 +33,28 @@ module System.Directory.Extra ( copyDirectoryRecursive , copyFile' + , copyTemplate ) where -- External imports +import Control.Monad ( filterM, forM_ ) import qualified Control.Exception as E +import Data.Aeson ( Value (..) ) +import qualified Data.ByteString.Lazy as B +import Data.Text.Lazy ( pack, unpack ) +import Data.Text.Lazy.Encoding ( encodeUtf8 ) import Distribution.Simple.Utils ( getDirectoryContentsRecursive ) import System.Directory ( copyFile, - createDirectoryIfMissing ) + createDirectoryIfMissing, + doesFileExist ) import System.Exit ( ExitCode (ExitFailure), exitWith ) -import System.FilePath ( takeDirectory, () ) +import System.FilePath ( makeRelative, splitFileName, + takeDirectory, () ) import System.IO ( hPutStrLn, stderr ) +import Text.Microstache ( compileMustacheFile, + compileMustacheText, + renderMustache ) -- | Copy all files from one directory to another. copyDirectoryRecursive :: FilePath -- ^ Source directory @@ -79,3 +91,48 @@ copyDirectoryRecursiveErrorHandler sourceDir targetDir _exception = do hPutStrLn stderr $ "ogma: error: cannot copy " ++ sourceDir ++ " to " ++ targetDir exitWith (ExitFailure 1) + +-- * Generic template handling + +-- | Copy a template directory into a target location, expanding variables +-- provided in a map in a JSON value, both in the file contents and in the +-- filepaths themselves. +copyTemplate :: FilePath -> Value -> FilePath -> IO () +copyTemplate templateDir subst targetDir = do + + -- Get all files (not directories) in the template dir. To keep a directory, + -- create an empty file in it (e.g., .keep). + tmplContents <- map (templateDir ) . filter (`notElem` ["..", "."]) + <$> getDirectoryContentsRecursive templateDir + tmplFiles <- filterM doesFileExist tmplContents + + -- Copy files to new locations, expanding their name and contents as + -- mustache templates. + forM_ tmplFiles $ \fp -> do + + -- New file name in target directory, treating file + -- name as mustache template. + let fullPath = targetDir newFP + where + -- If file name has mustache markers, expand, otherwise use + -- relative file path + newFP = either (const relFP) + (unpack . (`renderMustache` subst)) + fpAsTemplateE + + -- Local file name within template dir + relFP = makeRelative templateDir fp + + -- Apply mustache substitutions to file name + fpAsTemplateE = compileMustacheText "fp" (pack relFP) + + -- File contents, treated as a mustache template. + contents <- encodeUtf8 <$> (`renderMustache` subst) + <$> compileMustacheFile fp + + -- Create target directory if necessary + let dirName = fst $ splitFileName fullPath + createDirectoryIfMissing True dirName + + -- Write expanded contents to expanded file path + B.writeFile fullPath contents