{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Command.ROSApp
( command
, CommandOptions(..)
, Node(Node)
, ErrorCode
)
where
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)
import System.Directory.Extra (copyTemplate)
import qualified Command.Standalone
import Command.Result (Result (..))
import Command.Common
import Command.Errors (ErrorCode, ErrorTriplet (..))
import Command.VariableDB (Connection (..), InputDef (..), TopicDef (..),
TypeDef (..), VariableDB, findConnection, findInput,
findTopic, findType, findTypeByType)
command :: CommandOptions
-> 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
String
templateDir <- Maybe String -> String -> ExceptT ErrorTriplet IO String
forall e. Maybe String -> String -> ExceptT e IO String
locateTemplateDir Maybe String
mTemplateDir String
"ros"
Value
templateVars <- Maybe String -> ExceptT ErrorTriplet IO Value
parseTemplateVarsFile Maybe String
templateVarsF
AppData
appData <- CommandOptions -> ExprPair -> ExceptT ErrorTriplet IO AppData
command' CommandOptions
options ExprPair
functions
let subst :: Value
subst = Value -> Value -> Value
mergeObjects (AppData -> Value
forall a. ToJSON a => a -> Value
toJSON AppData
appData) Value
templateVars
IO (Either ErrorTriplet ()) -> ExceptT ErrorTriplet IO ()
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either ErrorTriplet ()) -> ExceptT ErrorTriplet IO ())
-> IO (Either ErrorTriplet ()) -> ExceptT ErrorTriplet IO ()
forall a b. (a -> b) -> a -> b
$ (Either SomeException () -> Either ErrorTriplet ())
-> IO (Either SomeException ()) -> IO (Either ErrorTriplet ())
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ErrorTriplet -> Either SomeException () -> Either ErrorTriplet ()
forall c b. c -> Either SomeException b -> Either c b
makeLeftE ErrorTriplet
cannotCopyTemplate) (IO (Either SomeException ()) -> IO (Either ErrorTriplet ()))
-> IO (Either SomeException ()) -> IO (Either ErrorTriplet ())
forall a b. (a -> b) -> a -> b
$ IO () -> IO (Either SomeException ())
forall e a. Exception e => IO a -> IO (Either e a)
E.try (IO () -> IO (Either SomeException ()))
-> IO () -> IO (Either SomeException ())
forall a b. (a -> b) -> a -> b
$
String -> Value -> String -> IO ()
copyTemplate String
templateDir Value
subst String
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
Maybe [String]
vs <- Maybe String -> ExceptT ErrorTriplet IO (Maybe [String])
parseVariablesFile Maybe String
varNameFile
Maybe [String]
rs <- Maybe String -> ExceptT ErrorTriplet IO (Maybe [String])
parseRequirementsListFile Maybe String
handlersFile
VariableDB
varDB <- [String] -> ExceptT ErrorTriplet IO VariableDB
openVarDBFilesWithDefault [String]
varDBFile
Maybe (Spec a)
specT <- ExceptT ErrorTriplet IO (Maybe (Spec a))
-> (String -> ExceptT ErrorTriplet IO (Maybe (Spec a)))
-> Maybe String
-> ExceptT ErrorTriplet IO (Maybe (Spec a))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe (Spec a) -> ExceptT ErrorTriplet IO (Maybe (Spec a))
forall a. a -> ExceptT ErrorTriplet IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Spec a)
forall a. Maybe a
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) Maybe String
cExpr
Maybe (Spec a)
specF <- ExceptT ErrorTriplet IO (Maybe (Spec a))
-> (String -> ExceptT ErrorTriplet IO (Maybe (Spec a)))
-> Maybe String
-> ExceptT ErrorTriplet IO (Maybe (Spec a))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe (Spec a) -> ExceptT ErrorTriplet IO (Maybe (Spec a))
forall a. a -> ExceptT ErrorTriplet IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Spec a)
forall a. Maybe a
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) Maybe String
fp
let spec :: Maybe (Spec a)
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
Either ErrorTriplet () -> ExceptT ErrorTriplet IO ()
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either ErrorTriplet () -> ExceptT ErrorTriplet IO ())
-> Either ErrorTriplet () -> ExceptT ErrorTriplet IO ()
forall a b. (a -> b) -> a -> b
$ Maybe (Spec a)
-> Maybe [String] -> Maybe [String] -> Either ErrorTriplet ()
forall a.
Maybe (Spec a)
-> Maybe [String] -> Maybe [String] -> Either ErrorTriplet ()
checkArguments Maybe (Spec a)
spec Maybe [String]
vs Maybe [String]
rs
Maybe AppData
copilotM <- Maybe (ExceptT ErrorTriplet IO AppData)
-> ExceptT ErrorTriplet IO (Maybe AppData)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => Maybe (f a) -> f (Maybe a)
sequenceA (Maybe (ExceptT ErrorTriplet IO AppData)
-> ExceptT ErrorTriplet IO (Maybe AppData))
-> Maybe (ExceptT ErrorTriplet IO AppData)
-> ExceptT ErrorTriplet IO (Maybe AppData)
forall a b. (a -> b) -> a -> b
$ (\Spec a
spec' -> Spec a
-> Maybe String -> Maybe String -> ExceptT ErrorTriplet IO AppData
processSpec Spec a
spec' Maybe String
fp Maybe String
cExpr) (Spec a -> ExceptT ErrorTriplet IO AppData)
-> Maybe (Spec a) -> Maybe (ExceptT ErrorTriplet IO AppData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Spec a)
spec
let varNames :: [String]
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)]
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 :: AppData
appData =
[VarDecl]
-> [Monitor] -> Maybe AppData -> [Node] -> [VarDecl] -> AppData
AppData [VarDecl]
variables [Monitor]
monitors' Maybe AppData
copilotM [Node]
testingAdditionalApps [VarDecl]
testingVars
variables :: [VarDecl]
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' :: [Monitor]
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 :: [VarDecl]
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
AppData -> ExceptT ErrorTriplet IO AppData
forall a. a -> ExceptT ErrorTriplet IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AppData
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
data CommandOptions = CommandOptions
{ CommandOptions -> Maybe String
commandConditionExpr :: Maybe String
, CommandOptions -> Maybe String
commandInputFile :: Maybe FilePath
, CommandOptions -> String
commandTargetDir :: FilePath
, CommandOptions -> Maybe String
commandTemplateDir :: Maybe FilePath
, CommandOptions -> Maybe String
commandVariables :: Maybe FilePath
, CommandOptions -> Maybe String
commandVariableDB :: Maybe FilePath
, CommandOptions -> Maybe String
commandHandlers :: Maybe FilePath
, CommandOptions -> String
commandFormat :: String
, CommandOptions -> String
commandPropFormat :: String
, CommandOptions -> Maybe String
commandPropVia :: Maybe String
, CommandOptions -> Maybe String
commandExtraVars :: Maybe FilePath
, CommandOptions -> [Node]
commandTestingApps :: [Node]
, CommandOptions -> [String]
commandTestingVars :: [String]
}
variableMap :: VariableDB
-> String
-> Maybe VarDecl
variableMap :: VariableDB -> String -> Maybe VarDecl
variableMap VariableDB
varDB String
varName = do
InputDef
inputDef <- VariableDB -> String -> Maybe InputDef
findInput VariableDB
varDB String
varName
String
mid <- Connection -> String
connectionTopic (Connection -> String) -> Maybe Connection -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InputDef -> String -> Maybe Connection
findConnection InputDef
inputDef String
"ros/message"
TopicDef
topicDef <- VariableDB -> String -> String -> Maybe TopicDef
findTopic VariableDB
varDB String
"ros/message" String
mid
String
typeVar' <- Maybe String
-> (TypeDef -> Maybe String) -> Maybe TypeDef -> Maybe String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(InputDef -> Maybe String
inputType InputDef
inputDef)
(String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> (TypeDef -> String) -> TypeDef -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeDef -> String
typeToType)
(VariableDB -> String -> String -> String -> Maybe TypeDef
findType VariableDB
varDB String
varName String
"ros/variable" String
"C")
let typeMsg' :: String
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")
VarDecl -> Maybe VarDecl
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (VarDecl -> Maybe VarDecl) -> VarDecl -> Maybe VarDecl
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String -> String -> VarDecl
VarDecl String
varName String
typeVar' String
mid String
typeMsg' (String -> String
randomBaseType String
typeVar')
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
String
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
Monitor -> Maybe Monitor
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Monitor -> Maybe Monitor) -> Monitor -> Maybe Monitor
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> Maybe String -> Monitor
Monitor String
monitorName (String -> Maybe String
forall a. a -> Maybe a
Just String
ty1) (String -> Maybe String
forall a. a -> Maybe a
Just String
ty2)
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
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
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 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
randomBaseType :: String
-> 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