{-# 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)
import Data.Aeson.Extra (mergeObjects)
import Data.ExprPair (ExprPair(..), exprPair)
import Data.Location (Location (..))
import Data.Spec.Parser (readInputExpr)
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
templateDir <- Maybe FilePath -> FilePath -> ExceptT ErrorTriplet IO FilePath
forall e. Maybe FilePath -> FilePath -> ExceptT e IO FilePath
locateTemplateDir Maybe FilePath
mTemplateDir FilePath
"cfs"
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
ExceptT $ fmap (makeLeftE cannotCopyTemplate) $ E.try $
copyTemplate templateDir subst 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
vs <- Maybe FilePath -> ExceptT ErrorTriplet IO (Maybe [FilePath])
parseVariablesFile Maybe FilePath
varNameFile
rs <- parseRequirementsListFile handlersFile
varDB <- openVarDBFilesWithDefault varDBFile
specT <- maybe (return Nothing) (\FilePath
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
<$> FilePath -> ExceptT ErrorTriplet IO (Spec a)
readInputExpr' FilePath
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 FilePath -> [FilePath] -> ExceptT ErrorTriplet IO AppData
processSpec InputFile a
spec' Maybe FilePath
cExpr [FilePath]
fpA) <$> spec
let varNames = [FilePath] -> Maybe [FilePath] -> [FilePath]
forall a. a -> Maybe a -> a
fromMaybe (Maybe (InputFile a) -> [FilePath]
forall {a}. Maybe (InputFile a) -> [FilePath]
defaultVarNames Maybe (InputFile a)
spec) Maybe [FilePath]
vs
monitors = [(FilePath, Maybe FilePath)]
-> ([FilePath] -> [(FilePath, Maybe FilePath)])
-> Maybe [FilePath]
-> [(FilePath, Maybe FilePath)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe (InputFile a) -> [(FilePath, Maybe FilePath)]
forall {a}. Maybe (InputFile a) -> [(FilePath, Maybe FilePath)]
defaultMonitors Maybe (InputFile 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 = VariableDB -> [FilePath] -> [Trigger] -> Maybe AppData -> AppData
commandLogic VariableDB
varDB [FilePath]
varNames [Trigger]
monitors' Maybe AppData
copilotM
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
return appData
where
cExpr :: Maybe FilePath
cExpr = CommandOptions -> Maybe FilePath
commandConditionExpr CommandOptions
options
fpA :: [FilePath]
fpA = CommandOptions -> [FilePath]
commandInputFiles 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
readInputExpr' :: FilePath -> ExceptT ErrorTriplet IO (Spec a)
readInputExpr' FilePath
e =
FilePath
-> FilePath
-> Maybe FilePath
-> ExprPairT a
-> ExceptT ErrorTriplet IO (Spec a)
forall a.
FilePath
-> FilePath
-> Maybe FilePath
-> ExprPairT a
-> ExceptT ErrorTriplet IO (Spec a)
readInputExpr FilePath
e FilePath
propFormatName Maybe FilePath
propVia ExprPairT a
exprT
readInputFile' :: FilePath -> ExceptT ErrorTriplet IO (InputFile a)
readInputFile' FilePath
f =
FilePath
-> FilePath
-> FilePath
-> Maybe FilePath
-> ExprPairT a
-> ExceptT ErrorTriplet IO (InputFile a)
forall a.
FilePath
-> FilePath
-> FilePath
-> Maybe FilePath
-> ExprPairT a
-> ExceptT ErrorTriplet IO (InputFile a)
parseInputFile FilePath
f FilePath
formatName FilePath
propFormatName Maybe FilePath
propVia ExprPairT a
exprT
processSpec :: InputFile a
-> Maybe FilePath -> [FilePath] -> ExceptT ErrorTriplet IO AppData
processSpec InputFile a
spec' Maybe FilePath
expr' [FilePath]
fp' =
Maybe FilePath
-> [FilePath]
-> FilePath
-> [(FilePath, FilePath)]
-> ExprPairT a
-> InputFile a
-> ExceptT ErrorTriplet IO AppData
forall a.
Maybe FilePath
-> [FilePath]
-> FilePath
-> [(FilePath, FilePath)]
-> ExprPairT a
-> InputFile a
-> ExceptT ErrorTriplet IO AppData
Command.Standalone.commandLogic Maybe FilePath
expr' [FilePath]
fp' FilePath
"copilot" [] ExprPairT a
exprT InputFile a
spec'
defaultVarNames :: Maybe (InputFile a) -> [FilePath]
defaultVarNames Maybe (InputFile a)
spec = case Maybe (InputFile a)
spec of
Just (InputFileSpec Spec a
spec') -> Maybe (Spec a) -> [FilePath]
forall a. Maybe (Spec a) -> [FilePath]
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)) -> [FilePath]
forall a. Maybe (Spec a) -> [FilePath]
specExtractExternalVariables Maybe (Spec (ZonkAny 1))
forall a. Maybe a
Nothing
defaultMonitors :: Maybe (InputFile a) -> [(FilePath, Maybe FilePath)]
defaultMonitors Maybe (InputFile a)
spec = case Maybe (InputFile a)
spec of
Just (InputFileSpec Spec a
spec') -> Maybe (Spec a) -> [(FilePath, Maybe FilePath)]
forall a. Maybe (Spec a) -> [(FilePath, Maybe FilePath)]
specExtractHandlers (Spec a -> Maybe (Spec a)
forall a. a -> Maybe a
Just Spec a
spec')
Just (InputFileDiagram Diagram
_) -> [ (FilePath
"handler", FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
"uint8_t" ) ]
Maybe (InputFile a)
Nothing -> Maybe (Spec (ZonkAny 0)) -> [(FilePath, Maybe FilePath)]
forall a. Maybe (Spec a) -> [(FilePath, Maybe FilePath)]
specExtractHandlers Maybe (Spec (ZonkAny 0))
forall a. Maybe a
Nothing
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
commandConditionExpr :: Maybe String
, CommandOptions -> [FilePath]
commandInputFiles :: [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 <- VariableDB -> FilePath -> Maybe InputDef
findInput VariableDB
varDB FilePath
varName
mid <- connectionTopic <$> findConnection inputDef "cfs"
topicDef <- findTopic varDB "cfs" mid
let typeDef = VariableDB -> FilePath -> FilePath -> FilePath -> Maybe TypeDef
findType VariableDB
varDB FilePath
varName FilePath
"cfs" FilePath
"C"
let typeMsgFromType = TypeDef -> FilePath
typeFromType (TypeDef -> FilePath) -> Maybe TypeDef -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TypeDef
typeDef
typeMsgFromField = TypeDef -> Maybe FilePath
typeFromField (TypeDef -> Maybe FilePath) -> Maybe TypeDef -> Maybe FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe TypeDef
typeDef
let 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
<$> Maybe TypeDef
typeDef)
let mn = FilePath -> FilePath
pascalCase (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath
stripSuffix FilePath
"_MID" FilePath
mid
return ( VarDecl varName typeVar'
, mid
, MsgInfo mid mn
, MsgData mn typeMsgFromType typeMsgFromField varName 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 -> Maybe FilePath
msgDataFromType :: Maybe String
, MsgData -> Maybe FilePath
msgDataFromField :: Maybe 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
commandMultipleInputTypes :: ErrorTriplet
commandMultipleInputTypes :: ErrorTriplet
commandMultipleInputTypes =
ErrorCode -> FilePath -> Location -> ErrorTriplet
ErrorTriplet ErrorCode
ecMultipleInputTypes FilePath
msg Location
LocationNothing
where
msg :: FilePath
msg =
FilePath
"Too many inputs provided. Provide one diagram or multiple specs."
ecMultipleInputTypes :: ErrorCode
ecMultipleInputTypes :: ErrorCode
ecMultipleInputTypes = ErrorCode
1