{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Command.ROSApp
( command
, CommandOptions(..)
, 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
FilePath
templateDir <- Maybe FilePath -> FilePath -> ExceptT ErrorTriplet IO FilePath
forall e. Maybe FilePath -> FilePath -> ExceptT e IO FilePath
locateTemplateDir Maybe FilePath
mTemplateDir FilePath
"ros"
Value
templateVars <- Maybe FilePath -> ExceptT ErrorTriplet IO Value
parseTemplateVarsFile Maybe FilePath
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
$
FilePath -> Value -> FilePath -> IO ()
copyTemplate FilePath
templateDir Value
subst FilePath
targetDir
where
targetDir :: FilePath
targetDir = CommandOptions -> FilePath
commandTargetDir CommandOptions
options
mTemplateDir :: Maybe FilePath
mTemplateDir = CommandOptions -> Maybe FilePath
commandTemplateDir CommandOptions
options
functions :: ExprPair
functions = FilePath -> ExprPair
exprPair (CommandOptions -> FilePath
commandPropFormat CommandOptions
options)
templateVarsF :: Maybe FilePath
templateVarsF = CommandOptions -> Maybe FilePath
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 [FilePath]
vs <- Maybe FilePath -> ExceptT ErrorTriplet IO (Maybe [FilePath])
parseVariablesFile Maybe FilePath
varNameFile
Maybe [FilePath]
rs <- Maybe FilePath -> ExceptT ErrorTriplet IO (Maybe [FilePath])
parseRequirementsListFile Maybe FilePath
handlersFile
VariableDB
varDB <- [FilePath] -> ExceptT ErrorTriplet IO VariableDB
openVarDBFilesWithDefault [FilePath]
varDBFile
Maybe (Spec a)
spec <- ExceptT ErrorTriplet IO (Maybe (Spec a))
-> (FilePath -> ExceptT ErrorTriplet IO (Maybe (Spec a)))
-> Maybe FilePath
-> 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) (\FilePath
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
<$> FilePath -> ExceptT ErrorTriplet IO (Spec a)
parseInputFile' FilePath
f) Maybe FilePath
fp
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 [FilePath] -> Maybe [FilePath] -> Either ErrorTriplet ()
forall a.
Maybe (Spec a)
-> Maybe [FilePath] -> Maybe [FilePath] -> Either ErrorTriplet ()
checkArguments Maybe (Spec a)
spec Maybe [FilePath]
vs Maybe [FilePath]
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 -> FilePath -> ExceptT ErrorTriplet IO AppData)
-> Maybe (Spec a)
-> Maybe FilePath
-> Maybe (ExceptT ErrorTriplet IO AppData)
forall a b c. (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Spec a -> FilePath -> ExceptT ErrorTriplet IO AppData
processSpec Maybe (Spec a)
spec Maybe FilePath
fp
let varNames :: [FilePath]
varNames = [FilePath] -> Maybe [FilePath] -> [FilePath]
forall a. a -> Maybe a -> a
fromMaybe (Maybe (Spec a) -> [FilePath]
forall a. Maybe (Spec a) -> [FilePath]
specExtractExternalVariables Maybe (Spec a)
spec) Maybe [FilePath]
vs
monitors :: [(FilePath, Maybe FilePath)]
monitors = [(FilePath, Maybe FilePath)]
-> ([FilePath] -> [(FilePath, Maybe FilePath)])
-> Maybe [FilePath]
-> [(FilePath, Maybe FilePath)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(Maybe (Spec a) -> [(FilePath, Maybe FilePath)]
forall a. Maybe (Spec a) -> [(FilePath, Maybe FilePath)]
specExtractHandlers Maybe (Spec a)
spec)
((FilePath -> (FilePath, Maybe FilePath))
-> [FilePath] -> [(FilePath, Maybe FilePath)]
forall a b. (a -> b) -> [a] -> [b]
map (\FilePath
x -> (FilePath
x, Maybe FilePath
forall a. Maybe a
Nothing)))
Maybe [FilePath]
rs
let appData :: AppData
appData = [VarDecl] -> [Monitor] -> Maybe AppData -> AppData
AppData [VarDecl]
variables [Monitor]
monitors' Maybe AppData
copilotM
variables :: [VarDecl]
variables = (FilePath -> Maybe VarDecl) -> [FilePath] -> [VarDecl]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (VariableDB -> FilePath -> Maybe VarDecl
variableMap VariableDB
varDB) [FilePath]
varNames
monitors' :: [Monitor]
monitors' = ((FilePath, Maybe FilePath) -> Maybe Monitor)
-> [(FilePath, Maybe FilePath)] -> [Monitor]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (VariableDB -> (FilePath, Maybe FilePath) -> Maybe Monitor
monitorMap VariableDB
varDB) [(FilePath, Maybe FilePath)]
monitors
AppData -> ExceptT ErrorTriplet IO AppData
forall a. a -> ExceptT ErrorTriplet IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AppData
appData
where
fp :: Maybe FilePath
fp = CommandOptions -> Maybe FilePath
commandInputFile CommandOptions
options
varNameFile :: Maybe FilePath
varNameFile = CommandOptions -> Maybe FilePath
commandVariables CommandOptions
options
varDBFile :: [FilePath]
varDBFile = Maybe FilePath -> [FilePath]
forall a. Maybe a -> [a]
maybeToList (Maybe FilePath -> [FilePath]) -> Maybe FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ CommandOptions -> Maybe FilePath
commandVariableDB CommandOptions
options
handlersFile :: Maybe FilePath
handlersFile = CommandOptions -> Maybe FilePath
commandHandlers CommandOptions
options
formatName :: FilePath
formatName = CommandOptions -> FilePath
commandFormat CommandOptions
options
propFormatName :: FilePath
propFormatName = CommandOptions -> FilePath
commandPropFormat CommandOptions
options
propVia :: Maybe FilePath
propVia = CommandOptions -> Maybe FilePath
commandPropVia CommandOptions
options
parseInputFile' :: FilePath -> ExceptT ErrorTriplet IO (Spec a)
parseInputFile' FilePath
f =
FilePath
-> FilePath
-> FilePath
-> Maybe FilePath
-> ExprPairT a
-> ExceptT ErrorTriplet IO (Spec a)
forall a.
FilePath
-> FilePath
-> FilePath
-> Maybe FilePath
-> ExprPairT a
-> ExceptT ErrorTriplet IO (Spec a)
parseInputFile FilePath
f FilePath
formatName FilePath
propFormatName Maybe FilePath
propVia ExprPairT a
exprT
processSpec :: Spec a -> FilePath -> ExceptT ErrorTriplet IO AppData
processSpec Spec a
spec' FilePath
fp' =
FilePath
-> FilePath
-> [(FilePath, FilePath)]
-> ExprPairT a
-> Spec a
-> ExceptT ErrorTriplet IO AppData
forall a.
FilePath
-> FilePath
-> [(FilePath, FilePath)]
-> ExprPairT a
-> Spec a
-> ExceptT ErrorTriplet IO AppData
Command.Standalone.commandLogic FilePath
fp' FilePath
"copilot" [] ExprPairT a
exprT Spec a
spec'
data CommandOptions = CommandOptions
{ CommandOptions -> Maybe FilePath
commandInputFile :: Maybe FilePath
, CommandOptions -> FilePath
commandTargetDir :: FilePath
, CommandOptions -> Maybe FilePath
commandTemplateDir :: Maybe FilePath
, CommandOptions -> Maybe FilePath
commandVariables :: Maybe FilePath
, CommandOptions -> Maybe FilePath
commandVariableDB :: Maybe FilePath
, CommandOptions -> Maybe FilePath
commandHandlers :: Maybe FilePath
, CommandOptions -> FilePath
commandFormat :: String
, CommandOptions -> FilePath
commandPropFormat :: String
, CommandOptions -> Maybe FilePath
commandPropVia :: Maybe String
, CommandOptions -> Maybe FilePath
commandExtraVars :: Maybe FilePath
}
variableMap :: VariableDB
-> String
-> Maybe VarDecl
variableMap :: VariableDB -> FilePath -> Maybe VarDecl
variableMap VariableDB
varDB FilePath
varName = do
InputDef
inputDef <- VariableDB -> FilePath -> Maybe InputDef
findInput VariableDB
varDB FilePath
varName
FilePath
mid <- Connection -> FilePath
connectionTopic (Connection -> FilePath) -> Maybe Connection -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InputDef -> FilePath -> Maybe Connection
findConnection InputDef
inputDef FilePath
"ros/message"
TopicDef
topicDef <- VariableDB -> FilePath -> FilePath -> Maybe TopicDef
findTopic VariableDB
varDB FilePath
"ros/message" FilePath
mid
FilePath
typeVar' <- Maybe FilePath
-> (TypeDef -> Maybe FilePath) -> Maybe TypeDef -> Maybe FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(InputDef -> Maybe FilePath
inputType InputDef
inputDef)
(FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath)
-> (TypeDef -> FilePath) -> TypeDef -> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeDef -> FilePath
typeToType)
(VariableDB -> FilePath -> FilePath -> FilePath -> Maybe TypeDef
findType VariableDB
varDB FilePath
varName FilePath
"ros/variable" FilePath
"C")
let typeMsg' :: FilePath
typeMsg' = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe
(TopicDef -> FilePath
topicType TopicDef
topicDef)
(TypeDef -> FilePath
typeFromType (TypeDef -> FilePath) -> Maybe TypeDef -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VariableDB -> FilePath -> FilePath -> FilePath -> Maybe TypeDef
findType VariableDB
varDB FilePath
varName FilePath
"ros/message" FilePath
"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
$ FilePath -> FilePath -> FilePath -> FilePath -> VarDecl
VarDecl FilePath
varName FilePath
typeVar' FilePath
mid FilePath
typeMsg'
monitorMap :: VariableDB
-> (String, Maybe String)
-> Maybe Monitor
monitorMap :: VariableDB -> (FilePath, Maybe FilePath) -> Maybe Monitor
monitorMap VariableDB
varDB (FilePath
monitorName, Maybe FilePath
Nothing) =
Monitor -> Maybe Monitor
forall a. a -> Maybe a
Just (Monitor -> Maybe Monitor) -> Monitor -> Maybe Monitor
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath -> Maybe FilePath -> Monitor
Monitor FilePath
monitorName Maybe FilePath
forall a. Maybe a
Nothing Maybe FilePath
forall a. Maybe a
Nothing
monitorMap VariableDB
varDB (FilePath
monitorName, Just FilePath
ty) = do
let ty1 :: FilePath
ty1 = FilePath -> (TypeDef -> FilePath) -> Maybe TypeDef -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
ty TypeDef -> FilePath
typeFromType (Maybe TypeDef -> FilePath) -> Maybe TypeDef -> FilePath
forall a b. (a -> b) -> a -> b
$ VariableDB -> FilePath -> FilePath -> FilePath -> Maybe TypeDef
findTypeByType VariableDB
varDB FilePath
"ros/variable" FilePath
"C" FilePath
ty
FilePath
ty2 <- TypeDef -> FilePath
typeFromType (TypeDef -> FilePath) -> Maybe TypeDef -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VariableDB -> FilePath -> FilePath -> FilePath -> Maybe TypeDef
findTypeByType VariableDB
varDB FilePath
"ros/message" FilePath
"C" FilePath
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
$ FilePath -> Maybe FilePath -> Maybe FilePath -> Monitor
Monitor FilePath
monitorName (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
ty1) (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
ty2)
data VarDecl = VarDecl
{ VarDecl -> FilePath
varDeclName :: String
, VarDecl -> FilePath
varDeclType :: String
, VarDecl -> FilePath
varDeclId :: String
, VarDecl -> FilePath
varDeclMsgType :: 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 -> FilePath
monitorName :: String
, Monitor -> Maybe FilePath
monitorType :: Maybe String
, Monitor -> Maybe FilePath
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 AppData = AppData
{ AppData -> [VarDecl]
variables :: [VarDecl]
, AppData -> [Monitor]
monitors :: [Monitor]
, AppData -> Maybe AppData
copilot :: Maybe Command.Standalone.AppData
}
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