{-# 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)

-- | 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 -> Spec a -> Maybe (Spec a)
forall a. a -> Maybe a
Just (Spec a -> Maybe (Spec a))
-> ExceptT ErrorTriplet IO (Spec a)
-> ExceptT ErrorTriplet IO (Maybe (Spec a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ExceptT ErrorTriplet IO (Spec a)
parseInputExpr' String
e) cExpr
    specF <- maybe (return Nothing) (\String
f -> Spec a -> Maybe (Spec a)
forall a. a -> Maybe a
Just (Spec a -> Maybe (Spec a))
-> ExceptT ErrorTriplet IO (Spec a)
-> ExceptT ErrorTriplet IO (Maybe (Spec a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ExceptT ErrorTriplet IO (Spec a)
parseInputFile' String
f) fp

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

    liftEither $ checkArguments spec vs rs

    copilotM <- sequenceA $ (\Spec a
spec' -> Spec a
-> Maybe String -> Maybe String -> ExceptT ErrorTriplet IO AppData
processSpec Spec a
spec' Maybe String
fp Maybe String
cExpr) <$> spec

    let varNames = [String] -> Maybe [String] -> [String]
forall a. a -> Maybe a -> a
fromMaybe (Maybe (Spec a) -> [String]
forall a. Maybe (Spec a) -> [String]
specExtractExternalVariables Maybe (Spec 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 (Spec a) -> [(String, Maybe String)]
forall a. Maybe (Spec a) -> [(String, Maybe String)]
specExtractHandlers Maybe (Spec 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
    fp :: Maybe String
fp             = CommandOptions -> Maybe String
commandInputFile 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

    parseInputExpr' :: String -> ExceptT ErrorTriplet IO (Spec a)
parseInputExpr' 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)
parseInputExpr String
e String
propFormatName Maybe String
propVia ExprPairT a
exprT

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

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

    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 -> Maybe String
commandInputFile   :: Maybe FilePath -- ^ Input specification file.
  , 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