-- Copyright 2020 United States Government as represented by the Administrator -- of the National Aeronautics and Space Administration. All Rights Reserved. -- -- Disclaimers -- -- No Warranty: THE SUBJECT SOFTWARE IS PROVIDED "AS IS" WITHOUT ANY WARRANTY -- OF ANY KIND, EITHER EXPRESSED, IMPLIED, OR STATUTORY, INCLUDING, BUT NOT -- LIMITED TO, ANY WARRANTY THAT THE SUBJECT SOFTWARE WILL CONFORM TO -- SPECIFICATIONS, ANY IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A -- PARTICULAR PURPOSE, OR FREEDOM FROM INFRINGEMENT, ANY WARRANTY THAT THE -- SUBJECT SOFTWARE WILL BE ERROR FREE, OR ANY WARRANTY THAT DOCUMENTATION, IF -- PROVIDED, WILL CONFORM TO THE SUBJECT SOFTWARE. THIS AGREEMENT DOES NOT, IN -- ANY MANNER, CONSTITUTE AN ENDORSEMENT BY GOVERNMENT AGENCY OR ANY PRIOR -- RECIPIENT OF ANY RESULTS, RESULTING DESIGNS, HARDWARE, SOFTWARE PRODUCTS OR -- ANY OTHER APPLICATIONS RESULTING FROM USE OF THE SUBJECT SOFTWARE. FURTHER, -- GOVERNMENT AGENCY DISCLAIMS ALL WARRANTIES AND LIABILITIES REGARDING -- THIRD-PARTY SOFTWARE, IF PRESENT IN THE ORIGINAL SOFTWARE, AND DISTRIBUTES -- IT "AS IS." -- -- Waiver and Indemnity: RECIPIENT AGREES TO WAIVE ANY AND ALL CLAIMS AGAINST -- THE UNITED STATES GOVERNMENT, ITS CONTRACTORS AND SUBCONTRACTORS, AS WELL AS -- ANY PRIOR RECIPIENT. IF RECIPIENT'S USE OF THE SUBJECT SOFTWARE RESULTS IN -- ANY LIABILITIES, DEMANDS, DAMAGES, EXPENSES OR LOSSES ARISING FROM SUCH USE, -- INCLUDING ANY DAMAGES FROM PRODUCTS BASED ON, OR RESULTING FROM, RECIPIENT'S -- USE OF THE SUBJECT SOFTWARE, RECIPIENT SHALL INDEMNIFY AND HOLD HARMLESS THE -- UNITED STATES GOVERNMENT, ITS CONTRACTORS AND SUBCONTRACTORS, AS WELL AS ANY -- PRIOR RECIPIENT, TO THE EXTENT PERMITTED BY LAW. RECIPIENT'S SOLE REMEDY -- FOR ANY SUCH MATTER SHALL BE THE IMMEDIATE, UNILATERAL TERMINATION OF THIS -- AGREEMENT. -- -- | CLI parsing, handling, and execution. -- -- The full module CLI is just a sum of all the subcommands with their -- respective CLI options. -- -- This module defines: -- -- - A 'CommandOpts' type that represents all options to the program, -- the subcommand executed, and any options for that subcommand. -- -- - A 'commandOptsParser' parser for the subcommands and their arguments, -- delegating the argument parsing to each subcommand's own CLI parser. -- -- - A 'command' function that dispatcher processing of the execution to the -- appropriate subcommand. -- -- - An 'ErrorCode' type that represents reasons why the program may have -- failed. -- -- Each of the subcommands is defined using the same standard interface. -- This module is merely a sum of all subcommands: -- -- - The type 'CommandOpts' is the sum of all respective subcommand options -- (whose types all share the same name but have different representations). -- -- - The parser is a sum of all subparsers, each attached to a specific -- command name defined in this module. -- -- - The command function is merely a dispatcher that detects the subcommand -- that must be executed, extracts the input, runs it, and translates the -- subcommands result into a top-level command result. -- -- - The error code is a plain representation that collapses the local -- subcommand error codes into a few possible values. module CLI.CommandTop ( -- * Direct command access CommandOpts , command , ErrorCode -- * CLI , commandDesc , commandOptsParser ) where -- External imports import Options.Applicative ( CommandFields, Mod, Parser, helper, info, progDesc, subparser, (<**>) ) import qualified Options.Applicative as OptParse -- External imports: command results import Command.Result ( Result ) -- Internal imports: subcommands import qualified CLI.CommandCFSApp import qualified CLI.CommandCStructs2Copilot import qualified CLI.CommandCStructs2MsgHandlers import qualified CLI.CommandFPrimeApp import qualified CLI.CommandFretComponentSpec2Copilot import qualified CLI.CommandFretReqsDB2Copilot import qualified CLI.CommandROSApp -- * Command -- | Commands supported by Ogma and their arguments. -- All subcommands use the same interface, so they all use the type name -- @CommandOpts@ to capture their respective arguments. These types are -- different for each subcommand. data CommandOpts = CommandOptsCFSApp CLI.CommandCFSApp.CommandOpts | CommandOptsCStructs2Copilot CLI.CommandCStructs2Copilot.CommandOpts | CommandOptsCStructs2MsgHandlers CLI.CommandCStructs2MsgHandlers.CommandOpts | CommandOptsFPrimeApp CLI.CommandFPrimeApp.CommandOpts | CommandOptsFretComponentSpec2Copilot CLI.CommandFretComponentSpec2Copilot.CommandOpts | CommandOptsFretReqsDB2Copilot CLI.CommandFretReqsDB2Copilot.CommandOpts | CommandOptsROSApp CLI.CommandROSApp.CommandOpts -- * CLI -- | Command description for CLI help. commandDesc :: String commandDesc = "Generate complete or partial Copilot applications from multiple languages" -- | Subparser for multiple subcommands. commandOptsParser :: Parser CommandOpts commandOptsParser = subparser ( subcommandCStructs <> subcommandMsgHandlers <> subcommandCFSApp <> subcommandFPrimeApp <> subcommandFretComponentSpec <> subcommandFretReqs <> subcommandROSApp ) -- | Modifier for the CStruct to Copilot Struct generation subcommand, linking -- the subcommand options and description to the command @structs@ at top -- level. subcommandCStructs :: Mod CommandFields CommandOpts subcommandCStructs = subcommand "structs" (CommandOptsCStructs2Copilot <$> CLI.CommandCStructs2Copilot.commandOptsParser) CLI.CommandCStructs2Copilot.commandDesc -- | Modifier for the msg handler generation subcommand, linking the subcommand -- options and description to the command @handlers@ at top level. subcommandMsgHandlers :: Mod CommandFields CommandOpts subcommandMsgHandlers = subcommand "handlers" (CommandOptsCStructs2MsgHandlers <$> CLI.CommandCStructs2MsgHandlers.commandOptsParser) CLI.CommandCStructs2MsgHandlers.commandDesc -- | Modifier for the CFS app expansion subcommand, linking the subcommand -- options and description to the command @cfs@ at top level. subcommandCFSApp :: Mod CommandFields CommandOpts subcommandCFSApp = subcommand "cfs" (CommandOptsCFSApp <$> CLI.CommandCFSApp.commandOptsParser) CLI.CommandCFSApp.commandDesc -- | Modifier for the FRET component spec to copilot subcommand, linking the -- subcommand options and description to the command @fret-component-spec@ at -- top level. subcommandFretComponentSpec :: Mod CommandFields CommandOpts subcommandFretComponentSpec = subcommand "fret-component-spec" (CommandOptsFretComponentSpec2Copilot <$> CLI.CommandFretComponentSpec2Copilot.commandOptsParser) CLI.CommandFretComponentSpec2Copilot.commandDesc -- | Modifier for the FRET requirements DB to copilot subcommand, linking the -- subcommand options and description to the command @fret-reqs-db@ at top -- level. subcommandFretReqs :: Mod CommandFields CommandOpts subcommandFretReqs = subcommand "fret-reqs-db" (CommandOptsFretReqsDB2Copilot <$> CLI.CommandFretReqsDB2Copilot.commandOptsParser) CLI.CommandFretReqsDB2Copilot.commandDesc -- | Modifier for the ROS app expansion subcommand, linking the subcommand -- options and description to the command @ros@ at top level. subcommandROSApp :: Mod CommandFields CommandOpts subcommandROSApp = subcommand "ros" (CommandOptsROSApp <$> CLI.CommandROSApp.commandOptsParser) CLI.CommandROSApp.commandDesc -- | Modifier for the FPrime app expansion subcommand, linking the subcommand -- options and description to the command @fprime@ at top level. subcommandFPrimeApp :: Mod CommandFields CommandOpts subcommandFPrimeApp = subcommand "fprime" (CommandOptsFPrimeApp <$> CLI.CommandFPrimeApp.commandOptsParser) CLI.CommandFPrimeApp.commandDesc -- * Command dispatcher -- | Command dispatcher that obtains the parameters from the command line and -- passes them as arguments to the actual function that will process them, -- transforming the local result into a global program result. -- This function is implemented as a combination of three processes or -- functions: one that adapts the input to the inner function (down), the -- actual function implementing the command, and a translation of the local -- result into a global result that can be reported to users (up). In this -- case, the commands are all using the same (and compatible) exit codes, but -- they might not do so. This is captured by the fmap of the function id on -- each processing command. -- -- The function that adapts the inputs simply passes the arguments obtained -- from the command line one by one. Composition with this function uncurries -- the next function to work over the product as defined by the record that -- accompanies each command definition in the type OgmaCLICommand. -- -- Neither this nor the internal commands not know, and need to know, that they -- run in CLI. command :: CommandOpts -> IO (Result ErrorCode) command (CommandOptsCFSApp c) = id <$> CLI.CommandCFSApp.command c command (CommandOptsCStructs2Copilot c) = id <$> CLI.CommandCStructs2Copilot.command c command (CommandOptsCStructs2MsgHandlers c) = id <$> CLI.CommandCStructs2MsgHandlers.command c command (CommandOptsFPrimeApp c) = id <$> CLI.CommandFPrimeApp.command c command (CommandOptsFretComponentSpec2Copilot c) = id <$> CLI.CommandFretComponentSpec2Copilot.command c command (CommandOptsFretReqsDB2Copilot c) = id <$> CLI.CommandFretReqsDB2Copilot.command c command (CommandOptsROSApp c) = id <$> CLI.CommandROSApp.command c -- We indicate to HLint that the use of (id <$>) above should not trigger a -- warning. Conceptually, there is a transformation taking place, but no change -- is required because the types used by the internal functions and the -- top-level command to represent results are the same, and the error codes are -- non-overlapping. {-# ANN command "HLint: ignore Functor law" #-} -- * Error codes -- | Encoding of reasons why the command can fail. -- -- The error code used is 1 for user error, 2 for internal bug. type ErrorCode = Int -- * Auxiliary defs -- | Build a subcommand modifier from a command name, option parser and command -- description. subcommand :: String -> Parser CommandOpts -> String -> Mod CommandFields CommandOpts subcommand entry parser desc = OptParse.command entry (info (parser <**> helper) (progDesc desc))