{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Command.CFSApp
( 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 qualified Command.Standalone
import Command.Result ( Result (..) )
import Data.List.Extra ( stripSuffix )
import Data.String.Extra ( pascalCase )
import System.Directory.Extra ( copyTemplate )
import Command.Common
import Command.Errors (ErrorCode, ErrorTriplet (..))
import Command.VariableDB (Connection (..), 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
"copilot-cfs"
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 = VariableDB -> [FilePath] -> [Trigger] -> Maybe AppData -> AppData
commandLogic VariableDB
varDB [FilePath]
varNames [Trigger]
monitors' Maybe AppData
copilotM
monitors' :: [Trigger]
monitors' = ((FilePath, Maybe FilePath) -> Maybe Trigger)
-> [(FilePath, Maybe FilePath)] -> [Trigger]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (VariableDB -> (FilePath, Maybe FilePath) -> Maybe Trigger
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'
commandLogic :: VariableDB
-> [String]
-> [Trigger]
-> Maybe Command.Standalone.AppData
-> AppData
commandLogic :: VariableDB -> [FilePath] -> [Trigger] -> Maybe AppData -> AppData
commandLogic VariableDB
varDB [FilePath]
varNames [Trigger]
handlers Maybe AppData
copilotM =
[VarDecl]
-> [FilePath]
-> [MsgInfo]
-> [MsgData]
-> [Trigger]
-> Maybe AppData
-> AppData
AppData [VarDecl]
vars [FilePath]
ids [MsgInfo]
infos [MsgData]
datas [Trigger]
handlers Maybe AppData
copilotM
where
([VarDecl]
vars, [FilePath]
ids, [MsgInfo]
infos, [MsgData]
datas) = (FilePath
-> ([VarDecl], [FilePath], [MsgInfo], [MsgData])
-> ([VarDecl], [FilePath], [MsgInfo], [MsgData]))
-> ([VarDecl], [FilePath], [MsgInfo], [MsgData])
-> [FilePath]
-> ([VarDecl], [FilePath], [MsgInfo], [MsgData])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr FilePath
-> ([VarDecl], [FilePath], [MsgInfo], [MsgData])
-> ([VarDecl], [FilePath], [MsgInfo], [MsgData])
f ([], [], [], []) [FilePath]
varNames
f :: FilePath
-> ([VarDecl], [FilePath], [MsgInfo], [MsgData])
-> ([VarDecl], [FilePath], [MsgInfo], [MsgData])
f FilePath
n o :: ([VarDecl], [FilePath], [MsgInfo], [MsgData])
o@([VarDecl]
oVars, [FilePath]
oIds, [MsgInfo]
oInfos, [MsgData]
oDatas) =
case VariableDB
-> FilePath -> Maybe (VarDecl, FilePath, MsgInfo, MsgData)
variableMap VariableDB
varDB FilePath
n of
Maybe (VarDecl, FilePath, MsgInfo, MsgData)
Nothing -> ([VarDecl], [FilePath], [MsgInfo], [MsgData])
o
Just (VarDecl
vars, FilePath
ids, MsgInfo
infos, MsgData
datas) ->
(VarDecl
vars VarDecl -> [VarDecl] -> [VarDecl]
forall a. a -> [a] -> [a]
: [VarDecl]
oVars, FilePath
ids FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
oIds, MsgInfo
infos MsgInfo -> [MsgInfo] -> [MsgInfo]
forall a. a -> [a] -> [a]
: [MsgInfo]
oInfos, MsgData
datas MsgData -> [MsgData] -> [MsgData]
forall a. a -> [a] -> [a]
: [MsgData]
oDatas)
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, MsgInfoId, MsgInfo, MsgData)
variableMap :: VariableDB
-> FilePath -> Maybe (VarDecl, FilePath, MsgInfo, MsgData)
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
"cfs"
TopicDef
topicDef <- VariableDB -> FilePath -> FilePath -> Maybe TopicDef
findTopic VariableDB
varDB FilePath
"cfs" FilePath
mid
let typeVar' :: FilePath
typeVar' = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe
(TopicDef -> FilePath
topicType TopicDef
topicDef)
(TypeDef -> FilePath
typeToType (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
"cfs" FilePath
"C")
let mn :: FilePath
mn = FilePath -> FilePath
pascalCase (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath
stripSuffix FilePath
"_MID" FilePath
mid
(VarDecl, FilePath, MsgInfo, MsgData)
-> Maybe (VarDecl, FilePath, MsgInfo, MsgData)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ( FilePath -> FilePath -> VarDecl
VarDecl FilePath
varName FilePath
typeVar'
, FilePath
mid
, FilePath -> FilePath -> MsgInfo
MsgInfo FilePath
mid FilePath
mn
, FilePath -> FilePath -> FilePath -> MsgData
MsgData FilePath
mn FilePath
varName FilePath
typeVar'
)
where
monitorMap :: VariableDB
-> (String, Maybe String)
-> Maybe Trigger
monitorMap :: VariableDB -> (FilePath, Maybe FilePath) -> Maybe Trigger
monitorMap VariableDB
varDB (FilePath
monitorName, Maybe FilePath
Nothing) =
Trigger -> Maybe Trigger
forall a. a -> Maybe a
Just (Trigger -> Maybe Trigger) -> Trigger -> Maybe Trigger
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath -> Maybe FilePath -> Trigger
Trigger 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 tyCFS :: Maybe FilePath
tyCFS = 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
"cfs" FilePath
"C" FilePath
ty
Trigger -> Maybe Trigger
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Trigger -> Maybe Trigger) -> Trigger -> Maybe Trigger
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath -> Maybe FilePath -> Trigger
Trigger FilePath
monitorName (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
ty) Maybe FilePath
tyCFS
data VarDecl = VarDecl
{ VarDecl -> FilePath
varDeclName :: String
, VarDecl -> FilePath
varDeclType :: 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
type MsgInfoId = String
data MsgInfo = MsgInfo
{ MsgInfo -> FilePath
msgInfoId :: MsgInfoId
, MsgInfo -> FilePath
msgInfoDesc :: String
}
deriving ((forall x. MsgInfo -> Rep MsgInfo x)
-> (forall x. Rep MsgInfo x -> MsgInfo) -> Generic MsgInfo
forall x. Rep MsgInfo x -> MsgInfo
forall x. MsgInfo -> Rep MsgInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MsgInfo -> Rep MsgInfo x
from :: forall x. MsgInfo -> Rep MsgInfo x
$cto :: forall x. Rep MsgInfo x -> MsgInfo
to :: forall x. Rep MsgInfo x -> MsgInfo
Generic)
instance ToJSON MsgInfo
data MsgData = MsgData
{ MsgData -> FilePath
msgDataDesc :: String
, MsgData -> FilePath
msgDataVarName :: String
, MsgData -> FilePath
msgDataVarType :: String
}
deriving ((forall x. MsgData -> Rep MsgData x)
-> (forall x. Rep MsgData x -> MsgData) -> Generic MsgData
forall x. Rep MsgData x -> MsgData
forall x. MsgData -> Rep MsgData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MsgData -> Rep MsgData x
from :: forall x. MsgData -> Rep MsgData x
$cto :: forall x. Rep MsgData x -> MsgData
to :: forall x. Rep MsgData x -> MsgData
Generic)
instance ToJSON MsgData
data Trigger = Trigger
{ Trigger -> FilePath
triggerName :: String
, Trigger -> Maybe FilePath
triggerType :: Maybe String
, Trigger -> Maybe FilePath
triggerMsgType :: Maybe String
}
deriving ((forall x. Trigger -> Rep Trigger x)
-> (forall x. Rep Trigger x -> Trigger) -> Generic Trigger
forall x. Rep Trigger x -> Trigger
forall x. Trigger -> Rep Trigger x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Trigger -> Rep Trigger x
from :: forall x. Trigger -> Rep Trigger x
$cto :: forall x. Rep Trigger x -> Trigger
to :: forall x. Rep Trigger x -> Trigger
Generic)
instance ToJSON Trigger
data AppData = AppData
{ AppData -> [VarDecl]
variables :: [VarDecl]
, AppData -> [FilePath]
msgIds :: [MsgInfoId]
, AppData -> [MsgInfo]
msgCases :: [MsgInfo]
, AppData -> [MsgData]
msgHandlers :: [MsgData]
, AppData -> [Trigger]
triggers :: [Trigger]
, 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