{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Command.Common
( parseInputFile
, parseVariablesFile
, parseRequirementsListFile
, openVarDBFiles
, openVarDBFilesWithDefault
, parseTemplateVarsFile
, checkArguments
, specExtractExternalVariables
, specExtractHandlers
, ExprPair(..)
, ExprPairT(..)
, exprPair
, processResult
, cannotCopyTemplate
, makeLeftE
, mergeObjects
, locateTemplateDir
)
where
import qualified Control.Exception as E
import Control.Monad.Except (ExceptT (..), runExceptT, throwError)
import Control.Monad.IO.Class (liftIO)
import Data.Aeson (Value (Null, Object), eitherDecode,
eitherDecodeFileStrict, object)
import Data.Aeson.KeyMap (union)
import qualified Data.ByteString.Lazy as L
import Data.List (isInfixOf, isPrefixOf)
import System.Directory (doesFileExist)
import System.FilePath ((</>))
import System.Process (readProcess)
import Data.ByteString.Extra as B (safeReadFile)
import Data.String.Extra (sanitizeLCIdentifier, sanitizeUCIdentifier)
import Data.OgmaSpec (Spec, externalVariableName, externalVariables,
requirementName, requirementResultType,
requirements)
import Language.CSVSpec.Parser (parseCSVSpec)
import Language.JSONSpec.Parser (parseJSONSpec)
import Language.XLSXSpec.Parser (parseXLSXSpec)
import Language.XMLSpec.Parser (parseXMLSpec)
import qualified Language.Lustre.AbsLustre as Lustre
import qualified Language.Lustre.ParLustre as Lustre (myLexer, pBoolSpec)
import qualified Language.SMV.AbsSMV as SMV
import qualified Language.SMV.ParSMV as SMV (myLexer, pBoolSpec)
import Language.SMV.Substitution (substituteBoolExpr)
import qualified Language.Trans.Lustre2Copilot as Lustre (boolSpec2Copilot,
boolSpecNames)
import Language.Trans.SMV2Copilot as SMV (boolSpec2Copilot,
boolSpecNames)
import Command.VariableDB (VariableDB, emptyVariableDB, mergeVariableDB)
import Command.Errors (ErrorTriplet(..), ErrorCode)
import Command.Result (Result (..))
import Data.Location (Location (..))
import Paths_ogma_core (getDataDir)
parseInputFile :: FilePath
-> String
-> String
-> Maybe String
-> ExprPairT a
-> ExceptT ErrorTriplet IO (Spec a)
parseInputFile :: forall a.
String
-> String
-> String
-> Maybe String
-> ExprPairT a
-> ExceptT ErrorTriplet IO (Spec a)
parseInputFile String
fp String
formatName String
propFormatName Maybe String
propVia ExprPairT a
exprT =
IO (Either ErrorTriplet (Spec a))
-> ExceptT ErrorTriplet IO (Spec a)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either ErrorTriplet (Spec a))
-> ExceptT ErrorTriplet IO (Spec a))
-> IO (Either ErrorTriplet (Spec a))
-> ExceptT ErrorTriplet IO (Spec a)
forall a b. (a -> b) -> a -> b
$ do
let ExprPairT String -> Either String a
parse [(String, String)] -> a -> a
replace a -> String
print a -> [String]
ids a
def = ExprPairT a
exprT
let wrapper :: String -> IO (Either String a)
wrapper = Maybe String
-> (String -> Either String a) -> String -> IO (Either String a)
forall a.
Maybe String
-> (String -> Either String a) -> String -> IO (Either String a)
wrapVia Maybe String
propVia String -> Either String a
parse
Bool
exists <- String -> IO Bool
doesFileExist String
formatName
String
dataDir <- IO String
getDataDir
let formatFile :: String
formatFile
| String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInfixOf String
"/" String
formatName Bool -> Bool -> Bool
|| Bool
exists
= String
formatName
| Bool
otherwise
= String
dataDir String -> String -> String
</> String
"data" String -> String -> String
</> String
"formats" String -> String -> String
</>
(String
formatName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
propFormatName)
Bool
formatMissing <- Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Bool
doesFileExist String
formatFile
if Bool
formatMissing
then Either ErrorTriplet (Spec a) -> IO (Either ErrorTriplet (Spec a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ErrorTriplet (Spec a) -> IO (Either ErrorTriplet (Spec a)))
-> Either ErrorTriplet (Spec a)
-> IO (Either ErrorTriplet (Spec a))
forall a b. (a -> b) -> a -> b
$ ErrorTriplet -> Either ErrorTriplet (Spec a)
forall a b. a -> Either a b
Left (ErrorTriplet -> Either ErrorTriplet (Spec a))
-> ErrorTriplet -> Either ErrorTriplet (Spec a)
forall a b. (a -> b) -> a -> b
$ String -> ErrorTriplet
commandIncorrectFormatSpec String
formatFile
else do
Either String (Spec a)
res <- do
String
format <- String -> IO String
readFile String
formatFile
if | String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"XMLFormat" String
format
-> do let xmlFormat :: XMLFormat
xmlFormat = String -> XMLFormat
forall a. Read a => String -> a
read String
format
String
content <- String -> IO String
readFile String
fp
(String -> IO (Either String a))
-> a -> XMLFormat -> String -> IO (Either String (Spec a))
forall a.
(String -> IO (Either String a))
-> a -> XMLFormat -> String -> IO (Either String (Spec a))
parseXMLSpec
(String -> IO (Either String a)
wrapper) (a
def) XMLFormat
xmlFormat String
content
| String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"CSVFormat" String
format
-> do let csvFormat :: CSVFormat
csvFormat = String -> CSVFormat
forall a. Read a => String -> a
read String
format
String
content <- String -> IO String
readFile String
fp
(String -> IO (Either String a))
-> a -> CSVFormat -> String -> IO (Either String (Spec a))
forall a.
(String -> IO (Either String a))
-> a -> CSVFormat -> String -> IO (Either String (Spec a))
parseCSVSpec String -> IO (Either String a)
wrapper a
def CSVFormat
csvFormat String
content
| String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"XLSXFormat" String
format
-> do let xlsxFormat :: XLSXFormat
xlsxFormat = String -> XLSXFormat
forall a. Read a => String -> a
read String
format
ByteString
content <- String -> IO ByteString
L.readFile String
fp
(String -> IO (Either String a))
-> a -> XLSXFormat -> ByteString -> IO (Either String (Spec a))
forall a.
(String -> IO (Either String a))
-> a -> XLSXFormat -> ByteString -> IO (Either String (Spec a))
parseXLSXSpec String -> IO (Either String a)
wrapper a
def XLSXFormat
xlsxFormat ByteString
content
| Bool
otherwise
-> do let jsonFormat :: JSONFormat
jsonFormat = String -> JSONFormat
forall a. Read a => String -> a
read String
format
Either String ByteString
content <- String -> IO (Either String ByteString)
B.safeReadFile String
fp
case Either String ByteString
content of
Left String
e -> Either String (Spec a) -> IO (Either String (Spec a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Spec a) -> IO (Either String (Spec a)))
-> Either String (Spec a) -> IO (Either String (Spec a))
forall a b. (a -> b) -> a -> b
$ String -> Either String (Spec a)
forall a b. a -> Either a b
Left String
e
Right ByteString
b -> do case ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
b of
Left String
e -> Either String (Spec a) -> IO (Either String (Spec a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Spec a) -> IO (Either String (Spec a)))
-> Either String (Spec a) -> IO (Either String (Spec a))
forall a b. (a -> b) -> a -> b
$ String -> Either String (Spec a)
forall a b. a -> Either a b
Left String
e
Right Value
v ->
(String -> IO (Either String a))
-> JSONFormat -> Value -> IO (Either String (Spec a))
forall a.
(String -> IO (Either String a))
-> JSONFormat -> Value -> IO (Either String (Spec a))
parseJSONSpec
(String -> IO (Either String a)
wrapper)
JSONFormat
jsonFormat
Value
v
case Either String (Spec a)
res of
Left String
e -> Either ErrorTriplet (Spec a) -> IO (Either ErrorTriplet (Spec a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ErrorTriplet (Spec a) -> IO (Either ErrorTriplet (Spec a)))
-> Either ErrorTriplet (Spec a)
-> IO (Either ErrorTriplet (Spec a))
forall a b. (a -> b) -> a -> b
$ ErrorTriplet -> Either ErrorTriplet (Spec a)
forall a b. a -> Either a b
Left (ErrorTriplet -> Either ErrorTriplet (Spec a))
-> ErrorTriplet -> Either ErrorTriplet (Spec a)
forall a b. (a -> b) -> a -> b
$ String -> ErrorTriplet
cannotOpenInputFile String
fp
Right Spec a
x -> Either ErrorTriplet (Spec a) -> IO (Either ErrorTriplet (Spec a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ErrorTriplet (Spec a) -> IO (Either ErrorTriplet (Spec a)))
-> Either ErrorTriplet (Spec a)
-> IO (Either ErrorTriplet (Spec a))
forall a b. (a -> b) -> a -> b
$ Spec a -> Either ErrorTriplet (Spec a)
forall a b. b -> Either a b
Right Spec a
x
parseVariablesFile :: Maybe FilePath
-> ExceptT ErrorTriplet IO (Maybe [String])
parseVariablesFile :: Maybe String -> ExceptT ErrorTriplet IO (Maybe [String])
parseVariablesFile Maybe String
Nothing = Maybe [String] -> ExceptT ErrorTriplet IO (Maybe [String])
forall a. a -> ExceptT ErrorTriplet IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [String]
forall a. Maybe a
Nothing
parseVariablesFile (Just String
fp) = do
Either SomeException [String]
varNamesE <- IO (Either SomeException [String])
-> ExceptT ErrorTriplet IO (Either SomeException [String])
forall a. IO a -> ExceptT ErrorTriplet IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SomeException [String])
-> ExceptT ErrorTriplet IO (Either SomeException [String]))
-> IO (Either SomeException [String])
-> ExceptT ErrorTriplet IO (Either SomeException [String])
forall a b. (a -> b) -> a -> b
$ IO [String] -> IO (Either SomeException [String])
forall e a. Exception e => IO a -> IO (Either e a)
E.try (IO [String] -> IO (Either SomeException [String]))
-> IO [String] -> IO (Either SomeException [String])
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines (String -> [String]) -> IO String -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
readFile String
fp
case (Either SomeException [String]
varNamesE :: Either E.SomeException [String]) of
Left SomeException
_ -> ErrorTriplet -> ExceptT ErrorTriplet IO (Maybe [String])
forall a. ErrorTriplet -> ExceptT ErrorTriplet IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ErrorTriplet -> ExceptT ErrorTriplet IO (Maybe [String]))
-> ErrorTriplet -> ExceptT ErrorTriplet IO (Maybe [String])
forall a b. (a -> b) -> a -> b
$ String -> ErrorTriplet
cannotOpenVarFile String
fp
Right [String]
varNames -> Maybe [String] -> ExceptT ErrorTriplet IO (Maybe [String])
forall a. a -> ExceptT ErrorTriplet IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [String] -> ExceptT ErrorTriplet IO (Maybe [String]))
-> Maybe [String] -> ExceptT ErrorTriplet IO (Maybe [String])
forall a b. (a -> b) -> a -> b
$ [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String]
varNames
parseRequirementsListFile :: Maybe FilePath
-> ExceptT ErrorTriplet IO (Maybe [String])
parseRequirementsListFile :: Maybe String -> ExceptT ErrorTriplet IO (Maybe [String])
parseRequirementsListFile Maybe String
Nothing = Maybe [String] -> ExceptT ErrorTriplet IO (Maybe [String])
forall a. a -> ExceptT ErrorTriplet IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [String]
forall a. Maybe a
Nothing
parseRequirementsListFile (Just String
fp) =
IO (Either ErrorTriplet (Maybe [String]))
-> ExceptT ErrorTriplet IO (Maybe [String])
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either ErrorTriplet (Maybe [String]))
-> ExceptT ErrorTriplet IO (Maybe [String]))
-> IO (Either ErrorTriplet (Maybe [String]))
-> ExceptT ErrorTriplet IO (Maybe [String])
forall a b. (a -> b) -> a -> b
$ ErrorTriplet
-> Either SomeException (Maybe [String])
-> Either ErrorTriplet (Maybe [String])
forall c b. c -> Either SomeException b -> Either c b
makeLeftE (String -> ErrorTriplet
cannotOpenHandlersFile String
fp) (Either SomeException (Maybe [String])
-> Either ErrorTriplet (Maybe [String]))
-> IO (Either SomeException (Maybe [String]))
-> IO (Either ErrorTriplet (Maybe [String]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(IO (Maybe [String]) -> IO (Either SomeException (Maybe [String]))
forall e a. Exception e => IO a -> IO (Either e a)
E.try (IO (Maybe [String]) -> IO (Either SomeException (Maybe [String])))
-> IO (Maybe [String])
-> IO (Either SomeException (Maybe [String]))
forall a b. (a -> b) -> a -> b
$ [String] -> Maybe [String]
forall a. a -> Maybe a
Just ([String] -> Maybe [String])
-> (String -> [String]) -> String -> Maybe [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> Maybe [String]) -> IO String -> IO (Maybe [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
readFile String
fp)
openVarDBFiles :: VariableDB
-> [FilePath]
-> ExceptT ErrorTriplet IO VariableDB
openVarDBFiles :: VariableDB -> [String] -> ExceptT ErrorTriplet IO VariableDB
openVarDBFiles VariableDB
acc [] = VariableDB -> ExceptT ErrorTriplet IO VariableDB
forall a. a -> ExceptT ErrorTriplet IO a
forall (m :: * -> *) a. Monad m => a -> m a
return VariableDB
acc
openVarDBFiles VariableDB
acc (String
x:[String]
xs) = do
VariableDB
file <- Maybe String -> ExceptT ErrorTriplet IO VariableDB
parseVarDBFile (String -> Maybe String
forall a. a -> Maybe a
Just String
x)
VariableDB
acc' <- VariableDB -> VariableDB -> ExceptT ErrorTriplet IO VariableDB
forall (m :: * -> *).
Monad m =>
VariableDB -> VariableDB -> ExceptT ErrorTriplet m VariableDB
mergeVariableDB VariableDB
acc VariableDB
file
VariableDB -> [String] -> ExceptT ErrorTriplet IO VariableDB
openVarDBFiles VariableDB
acc' [String]
xs
where
parseVarDBFile :: Maybe FilePath
-> ExceptT ErrorTriplet IO VariableDB
parseVarDBFile :: Maybe String -> ExceptT ErrorTriplet IO VariableDB
parseVarDBFile Maybe String
Nothing = VariableDB -> ExceptT ErrorTriplet IO VariableDB
forall a. a -> ExceptT ErrorTriplet IO a
forall (m :: * -> *) a. Monad m => a -> m a
return VariableDB
emptyVariableDB
parseVarDBFile (Just String
fn) =
IO (Either ErrorTriplet VariableDB)
-> ExceptT ErrorTriplet IO VariableDB
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either ErrorTriplet VariableDB)
-> ExceptT ErrorTriplet IO VariableDB)
-> IO (Either ErrorTriplet VariableDB)
-> ExceptT ErrorTriplet IO VariableDB
forall a b. (a -> b) -> a -> b
$ ErrorTriplet
-> Either String VariableDB -> Either ErrorTriplet VariableDB
forall c a b. c -> Either a b -> Either c b
makeLeftE' (String -> ErrorTriplet
cannotOpenDB String
fn) (Either String VariableDB -> Either ErrorTriplet VariableDB)
-> IO (Either String VariableDB)
-> IO (Either ErrorTriplet VariableDB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
String -> IO (Either String VariableDB)
forall a. FromJSON a => String -> IO (Either String a)
eitherDecodeFileStrict String
fn
openVarDBFilesWithDefault :: [FilePath]
-> ExceptT ErrorTriplet IO VariableDB
openVarDBFilesWithDefault :: [String] -> ExceptT ErrorTriplet IO VariableDB
openVarDBFilesWithDefault [String]
files = do
String
dataDir <- IO String -> ExceptT ErrorTriplet IO String
forall a. IO a -> ExceptT ErrorTriplet IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
getDataDir
let defaultDB :: String
defaultDB = String
dataDir String -> String -> String
</> String
"data" String -> String -> String
</> String
"variable-db.json"
VariableDB -> [String] -> ExceptT ErrorTriplet IO VariableDB
openVarDBFiles VariableDB
emptyVariableDB ([String]
files [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
defaultDB])
parseTemplateVarsFile :: Maybe FilePath
-> ExceptT ErrorTriplet IO Value
parseTemplateVarsFile :: Maybe String -> ExceptT ErrorTriplet IO Value
parseTemplateVarsFile Maybe String
Nothing = Value -> ExceptT ErrorTriplet IO Value
forall a. a -> ExceptT ErrorTriplet IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> ExceptT ErrorTriplet IO Value)
-> Value -> ExceptT ErrorTriplet IO Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object []
parseTemplateVarsFile (Just String
fp) = do
Either String ByteString
content <- IO (Either String ByteString)
-> ExceptT ErrorTriplet IO (Either String ByteString)
forall a. IO a -> ExceptT ErrorTriplet IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either String ByteString)
-> ExceptT ErrorTriplet IO (Either String ByteString))
-> IO (Either String ByteString)
-> ExceptT ErrorTriplet IO (Either String ByteString)
forall a b. (a -> b) -> a -> b
$ String -> IO (Either String ByteString)
B.safeReadFile String
fp
let value :: Either String Value
value = ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (ByteString -> Either String Value)
-> Either String ByteString -> Either String Value
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Either String ByteString
content
case Either String Value
value of
Right x :: Value
x@(Object Object
_) -> Value -> ExceptT ErrorTriplet IO Value
forall a. a -> ExceptT ErrorTriplet IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Value
x
Right x :: Value
x@Value
Null -> Value -> ExceptT ErrorTriplet IO Value
forall a. a -> ExceptT ErrorTriplet IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Value
x
Right Value
_ -> ErrorTriplet -> ExceptT ErrorTriplet IO Value
forall a. ErrorTriplet -> ExceptT ErrorTriplet IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ErrorTriplet
cannotReadObjectTemplateVars String
fp)
Either String Value
_ -> ErrorTriplet -> ExceptT ErrorTriplet IO Value
forall a. ErrorTriplet -> ExceptT ErrorTriplet IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ErrorTriplet
cannotOpenTemplateVars String
fp)
checkArguments :: Maybe (Spec a)
-> Maybe [String]
-> Maybe [String]
-> Either ErrorTriplet ()
checkArguments :: forall a.
Maybe (Spec a)
-> Maybe [String] -> Maybe [String] -> Either ErrorTriplet ()
checkArguments Maybe (Spec a)
Nothing Maybe [String]
Nothing Maybe [String]
Nothing = ErrorTriplet -> Either ErrorTriplet ()
forall a b. a -> Either a b
Left ErrorTriplet
wrongArguments
checkArguments Maybe (Spec a)
Nothing Maybe [String]
Nothing Maybe [String]
_ = ErrorTriplet -> Either ErrorTriplet ()
forall a b. a -> Either a b
Left ErrorTriplet
wrongArguments
checkArguments Maybe (Spec a)
Nothing Maybe [String]
_ Maybe [String]
Nothing = ErrorTriplet -> Either ErrorTriplet ()
forall a b. a -> Either a b
Left ErrorTriplet
wrongArguments
checkArguments Maybe (Spec a)
_ (Just []) Maybe [String]
_ = ErrorTriplet -> Either ErrorTriplet ()
forall a b. a -> Either a b
Left ErrorTriplet
wrongArguments
checkArguments Maybe (Spec a)
_ Maybe [String]
_ (Just []) = ErrorTriplet -> Either ErrorTriplet ()
forall a b. a -> Either a b
Left ErrorTriplet
wrongArguments
checkArguments Maybe (Spec a)
_ Maybe [String]
_ Maybe [String]
_ = () -> Either ErrorTriplet ()
forall a b. b -> Either a b
Right ()
specExtractExternalVariables :: Maybe (Spec a) -> [String]
Maybe (Spec a)
Nothing = []
specExtractExternalVariables (Just Spec a
cs) = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
sanitizeLCIdentifier
([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (ExternalVariableDef -> String)
-> [ExternalVariableDef] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ExternalVariableDef -> String
externalVariableName
([ExternalVariableDef] -> [String])
-> [ExternalVariableDef] -> [String]
forall a b. (a -> b) -> a -> b
$ Spec a -> [ExternalVariableDef]
forall a. Spec a -> [ExternalVariableDef]
externalVariables Spec a
cs
specExtractHandlers :: Maybe (Spec a) -> [(String, Maybe String)]
specExtractHandlers :: forall a. Maybe (Spec a) -> [(String, Maybe String)]
specExtractHandlers Maybe (Spec a)
Nothing = []
specExtractHandlers (Just Spec a
cs) = (Requirement a -> (String, Maybe String))
-> [Requirement a] -> [(String, Maybe String)]
forall a b. (a -> b) -> [a] -> [b]
map Requirement a -> (String, Maybe String)
forall {a}. Requirement a -> (String, Maybe String)
extractReqData
([Requirement a] -> [(String, Maybe String)])
-> [Requirement a] -> [(String, Maybe String)]
forall a b. (a -> b) -> a -> b
$ Spec a -> [Requirement a]
forall a. Spec a -> [Requirement a]
requirements Spec a
cs
where
extractReqData :: Requirement a -> (String, Maybe String)
extractReqData Requirement a
r =
(String -> String
handlerNameF (Requirement a -> String
forall a. Requirement a -> String
requirementName Requirement a
r), Requirement a -> Maybe String
forall a. Requirement a -> Maybe String
requirementResultType Requirement a
r)
handlerNameF :: String -> String
handlerNameF = (String
"handler" String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
sanitizeUCIdentifier
data ExprPair = forall a . ExprPair
{ ()
exprTPair :: ExprPairT a
}
data ExprPairT a = ExprPairT
{ forall a. ExprPairT a -> String -> Either String a
exprTParse :: String -> Either String a
, forall a. ExprPairT a -> [(String, String)] -> a -> a
exprTReplace :: [(String, String)] -> a -> a
, forall a. ExprPairT a -> a -> String
exprTPrint :: a -> String
, forall a. ExprPairT a -> a -> [String]
exprTIdents :: a -> [String]
, forall a. ExprPairT a -> a
exprTUnknown :: a
}
exprPair :: String -> ExprPair
exprPair :: String -> ExprPair
exprPair String
"lustre" = ExprPairT BoolSpec -> ExprPair
forall a. ExprPairT a -> ExprPair
ExprPair (ExprPairT BoolSpec -> ExprPair) -> ExprPairT BoolSpec -> ExprPair
forall a b. (a -> b) -> a -> b
$
(String -> Either String BoolSpec)
-> ([(String, String)] -> BoolSpec -> BoolSpec)
-> (BoolSpec -> String)
-> (BoolSpec -> [String])
-> BoolSpec
-> ExprPairT BoolSpec
forall a.
(String -> Either String a)
-> ([(String, String)] -> a -> a)
-> (a -> String)
-> (a -> [String])
-> a
-> ExprPairT a
ExprPairT
([Token] -> Either String BoolSpec
Lustre.pBoolSpec ([Token] -> Either String BoolSpec)
-> (String -> [Token]) -> String -> Either String BoolSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Token]
Lustre.myLexer)
(\[(String, String)]
_ -> BoolSpec -> BoolSpec
forall a. a -> a
id)
(BoolSpec -> String
Lustre.boolSpec2Copilot)
(BoolSpec -> [String]
Lustre.boolSpecNames)
(Ident -> BoolSpec
Lustre.BoolSpecSignal (String -> Ident
Lustre.Ident String
"undefined"))
exprPair String
"literal" = ExprPairT String -> ExprPair
forall a. ExprPairT a -> ExprPair
ExprPair (ExprPairT String -> ExprPair) -> ExprPairT String -> ExprPair
forall a b. (a -> b) -> a -> b
$
(String -> Either String String)
-> ([(String, String)] -> String -> String)
-> (String -> String)
-> (String -> [String])
-> String
-> ExprPairT String
forall a.
(String -> Either String a)
-> ([(String, String)] -> a -> a)
-> (a -> String)
-> (a -> [String])
-> a
-> ExprPairT a
ExprPairT
String -> Either String String
forall a b. b -> Either a b
Right
(\[(String, String)]
_ -> String -> String
forall a. a -> a
id)
String -> String
forall a. a -> a
id
([String] -> String -> [String]
forall a b. a -> b -> a
const [])
String
"undefined"
exprPair String
"cocospec" = String -> ExprPair
exprPair String
"lustre"
exprPair String
_ = ExprPairT BoolSpec -> ExprPair
forall a. ExprPairT a -> ExprPair
ExprPair (ExprPairT BoolSpec -> ExprPair) -> ExprPairT BoolSpec -> ExprPair
forall a b. (a -> b) -> a -> b
$
(String -> Either String BoolSpec)
-> ([(String, String)] -> BoolSpec -> BoolSpec)
-> (BoolSpec -> String)
-> (BoolSpec -> [String])
-> BoolSpec
-> ExprPairT BoolSpec
forall a.
(String -> Either String a)
-> ([(String, String)] -> a -> a)
-> (a -> String)
-> (a -> [String])
-> a
-> ExprPairT a
ExprPairT
([Token] -> Either String BoolSpec
SMV.pBoolSpec ([Token] -> Either String BoolSpec)
-> (String -> [Token]) -> String -> Either String BoolSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Token]
SMV.myLexer)
([(String, String)] -> BoolSpec -> BoolSpec
forall {t :: * -> *}.
Foldable t =>
t (String, String) -> BoolSpec -> BoolSpec
substituteBoolExpr)
(BoolSpec -> String
SMV.boolSpec2Copilot)
(BoolSpec -> [String]
SMV.boolSpecNames)
(Ident -> BoolSpec
SMV.BoolSpecSignal (String -> Ident
SMV.Ident String
"undefined"))
processResult :: Monad m => ExceptT ErrorTriplet m a -> m (Result ErrorCode)
processResult :: forall (m :: * -> *) a.
Monad m =>
ExceptT ErrorTriplet m a -> m (Result ErrorCode)
processResult ExceptT ErrorTriplet m a
m = do
Either ErrorTriplet a
r <- ExceptT ErrorTriplet m a -> m (Either ErrorTriplet a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT ErrorTriplet m a
m
case Either ErrorTriplet a
r of
Left (ErrorTriplet ErrorCode
errorCode String
msg Location
location)
-> Result ErrorCode -> m (Result ErrorCode)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result ErrorCode -> m (Result ErrorCode))
-> Result ErrorCode -> m (Result ErrorCode)
forall a b. (a -> b) -> a -> b
$ ErrorCode -> String -> Location -> Result ErrorCode
forall a. a -> String -> Location -> Result a
Error ErrorCode
errorCode String
msg Location
location
Either ErrorTriplet a
_ -> Result ErrorCode -> m (Result ErrorCode)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Result ErrorCode
forall a. Result a
Success
wrongArguments :: ErrorTriplet
wrongArguments :: ErrorTriplet
wrongArguments =
ErrorCode -> String -> Location -> ErrorTriplet
ErrorTriplet ErrorCode
ecWrongArguments String
msg Location
LocationNothing
where
msg :: String
msg =
String
"the arguments provided are insufficient: you must provide an input "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"specification, or both a variables and a handlers file."
cannotOpenInputFile :: FilePath -> ErrorTriplet
cannotOpenInputFile :: String -> ErrorTriplet
cannotOpenInputFile String
file =
ErrorCode -> String -> Location -> ErrorTriplet
ErrorTriplet ErrorCode
ecCannotOpenInputFile String
msg (String -> Location
LocationFile String
file)
where
msg :: String
msg =
String
"cannot open input specification file " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
cannotOpenDB :: FilePath -> ErrorTriplet
cannotOpenDB :: String -> ErrorTriplet
cannotOpenDB String
file =
ErrorCode -> String -> Location -> ErrorTriplet
ErrorTriplet ErrorCode
ecCannotOpenDBFile String
msg (String -> Location
LocationFile String
file)
where
msg :: String
msg =
String
"cannot open variable DB file " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
cannotOpenVarFile :: FilePath -> ErrorTriplet
cannotOpenVarFile :: String -> ErrorTriplet
cannotOpenVarFile String
file =
ErrorCode -> String -> Location -> ErrorTriplet
ErrorTriplet ErrorCode
ecCannotOpenVarFile String
msg (String -> Location
LocationFile String
file)
where
msg :: String
msg =
String
"cannot open variable list file " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
cannotOpenHandlersFile :: FilePath -> ErrorTriplet
cannotOpenHandlersFile :: String -> ErrorTriplet
cannotOpenHandlersFile String
file =
ErrorCode -> String -> Location -> ErrorTriplet
ErrorTriplet ErrorCode
ecCannotOpenHandlersFile String
msg (String -> Location
LocationFile String
file)
where
msg :: String
msg =
String
"cannot open handlers file " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
commandIncorrectFormatSpec :: FilePath -> ErrorTriplet
commandIncorrectFormatSpec :: String -> ErrorTriplet
commandIncorrectFormatSpec String
formatFile =
ErrorCode -> String -> Location -> ErrorTriplet
ErrorTriplet ErrorCode
ecIncorrectFormatFile String
msg (String -> Location
LocationFile String
formatFile)
where
msg :: String
msg =
String
"The format specification " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
formatFile String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" does not exist or is not "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"readable"
cannotOpenTemplateVars :: FilePath -> ErrorTriplet
cannotOpenTemplateVars :: String -> ErrorTriplet
cannotOpenTemplateVars String
file =
ErrorCode -> String -> Location -> ErrorTriplet
ErrorTriplet ErrorCode
ecCannotOpenTemplateVarsFile String
msg (String -> Location
LocationFile String
file)
where
msg :: String
msg =
String
"Cannot open file with additional template variables: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
cannotReadObjectTemplateVars :: FilePath -> ErrorTriplet
cannotReadObjectTemplateVars :: String -> ErrorTriplet
cannotReadObjectTemplateVars String
file =
ErrorCode -> String -> Location -> ErrorTriplet
ErrorTriplet ErrorCode
ecCannotReadObjectTemplateVarsFile String
msg (String -> Location
LocationFile String
file)
where
msg :: String
msg =
String
"Cannot open file with additional template variables: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
cannotCopyTemplate :: ErrorTriplet
cannotCopyTemplate :: ErrorTriplet
cannotCopyTemplate =
ErrorCode -> String -> Location -> ErrorTriplet
ErrorTriplet ErrorCode
ecCannotCopyTemplate String
msg Location
LocationNothing
where
msg :: String
msg =
String
"Generation failed during copy/write operation. Check that"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" there's free space in the disk and that you have the necessary"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" permissions to write in the destination directory."
ecWrongArguments :: ErrorCode
ecWrongArguments :: ErrorCode
ecWrongArguments = ErrorCode
1
ecCannotOpenInputFile :: ErrorCode
ecCannotOpenInputFile :: ErrorCode
ecCannotOpenInputFile = ErrorCode
1
ecCannotOpenDBFile :: ErrorCode
ecCannotOpenDBFile :: ErrorCode
ecCannotOpenDBFile = ErrorCode
1
ecCannotOpenVarFile :: ErrorCode
ecCannotOpenVarFile :: ErrorCode
ecCannotOpenVarFile = ErrorCode
1
ecCannotOpenHandlersFile :: ErrorCode
ecCannotOpenHandlersFile :: ErrorCode
ecCannotOpenHandlersFile = ErrorCode
1
ecIncorrectFormatFile :: ErrorCode
ecIncorrectFormatFile :: ErrorCode
ecIncorrectFormatFile = ErrorCode
1
ecCannotOpenTemplateVarsFile :: ErrorCode
ecCannotOpenTemplateVarsFile :: ErrorCode
ecCannotOpenTemplateVarsFile = ErrorCode
1
ecCannotReadObjectTemplateVarsFile :: ErrorCode
ecCannotReadObjectTemplateVarsFile :: ErrorCode
ecCannotReadObjectTemplateVarsFile = ErrorCode
1
ecCannotCopyTemplate :: ErrorCode
ecCannotCopyTemplate :: ErrorCode
ecCannotCopyTemplate = ErrorCode
1
locateTemplateDir :: Maybe FilePath
-> FilePath
-> ExceptT e IO FilePath
locateTemplateDir :: forall e. Maybe String -> String -> ExceptT e IO String
locateTemplateDir Maybe String
mTemplateDir String
name =
case Maybe String
mTemplateDir of
Just String
x -> String -> ExceptT e IO String
forall a. a -> ExceptT e IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
x
Maybe String
Nothing -> IO String -> ExceptT e IO String
forall a. IO a -> ExceptT e IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> ExceptT e IO String)
-> IO String -> ExceptT e IO String
forall a b. (a -> b) -> a -> b
$ do
String
dataDir <- IO String
getDataDir
String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
dataDir String -> String -> String
</> String
"templates" String -> String -> String
</> String
name
wrapVia :: Maybe String
-> (String -> Either String a)
-> String
-> IO (Either String a)
wrapVia :: forall a.
Maybe String
-> (String -> Either String a) -> String -> IO (Either String a)
wrapVia Maybe String
Nothing String -> Either String a
parse String
s = Either String a -> IO (Either String a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Either String a
parse String
s)
wrapVia (Just String
f) String -> Either String a
parse String
s =
(IOException -> IO (Either String a))
-> IO (Either String a) -> IO (Either String a)
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
E.handle (\(IOException
e :: E.IOException) -> Either String a -> IO (Either String a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String a -> IO (Either String a))
-> Either String a -> IO (Either String a)
forall a b. (a -> b) -> a -> b
$ String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ IOException -> String
forall a. Show a => a -> String
show IOException
e) (IO (Either String a) -> IO (Either String a))
-> IO (Either String a) -> IO (Either String a)
forall a b. (a -> b) -> a -> b
$ do
String
out <- String -> [String] -> String -> IO String
readProcess String
f [] String
s
Either String a -> IO (Either String a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String a -> IO (Either String a))
-> Either String a -> IO (Either String a)
forall a b. (a -> b) -> a -> b
$ String -> Either String a
parse String
out
mergeObjects :: Value -> Value -> Value
mergeObjects :: Value -> Value -> Value
mergeObjects (Object Object
m1) (Object Object
m2) = Object -> Value
Object (Object -> Object -> Object
forall v. KeyMap v -> KeyMap v -> KeyMap v
union Object
m1 Object
m2)
mergeObjects Value
obj Value
Null = Value
obj
mergeObjects Value
Null Value
obj = Value
obj
mergeObjects Value
_ Value
_ = String -> Value
forall a. HasCallStack => String -> a
error String
"The values passed are not objects"
makeLeftE :: c -> Either E.SomeException b -> Either c b
makeLeftE :: forall c b. c -> Either SomeException b -> Either c b
makeLeftE = c -> Either SomeException b -> Either c b
forall c a b. c -> Either a b -> Either c b
makeLeftE'
makeLeftE' :: c -> Either a b -> Either c b
makeLeftE' :: forall c a b. c -> Either a b -> Either c b
makeLeftE' c
c (Left a
_) = c -> Either c b
forall a b. a -> Either a b
Left c
c
makeLeftE' c
_ (Right b
x) = b -> Either c b
forall a b. b -> Either a b
Right b
x