{-# 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 <https://www.ros.org/ Robot Operating System> (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 :: CommandOptions -> IO (Result ErrorCode)
command CommandOptions
options = ExceptT ErrorTriplet IO () -> IO (Result ErrorCode)
forall (m :: * -> *) a.
Monad m =>
ExceptT ErrorTriplet m a -> m (Result ErrorCode)
processResult (ExceptT ErrorTriplet IO () -> IO (Result ErrorCode))
-> ExceptT ErrorTriplet IO () -> IO (Result ErrorCode)
forall a b. (a -> b) -> a -> b
$ do
    -- Obtain template dir
    templateDir <- Maybe String -> String -> ExceptT ErrorTriplet IO String
forall e. Maybe String -> String -> ExceptT e IO String
locateTemplateDir Maybe String
mTemplateDir String
"ros"

    templateVars <- parseTemplateVarsFile templateVarsF

    appData <- command' options functions

    let subst = Value -> Value -> Value
mergeObjects (AppData -> Value
forall a. ToJSON a => a -> Value
toJSON AppData
appData) Value
templateVars

    -- Expand template
    ExceptT $ fmap (makeLeftE cannotCopyTemplate) $ E.try $
      copyTemplate templateDir subst targetDir

  where

    targetDir :: String
targetDir     = CommandOptions -> String
commandTargetDir CommandOptions
options
    mTemplateDir :: Maybe String
mTemplateDir  = CommandOptions -> Maybe String
commandTemplateDir CommandOptions
options
    functions :: ExprPair
functions     = String -> ExprPair
exprPair (CommandOptions -> String
commandPropFormat CommandOptions
options)
    templateVarsF :: Maybe String
templateVarsF = CommandOptions -> Maybe String
commandExtraVars CommandOptions
options

command' :: CommandOptions
         -> ExprPair
         -> ExceptT ErrorTriplet IO AppData
command' :: CommandOptions -> ExprPair -> ExceptT ErrorTriplet IO AppData
command' CommandOptions
options (ExprPair ExprPairT a
exprT) = do
    -- Open files needed to fill in details in the template.
    vs    <- Maybe String -> ExceptT ErrorTriplet IO (Maybe [String])
parseVariablesFile Maybe String
varNameFile
    rs    <- parseRequirementsListFile handlersFile
    varDB <- openVarDBFilesWithDefault varDBFile

    specT <- maybe (return Nothing) (\String
e -> InputFile a -> Maybe (InputFile a)
forall a. a -> Maybe a
Just (InputFile a -> Maybe (InputFile a))
-> (Spec a -> InputFile a) -> Spec a -> Maybe (InputFile a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Spec a -> InputFile a
forall a. Spec a -> InputFile a
InputFileSpec (Spec a -> Maybe (InputFile a))
-> ExceptT ErrorTriplet IO (Spec a)
-> ExceptT ErrorTriplet IO (Maybe (InputFile a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ExceptT ErrorTriplet IO (Spec a)
readInputExpr' String
e) cExpr
    specF <- if null fpA
                  then return Nothing
                  else do
                    fpA' <- mapM readInputFile' fpA
                    let fpA'' = [InputFile a] -> [InputFile a]
forall a. [InputFile a] -> [InputFile a]
combineInputFiles [InputFile a]
fpA'
                    if length fpA'' > 1
                      then liftEither $ Left commandMultipleInputTypes
                      else pure $ Just $ head fpA''

    let spec = Maybe (InputFile a)
specT Maybe (InputFile a) -> Maybe (InputFile a) -> Maybe (InputFile a)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (InputFile a)
specF

    liftEither $ checkArguments spec vs rs

    copilotM <- sequenceA $ (\InputFile a
spec' -> InputFile a
-> Maybe String -> [String] -> ExceptT ErrorTriplet IO AppData
processSpec InputFile a
spec' Maybe String
cExpr [String]
fpA) <$> spec

    let varNames = [String] -> Maybe [String] -> [String]
forall a. a -> Maybe a -> a
fromMaybe (Maybe (InputFile a) -> [String]
forall {a}. Maybe (InputFile a) -> [String]
defaultVarNames Maybe (InputFile a)
spec) Maybe [String]
vs
        monitors = [(String, Maybe String)]
-> ([String] -> [(String, Maybe String)])
-> Maybe [String]
-> [(String, Maybe String)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe (InputFile a) -> [(String, Maybe String)]
forall {a}. Maybe (InputFile a) -> [(String, Maybe String)]
defaultMonitors Maybe (InputFile a)
spec) ((String -> (String, Maybe String))
-> [String] -> [(String, Maybe String)]
forall a b. (a -> b) -> [a] -> [b]
map (\String
x -> (String
x, Maybe String
forall a. Maybe a
Nothing))) Maybe [String]
rs

    let appData =
          [VarDecl]
-> [Monitor] -> Maybe AppData -> [Node] -> [VarDecl] -> AppData
AppData [VarDecl]
variables [Monitor]
monitors' Maybe AppData
copilotM [Node]
testingAdditionalApps [VarDecl]
testingVars

        variables = (String -> Maybe VarDecl) -> [String] -> [VarDecl]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (VariableDB -> String -> Maybe VarDecl
variableMap VariableDB
varDB) [String]
varNames
        monitors' = ((String, Maybe String) -> Maybe Monitor)
-> [(String, Maybe String)] -> [Monitor]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (VariableDB -> (String, Maybe String) -> Maybe Monitor
monitorMap VariableDB
varDB) [(String, Maybe String)]
monitors

        testingVars
          | [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
testingLimitedVars
          = [VarDecl]
variables
          | Bool
otherwise
          = (VarDecl -> Bool) -> [VarDecl] -> [VarDecl]
forall a. (a -> Bool) -> [a] -> [a]
filter (\VarDecl
x -> VarDecl -> String
varDeclName VarDecl
x String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
testingLimitedVars) [VarDecl]
variables

    return appData

  where

    cExpr :: Maybe String
cExpr          = CommandOptions -> Maybe String
commandConditionExpr CommandOptions
options
    fpA :: [String]
fpA            = CommandOptions -> [String]
commandInputFiles CommandOptions
options
    varNameFile :: Maybe String
varNameFile    = CommandOptions -> Maybe String
commandVariables CommandOptions
options
    varDBFile :: [String]
varDBFile      = Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList (Maybe String -> [String]) -> Maybe String -> [String]
forall a b. (a -> b) -> a -> b
$ CommandOptions -> Maybe String
commandVariableDB CommandOptions
options
    handlersFile :: Maybe String
handlersFile   = CommandOptions -> Maybe String
commandHandlers CommandOptions
options
    formatName :: String
formatName     = CommandOptions -> String
commandFormat CommandOptions
options
    propFormatName :: String
propFormatName = CommandOptions -> String
commandPropFormat CommandOptions
options
    propVia :: Maybe String
propVia        = CommandOptions -> Maybe String
commandPropVia CommandOptions
options

    readInputExpr' :: String -> ExceptT ErrorTriplet IO (Spec a)
readInputExpr' String
e =
      String
-> String
-> Maybe String
-> ExprPairT a
-> ExceptT ErrorTriplet IO (Spec a)
forall a.
String
-> String
-> Maybe String
-> ExprPairT a
-> ExceptT ErrorTriplet IO (Spec a)
readInputExpr String
e String
propFormatName Maybe String
propVia ExprPairT a
exprT

    readInputFile' :: String -> ExceptT ErrorTriplet IO (InputFile a)
readInputFile' String
f =
      String
-> String
-> String
-> Maybe String
-> ExprPairT a
-> ExceptT ErrorTriplet IO (InputFile a)
forall a.
String
-> String
-> String
-> Maybe String
-> ExprPairT a
-> ExceptT ErrorTriplet IO (InputFile a)
parseInputFile String
f String
formatName String
propFormatName Maybe String
propVia ExprPairT a
exprT

    processSpec :: InputFile a
-> Maybe String -> [String] -> ExceptT ErrorTriplet IO AppData
processSpec InputFile a
spec' Maybe String
expr' [String]
fp' =
      Maybe String
-> [String]
-> String
-> [(String, String)]
-> ExprPairT a
-> InputFile a
-> ExceptT ErrorTriplet IO AppData
forall a.
Maybe String
-> [String]
-> String
-> [(String, String)]
-> ExprPairT a
-> InputFile a
-> ExceptT ErrorTriplet IO AppData
Command.Standalone.commandLogic Maybe String
expr' [String]
fp' String
"copilot" [] ExprPairT a
exprT InputFile a
spec'

    defaultVarNames :: Maybe (InputFile a) -> [String]
defaultVarNames Maybe (InputFile a)
spec = case Maybe (InputFile a)
spec of
      Just (InputFileSpec Spec a
spec') -> Maybe (Spec a) -> [String]
forall a. Maybe (Spec a) -> [String]
specExtractExternalVariables (Spec a -> Maybe (Spec a)
forall a. a -> Maybe a
Just Spec a
spec')
      Just (InputFileDiagram Diagram
_)  -> []
      Maybe (InputFile a)
Nothing                    -> Maybe (Spec (ZonkAny 1)) -> [String]
forall a. Maybe (Spec a) -> [String]
specExtractExternalVariables Maybe (Spec (ZonkAny 1))
forall a. Maybe a
Nothing


    defaultMonitors :: Maybe (InputFile a) -> [(String, Maybe String)]
defaultMonitors Maybe (InputFile a)
spec = case Maybe (InputFile a)
spec of
      Just (InputFileSpec Spec a
spec') -> Maybe (Spec a) -> [(String, Maybe String)]
forall a. Maybe (Spec a) -> [(String, Maybe String)]
specExtractHandlers (Spec a -> Maybe (Spec a)
forall a. a -> Maybe a
Just Spec a
spec')
      Just (InputFileDiagram Diagram
_)  -> [ (String
"handler", String -> Maybe String
forall a. a -> Maybe a
Just String
"uint8_t" ) ]
      Maybe (InputFile a)
Nothing                    -> Maybe (Spec (ZonkAny 0)) -> [(String, Maybe String)]
forall a. Maybe (Spec a) -> [(String, Maybe String)]
specExtractHandlers Maybe (Spec (ZonkAny 0))
forall a. Maybe a
Nothing

    testingAdditionalApps :: [Node]
testingAdditionalApps = CommandOptions -> [Node]
commandTestingApps CommandOptions
options
    testingLimitedVars :: [String]
testingLimitedVars    = CommandOptions -> [String]
commandTestingVars CommandOptions
options

-- ** Argument processing

-- | Options used to customize the conversion of specifications to ROS
-- applications.
data CommandOptions = CommandOptions
  { CommandOptions -> Maybe String
commandConditionExpr :: Maybe String   -- ^ Trigger condition.
  , CommandOptions -> [String]
commandInputFiles  :: [FilePath]     -- ^ Input specification files.
  , CommandOptions -> String
commandTargetDir   :: FilePath       -- ^ Target directory where the
                                         -- application should be created.
  , CommandOptions -> Maybe String
commandTemplateDir :: Maybe FilePath -- ^ Directory where the template is
                                         -- to be found.
  , CommandOptions -> Maybe String
commandVariables   :: Maybe FilePath -- ^ File containing a list of
                                         -- variables to make available to
                                         -- Copilot.
  , CommandOptions -> Maybe String
commandVariableDB  :: Maybe FilePath -- ^ File containing a list of known
                                         -- variables with their types and the
                                         -- message IDs they can be obtained
                                         -- from.
  , CommandOptions -> Maybe String
commandHandlers    :: Maybe FilePath -- ^ File containing a list of
                                         -- handlers used in the Copilot
                                         -- specification. The handlers are
                                         -- assumed to receive no arguments.
  , CommandOptions -> String
commandFormat      :: String         -- ^ Format of the input file.
  , CommandOptions -> String
commandPropFormat  :: String         -- ^ Format used for input properties.
  , CommandOptions -> Maybe String
commandPropVia     :: Maybe String   -- ^ Use external command to
                                         -- pre-process system properties.
  , CommandOptions -> Maybe String
commandExtraVars   :: Maybe FilePath -- ^ File containing additional
                                         -- variables to make available to the
                                         -- template.
  , CommandOptions -> [Node]
commandTestingApps :: [Node]         -- ^ Additional applications to turn
                                         -- on during testing.
  , CommandOptions -> [String]
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 :: VariableDB -> String -> Maybe VarDecl
variableMap VariableDB
varDB String
varName = do
  inputDef <- VariableDB -> String -> Maybe InputDef
findInput VariableDB
varDB String
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' = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe
                   (TopicDef -> String
topicType TopicDef
topicDef)
                   (TypeDef -> String
typeFromType (TypeDef -> String) -> Maybe TypeDef -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VariableDB -> String -> String -> String -> Maybe TypeDef
findType VariableDB
varDB String
varName String
"ros/message" String
"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 :: VariableDB -> (String, Maybe String) -> Maybe Monitor
monitorMap VariableDB
varDB (String
monitorName, Maybe String
Nothing) =
  Monitor -> Maybe Monitor
forall a. a -> Maybe a
Just (Monitor -> Maybe Monitor) -> Monitor -> Maybe Monitor
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> Maybe String -> Monitor
Monitor String
monitorName Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
monitorMap VariableDB
varDB (String
monitorName, Just String
ty) = do
  let ty1 :: String
ty1 = String -> (TypeDef -> String) -> Maybe TypeDef -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
ty TypeDef -> String
typeFromType (Maybe TypeDef -> String) -> Maybe TypeDef -> String
forall a b. (a -> b) -> a -> b
$ VariableDB -> String -> String -> String -> Maybe TypeDef
findTypeByType VariableDB
varDB String
"ros/variable" String
"C" String
ty
  ty2 <- TypeDef -> String
typeFromType (TypeDef -> String) -> Maybe TypeDef -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VariableDB -> String -> String -> String -> Maybe TypeDef
findTypeByType VariableDB
varDB String
"ros/message" String
"C" String
ty
  return $ Monitor monitorName (Just ty1) (Just ty2)

-- | The declaration of a variable in C, with a given type and name.
data VarDecl = VarDecl
    { VarDecl -> String
varDeclName    :: String
    , VarDecl -> String
varDeclType    :: String
    , VarDecl -> String
varDeclId      :: String
    , VarDecl -> String
varDeclMsgType :: String
    , VarDecl -> String
varDeclRandom  :: String
    }
  deriving (forall x. VarDecl -> Rep VarDecl x)
-> (forall x. Rep VarDecl x -> VarDecl) -> Generic VarDecl
forall x. Rep VarDecl x -> VarDecl
forall x. VarDecl -> Rep VarDecl x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. VarDecl -> Rep VarDecl x
from :: forall x. VarDecl -> Rep VarDecl x
$cto :: forall x. Rep VarDecl x -> VarDecl
to :: forall x. Rep VarDecl x -> VarDecl
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
    { Monitor -> String
monitorName    :: String
    , Monitor -> Maybe String
monitorType    :: Maybe String
    , Monitor -> Maybe String
monitorMsgType :: Maybe String
    }
  deriving (forall x. Monitor -> Rep Monitor x)
-> (forall x. Rep Monitor x -> Monitor) -> Generic Monitor
forall x. Rep Monitor x -> Monitor
forall x. Monitor -> Rep Monitor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Monitor -> Rep Monitor x
from :: forall x. Monitor -> Rep Monitor x
$cto :: forall x. Rep Monitor x -> Monitor
to :: forall x. Rep Monitor x -> Monitor
Generic

instance ToJSON Monitor

-- | A package-qualified ROS 2 node name.
data Node = Node
    { Node -> String
nodePackage :: String
    , Node -> String
nodeName    :: String
    }
  deriving (forall x. Node -> Rep Node x)
-> (forall x. Rep Node x -> Node) -> Generic Node
forall x. Rep Node x -> Node
forall x. Node -> Rep Node x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Node -> Rep Node x
from :: forall x. Node -> Rep Node x
$cto :: forall x. Rep Node x -> Node
to :: forall x. Rep Node x -> Node
Generic

instance ToJSON Node

-- | Data that may be relevant to generate a ROS application.
data AppData = AppData
  { AppData -> [VarDecl]
variables        :: [VarDecl]
  , AppData -> [Monitor]
monitors         :: [Monitor]
  , AppData -> Maybe AppData
copilot          :: Maybe Command.Standalone.AppData
  , AppData -> [Node]
testingApps      :: [Node]
  , AppData -> [VarDecl]
testingVariables :: [VarDecl]
  }
  deriving ((forall x. AppData -> Rep AppData x)
-> (forall x. Rep AppData x -> AppData) -> Generic AppData
forall x. Rep AppData x -> AppData
forall x. AppData -> Rep AppData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AppData -> Rep AppData x
from :: forall x. AppData -> Rep AppData x
$cto :: forall x. Rep AppData x -> AppData
to :: forall x. Rep AppData x -> AppData
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 :: String -> String
randomBaseType String
ty = case String
ty of
  String
"bool"     -> String
"randomBool"
  String
"uint8_t"  -> String
"randomInt"
  String
"uint16_t" -> String
"randomInt"
  String
"uint32_t" -> String
"randomInt"
  String
"uint64_t" -> String
"randomInt"
  String
"int8_t"   -> String
"randomInt"
  String
"int16_t"  -> String
"randomInt"
  String
"int32_t"  -> String
"randomInt"
  String
"int64_t"  -> String
"randomInt"
  String
"float"    -> String
"randomFloat"
  String
"double"   -> String
"randomFloat"
  String
def        -> String
def

-- | Error message associated to having multiple input files of incompatible
-- types.
commandMultipleInputTypes :: ErrorTriplet
commandMultipleInputTypes :: ErrorTriplet
commandMultipleInputTypes =
    ErrorCode -> String -> Location -> ErrorTriplet
ErrorTriplet ErrorCode
ecMultipleInputTypes String
msg Location
LocationNothing
  where
    msg :: String
msg =
      String
"Too many inputs provided. Provide one diagram or multiple specs."

-- | Error: multiple inputs of incompatible types.
ecMultipleInputTypes :: ErrorCode
ecMultipleInputTypes :: ErrorCode
ecMultipleInputTypes = ErrorCode
1