{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
module Command.VariableDB
( VariableDB(..)
, InputDef(..)
, Connection(..)
, TopicDef(..)
, TypeDef(..)
, emptyVariableDB
, findInput
, findConnection
, findTopic
, findType
, findTypeByType
, mergeVariableDB
)
where
import Control.Monad.Except (ExceptT, throwError)
import Data.Aeson (FromJSON (..))
import Data.Aeson.TH (defaultOptions, deriveFromJSON, fieldLabelModifier)
import Data.Char (toLower)
import Data.List (find)
import Data.Maybe (isNothing)
import GHC.Generics (Generic)
import Data.List.Extra (toHead)
import Data.Location (Location(..))
import Command.Errors (ErrorTriplet(..), ErrorCode)
data VariableDB = VariableDB
{ VariableDB -> [InputDef]
inputs :: [InputDef]
, VariableDB -> [TopicDef]
topics :: [TopicDef]
, VariableDB -> [TypeDef]
types :: [TypeDef]
}
deriving ((forall x. VariableDB -> Rep VariableDB x)
-> (forall x. Rep VariableDB x -> VariableDB) -> Generic VariableDB
forall x. Rep VariableDB x -> VariableDB
forall x. VariableDB -> Rep VariableDB x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. VariableDB -> Rep VariableDB x
from :: forall x. VariableDB -> Rep VariableDB x
$cto :: forall x. Rep VariableDB x -> VariableDB
to :: forall x. Rep VariableDB x -> VariableDB
Generic, Int -> VariableDB -> ShowS
[VariableDB] -> ShowS
VariableDB -> String
(Int -> VariableDB -> ShowS)
-> (VariableDB -> String)
-> ([VariableDB] -> ShowS)
-> Show VariableDB
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VariableDB -> ShowS
showsPrec :: Int -> VariableDB -> ShowS
$cshow :: VariableDB -> String
show :: VariableDB -> String
$cshowList :: [VariableDB] -> ShowS
showList :: [VariableDB] -> ShowS
Show)
data InputDef = InputDef
{ InputDef -> String
inputName :: String
, InputDef -> Maybe String
inputType :: Maybe String
, InputDef -> [Connection]
inputConnections :: [ Connection ]
}
deriving (InputDef -> InputDef -> Bool
(InputDef -> InputDef -> Bool)
-> (InputDef -> InputDef -> Bool) -> Eq InputDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InputDef -> InputDef -> Bool
== :: InputDef -> InputDef -> Bool
$c/= :: InputDef -> InputDef -> Bool
/= :: InputDef -> InputDef -> Bool
Eq, Int -> InputDef -> ShowS
[InputDef] -> ShowS
InputDef -> String
(Int -> InputDef -> ShowS)
-> (InputDef -> String) -> ([InputDef] -> ShowS) -> Show InputDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InputDef -> ShowS
showsPrec :: Int -> InputDef -> ShowS
$cshow :: InputDef -> String
show :: InputDef -> String
$cshowList :: [InputDef] -> ShowS
showList :: [InputDef] -> ShowS
Show)
data Connection = Connection
{ Connection -> String
connectionScope :: String
, Connection -> String
connectionTopic :: String
, Connection -> Maybe String
connectionField :: Maybe String
}
deriving (Connection -> Connection -> Bool
(Connection -> Connection -> Bool)
-> (Connection -> Connection -> Bool) -> Eq Connection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Connection -> Connection -> Bool
== :: Connection -> Connection -> Bool
$c/= :: Connection -> Connection -> Bool
/= :: Connection -> Connection -> Bool
Eq, Int -> Connection -> ShowS
[Connection] -> ShowS
Connection -> String
(Int -> Connection -> ShowS)
-> (Connection -> String)
-> ([Connection] -> ShowS)
-> Show Connection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Connection -> ShowS
showsPrec :: Int -> Connection -> ShowS
$cshow :: Connection -> String
show :: Connection -> String
$cshowList :: [Connection] -> ShowS
showList :: [Connection] -> ShowS
Show)
data TopicDef = TopicDef
{ TopicDef -> String
topicScope :: String
, TopicDef -> String
topicTopic :: String
, TopicDef -> String
topicType :: String
}
deriving (TopicDef -> TopicDef -> Bool
(TopicDef -> TopicDef -> Bool)
-> (TopicDef -> TopicDef -> Bool) -> Eq TopicDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TopicDef -> TopicDef -> Bool
== :: TopicDef -> TopicDef -> Bool
$c/= :: TopicDef -> TopicDef -> Bool
/= :: TopicDef -> TopicDef -> Bool
Eq, Int -> TopicDef -> ShowS
[TopicDef] -> ShowS
TopicDef -> String
(Int -> TopicDef -> ShowS)
-> (TopicDef -> String) -> ([TopicDef] -> ShowS) -> Show TopicDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TopicDef -> ShowS
showsPrec :: Int -> TopicDef -> ShowS
$cshow :: TopicDef -> String
show :: TopicDef -> String
$cshowList :: [TopicDef] -> ShowS
showList :: [TopicDef] -> ShowS
Show)
data TypeDef = TypeDef
{ TypeDef -> String
typeFromScope :: String
, TypeDef -> String
typeFromType :: String
, TypeDef -> Maybe String
typeFromField :: Maybe String
, TypeDef -> String
typeToScope :: String
, TypeDef -> String
typeToType :: String
}
deriving (TypeDef -> TypeDef -> Bool
(TypeDef -> TypeDef -> Bool)
-> (TypeDef -> TypeDef -> Bool) -> Eq TypeDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeDef -> TypeDef -> Bool
== :: TypeDef -> TypeDef -> Bool
$c/= :: TypeDef -> TypeDef -> Bool
/= :: TypeDef -> TypeDef -> Bool
Eq, Int -> TypeDef -> ShowS
[TypeDef] -> ShowS
TypeDef -> String
(Int -> TypeDef -> ShowS)
-> (TypeDef -> String) -> ([TypeDef] -> ShowS) -> Show TypeDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypeDef -> ShowS
showsPrec :: Int -> TypeDef -> ShowS
$cshow :: TypeDef -> String
show :: TypeDef -> String
$cshowList :: [TypeDef] -> ShowS
showList :: [TypeDef] -> ShowS
Show)
emptyVariableDB :: VariableDB
emptyVariableDB :: VariableDB
emptyVariableDB = [InputDef] -> [TopicDef] -> [TypeDef] -> VariableDB
VariableDB [] [] []
findInput :: VariableDB -> String -> Maybe InputDef
findInput :: VariableDB -> String -> Maybe InputDef
findInput VariableDB
varDB String
name =
(InputDef -> Bool) -> [InputDef] -> Maybe InputDef
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\InputDef
x -> InputDef -> String
inputName InputDef
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name) (VariableDB -> [InputDef]
inputs VariableDB
varDB)
findConnection :: InputDef -> String -> Maybe Connection
findConnection :: InputDef -> String -> Maybe Connection
findConnection InputDef
inputDef String
scope =
(Connection -> Bool) -> [Connection] -> Maybe Connection
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Connection
x -> Connection -> String
connectionScope Connection
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
scope) (InputDef -> [Connection]
inputConnections InputDef
inputDef)
findTopic :: VariableDB -> String -> String -> Maybe TopicDef
findTopic :: VariableDB -> String -> String -> Maybe TopicDef
findTopic VariableDB
varDB String
scope String
name =
(TopicDef -> Bool) -> [TopicDef] -> Maybe TopicDef
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\TopicDef
x -> TopicDef -> String
topicScope TopicDef
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
scope Bool -> Bool -> Bool
&& TopicDef -> String
topicTopic TopicDef
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name) (VariableDB -> [TopicDef]
topics VariableDB
varDB)
findType :: VariableDB -> String -> String -> String -> Maybe TypeDef
findType :: VariableDB -> String -> String -> String -> Maybe TypeDef
findType VariableDB
varDB String
name String
scope String
destConn = do
InputDef
inputDef <- VariableDB -> String -> Maybe InputDef
findInput VariableDB
varDB String
name
let connectionDef :: Maybe Connection
connectionDef :: Maybe Connection
connectionDef = InputDef -> String -> Maybe Connection
findConnection InputDef
inputDef String
scope
field :: Maybe String
field :: Maybe String
field = Connection -> Maybe String
connectionField (Connection -> Maybe String) -> Maybe Connection -> Maybe String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Connection
connectionDef
topic :: Maybe String
topic :: Maybe String
topic = Connection -> String
connectionTopic (Connection -> String) -> Maybe Connection -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Connection
connectionDef
topicDef :: Maybe TopicDef
topicDef :: Maybe TopicDef
topicDef = VariableDB -> String -> String -> Maybe TopicDef
findTopic VariableDB
varDB String
scope (String -> Maybe TopicDef) -> Maybe String -> Maybe TopicDef
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe String
topic
ty :: Maybe String
ty :: Maybe String
ty = TopicDef -> String
topicType (TopicDef -> String) -> Maybe TopicDef -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TopicDef
topicDef
let match :: TypeDef -> Bool
match :: TypeDef -> Bool
match TypeDef
typeDef =
case (InputDef -> Maybe String
inputType InputDef
inputDef, Maybe String
ty) of
(Just String
ty1, Maybe String
Nothing) ->
TypeDef -> String
typeFromScope TypeDef
typeDef String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
scope
Bool -> Bool -> Bool
&& TypeDef -> Maybe String
typeFromField TypeDef
typeDef Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe String
field
Bool -> Bool -> Bool
&& TypeDef -> String
typeToScope TypeDef
typeDef String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
destConn
Bool -> Bool -> Bool
&& TypeDef -> String
typeToType TypeDef
typeDef String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
ty1
(Just String
ty1, Just String
ty2) ->
TypeDef -> String
typeFromScope TypeDef
typeDef String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
scope
Bool -> Bool -> Bool
&& TypeDef -> String
typeFromType TypeDef
typeDef String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
ty2
Bool -> Bool -> Bool
&& TypeDef -> Maybe String
typeFromField TypeDef
typeDef Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe String
field
Bool -> Bool -> Bool
&& TypeDef -> String
typeToScope TypeDef
typeDef String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
destConn
Bool -> Bool -> Bool
&& TypeDef -> String
typeToType TypeDef
typeDef String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
ty1
(Maybe String
_ , Just String
ty2) ->
TypeDef -> String
typeFromScope TypeDef
typeDef String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
scope
Bool -> Bool -> Bool
&& TypeDef -> String
typeFromType TypeDef
typeDef String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
ty2
Bool -> Bool -> Bool
&& TypeDef -> Maybe String
typeFromField TypeDef
typeDef Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe String
field
Bool -> Bool -> Bool
&& TypeDef -> String
typeToScope TypeDef
typeDef String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
destConn
(Maybe String
Nothing, Maybe String
Nothing) -> Bool
False
(TypeDef -> Bool) -> [TypeDef] -> Maybe TypeDef
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find TypeDef -> Bool
match (VariableDB -> [TypeDef]
types VariableDB
varDB)
findTypeByType :: VariableDB -> String -> String -> String -> Maybe TypeDef
findTypeByType :: VariableDB -> String -> String -> String -> Maybe TypeDef
findTypeByType VariableDB
varDB String
fromScope String
toScope String
toType = do
let match :: TypeDef -> Bool
match :: TypeDef -> Bool
match TypeDef
typeDef =
TypeDef -> String
typeFromScope TypeDef
typeDef String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
fromScope
Bool -> Bool -> Bool
&& TypeDef -> String
typeToScope TypeDef
typeDef String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
toScope
Bool -> Bool -> Bool
&& TypeDef -> String
typeToType TypeDef
typeDef String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
toType
(TypeDef -> Bool) -> [TypeDef] -> Maybe TypeDef
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find TypeDef -> Bool
match (VariableDB -> [TypeDef]
types VariableDB
varDB)
mergeVariableDB :: Monad m
=> VariableDB -> VariableDB -> ExceptT ErrorTriplet m VariableDB
mergeVariableDB :: forall (m :: * -> *).
Monad m =>
VariableDB -> VariableDB -> ExceptT ErrorTriplet m VariableDB
mergeVariableDB VariableDB
varDB1 VariableDB
varDB2 = do
[InputDef]
inputs' <- [InputDef] -> [InputDef] -> ExceptT ErrorTriplet m [InputDef]
forall (m :: * -> *).
Monad m =>
[InputDef] -> [InputDef] -> ExceptT ErrorTriplet m [InputDef]
mergeInputs (VariableDB -> [InputDef]
inputs VariableDB
varDB1) (VariableDB -> [InputDef]
inputs VariableDB
varDB2)
[TopicDef]
topics' <- [TopicDef] -> [TopicDef] -> ExceptT ErrorTriplet m [TopicDef]
forall (m :: * -> *).
Monad m =>
[TopicDef] -> [TopicDef] -> ExceptT ErrorTriplet m [TopicDef]
mergeTopics (VariableDB -> [TopicDef]
topics VariableDB
varDB1) (VariableDB -> [TopicDef]
topics VariableDB
varDB2)
[TypeDef]
types' <- [TypeDef] -> [TypeDef] -> ExceptT ErrorTriplet m [TypeDef]
forall (m :: * -> *).
Monad m =>
[TypeDef] -> [TypeDef] -> ExceptT ErrorTriplet m [TypeDef]
mergeTypes (VariableDB -> [TypeDef]
types VariableDB
varDB1) (VariableDB -> [TypeDef]
types VariableDB
varDB2)
VariableDB -> ExceptT ErrorTriplet m VariableDB
forall a. a -> ExceptT ErrorTriplet m a
forall (m :: * -> *) a. Monad m => a -> m a
return (VariableDB -> ExceptT ErrorTriplet m VariableDB)
-> VariableDB -> ExceptT ErrorTriplet m VariableDB
forall a b. (a -> b) -> a -> b
$ [InputDef] -> [TopicDef] -> [TypeDef] -> VariableDB
VariableDB [InputDef]
inputs' [TopicDef]
topics' [TypeDef]
types'
mergeInputs :: Monad m
=> [InputDef] -> [InputDef] -> ExceptT ErrorTriplet m [InputDef]
mergeInputs :: forall (m :: * -> *).
Monad m =>
[InputDef] -> [InputDef] -> ExceptT ErrorTriplet m [InputDef]
mergeInputs [InputDef]
is1 [] = [InputDef] -> ExceptT ErrorTriplet m [InputDef]
forall a. a -> ExceptT ErrorTriplet m a
forall (m :: * -> *) a. Monad m => a -> m a
return [InputDef]
is1
mergeInputs [InputDef]
is1 (InputDef
i2:[InputDef]
is2) = do
[InputDef]
is1' <- [InputDef] -> InputDef -> ExceptT ErrorTriplet m [InputDef]
forall (m :: * -> *).
Monad m =>
[InputDef] -> InputDef -> ExceptT ErrorTriplet m [InputDef]
mergeInput [InputDef]
is1 InputDef
i2
[InputDef] -> [InputDef] -> ExceptT ErrorTriplet m [InputDef]
forall (m :: * -> *).
Monad m =>
[InputDef] -> [InputDef] -> ExceptT ErrorTriplet m [InputDef]
mergeInputs [InputDef]
is1' [InputDef]
is2
mergeInput :: Monad m
=> [InputDef] -> InputDef -> ExceptT ErrorTriplet m [InputDef]
mergeInput :: forall (m :: * -> *).
Monad m =>
[InputDef] -> InputDef -> ExceptT ErrorTriplet m [InputDef]
mergeInput [] InputDef
i2 = [InputDef] -> ExceptT ErrorTriplet m [InputDef]
forall a. a -> ExceptT ErrorTriplet m a
forall (m :: * -> *) a. Monad m => a -> m a
return [InputDef
i2]
mergeInput (InputDef
i1:[InputDef]
is1) InputDef
i2
| InputDef -> String
inputName InputDef
i1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== InputDef -> String
inputName InputDef
i2
Bool -> Bool -> Bool
&& ( Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing (InputDef -> Maybe String
inputType InputDef
i1)
Bool -> Bool -> Bool
|| Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing (InputDef -> Maybe String
inputType InputDef
i2)
Bool -> Bool -> Bool
|| InputDef -> Maybe String
inputType InputDef
i1 Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== InputDef -> Maybe String
inputType InputDef
i2
)
= do [Connection]
cs <- [Connection] -> [Connection] -> ExceptT ErrorTriplet m [Connection]
forall (m :: * -> *).
Monad m =>
[Connection] -> [Connection] -> ExceptT ErrorTriplet m [Connection]
mergeConnections (InputDef -> [Connection]
inputConnections InputDef
i1) (InputDef -> [Connection]
inputConnections InputDef
i2)
let i1' :: InputDef
i1' = InputDef
i1 { inputType =
mergeMaybe (inputType i1) (inputType i2)
, inputConnections =
cs
}
[InputDef] -> ExceptT ErrorTriplet m [InputDef]
forall a. a -> ExceptT ErrorTriplet m a
forall (m :: * -> *) a. Monad m => a -> m a
return (InputDef
i1' InputDef -> [InputDef] -> [InputDef]
forall a. a -> [a] -> [a]
: [InputDef]
is1)
| Bool
otherwise
= do [InputDef]
is1' <- [InputDef] -> InputDef -> ExceptT ErrorTriplet m [InputDef]
forall (m :: * -> *).
Monad m =>
[InputDef] -> InputDef -> ExceptT ErrorTriplet m [InputDef]
mergeInput [InputDef]
is1 InputDef
i2
[InputDef] -> ExceptT ErrorTriplet m [InputDef]
forall a. a -> ExceptT ErrorTriplet m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([InputDef] -> ExceptT ErrorTriplet m [InputDef])
-> [InputDef] -> ExceptT ErrorTriplet m [InputDef]
forall a b. (a -> b) -> a -> b
$ InputDef
i1 InputDef -> [InputDef] -> [InputDef]
forall a. a -> [a] -> [a]
: [InputDef]
is1'
mergeConnections :: Monad m
=> [Connection] -> [Connection] -> ExceptT ErrorTriplet m [Connection]
mergeConnections :: forall (m :: * -> *).
Monad m =>
[Connection] -> [Connection] -> ExceptT ErrorTriplet m [Connection]
mergeConnections [Connection]
cs1 [] = [Connection] -> ExceptT ErrorTriplet m [Connection]
forall a. a -> ExceptT ErrorTriplet m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Connection]
cs1
mergeConnections [Connection]
cs1 (Connection
c2:[Connection]
cs2) = do
[Connection]
cs1' <- [Connection] -> Connection -> ExceptT ErrorTriplet m [Connection]
forall (m :: * -> *).
Monad m =>
[Connection] -> Connection -> ExceptT ErrorTriplet m [Connection]
mergeConnection [Connection]
cs1 Connection
c2
[Connection] -> [Connection] -> ExceptT ErrorTriplet m [Connection]
forall (m :: * -> *).
Monad m =>
[Connection] -> [Connection] -> ExceptT ErrorTriplet m [Connection]
mergeConnections [Connection]
cs1' [Connection]
cs2
mergeConnection :: Monad m
=> [Connection] -> Connection -> ExceptT ErrorTriplet m [Connection]
mergeConnection :: forall (m :: * -> *).
Monad m =>
[Connection] -> Connection -> ExceptT ErrorTriplet m [Connection]
mergeConnection [] Connection
c2 = [Connection] -> ExceptT ErrorTriplet m [Connection]
forall a. a -> ExceptT ErrorTriplet m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Connection
c2]
mergeConnection (Connection
c1:[Connection]
cs1) Connection
c2
| Connection
c1 Connection -> Connection -> Bool
forall a. Eq a => a -> a -> Bool
== Connection
c2
= [Connection] -> ExceptT ErrorTriplet m [Connection]
forall a. a -> ExceptT ErrorTriplet m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Connection] -> ExceptT ErrorTriplet m [Connection])
-> [Connection] -> ExceptT ErrorTriplet m [Connection]
forall a b. (a -> b) -> a -> b
$ Connection
c1 Connection -> [Connection] -> [Connection]
forall a. a -> [a] -> [a]
: [Connection]
cs1
| Connection -> String
connectionScope Connection
c1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Connection -> String
connectionScope Connection
c2
= ErrorTriplet -> ExceptT ErrorTriplet m [Connection]
forall a. ErrorTriplet -> ExceptT ErrorTriplet m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ErrorTriplet -> ExceptT ErrorTriplet m [Connection])
-> ErrorTriplet -> ExceptT ErrorTriplet m [Connection]
forall a b. (a -> b) -> a -> b
$
String -> ErrorTriplet
cannotMergeVariableDBs String
"connections with the same scopes"
| Bool
otherwise
= do [Connection]
cs1' <- [Connection] -> Connection -> ExceptT ErrorTriplet m [Connection]
forall (m :: * -> *).
Monad m =>
[Connection] -> Connection -> ExceptT ErrorTriplet m [Connection]
mergeConnection [Connection]
cs1 Connection
c2
[Connection] -> ExceptT ErrorTriplet m [Connection]
forall a. a -> ExceptT ErrorTriplet m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Connection
c1 Connection -> [Connection] -> [Connection]
forall a. a -> [a] -> [a]
: [Connection]
cs1')
mergeTopics :: Monad m
=> [TopicDef] -> [TopicDef] -> ExceptT ErrorTriplet m [TopicDef]
mergeTopics :: forall (m :: * -> *).
Monad m =>
[TopicDef] -> [TopicDef] -> ExceptT ErrorTriplet m [TopicDef]
mergeTopics [TopicDef]
ts1 [] = [TopicDef] -> ExceptT ErrorTriplet m [TopicDef]
forall a. a -> ExceptT ErrorTriplet m a
forall (m :: * -> *) a. Monad m => a -> m a
return [TopicDef]
ts1
mergeTopics [TopicDef]
ts1 (TopicDef
t2:[TopicDef]
ts2) = do
[TopicDef]
ts1' <- [TopicDef] -> TopicDef -> ExceptT ErrorTriplet m [TopicDef]
forall (m :: * -> *).
Monad m =>
[TopicDef] -> TopicDef -> ExceptT ErrorTriplet m [TopicDef]
mergeTopic [TopicDef]
ts1 TopicDef
t2
[TopicDef] -> [TopicDef] -> ExceptT ErrorTriplet m [TopicDef]
forall (m :: * -> *).
Monad m =>
[TopicDef] -> [TopicDef] -> ExceptT ErrorTriplet m [TopicDef]
mergeTopics [TopicDef]
ts1' [TopicDef]
ts2
mergeTopic :: Monad m
=> [TopicDef] -> TopicDef -> ExceptT ErrorTriplet m [TopicDef]
mergeTopic :: forall (m :: * -> *).
Monad m =>
[TopicDef] -> TopicDef -> ExceptT ErrorTriplet m [TopicDef]
mergeTopic [] TopicDef
t2 = [TopicDef] -> ExceptT ErrorTriplet m [TopicDef]
forall a. a -> ExceptT ErrorTriplet m a
forall (m :: * -> *) a. Monad m => a -> m a
return [TopicDef
t2]
mergeTopic (TopicDef
t1:[TopicDef]
ts1) TopicDef
t2
| TopicDef
t1 TopicDef -> TopicDef -> Bool
forall a. Eq a => a -> a -> Bool
== TopicDef
t2
= [TopicDef] -> ExceptT ErrorTriplet m [TopicDef]
forall a. a -> ExceptT ErrorTriplet m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([TopicDef] -> ExceptT ErrorTriplet m [TopicDef])
-> [TopicDef] -> ExceptT ErrorTriplet m [TopicDef]
forall a b. (a -> b) -> a -> b
$ TopicDef
t1 TopicDef -> [TopicDef] -> [TopicDef]
forall a. a -> [a] -> [a]
: [TopicDef]
ts1
| TopicDef -> String
topicScope TopicDef
t1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== TopicDef -> String
topicScope TopicDef
t2 Bool -> Bool -> Bool
&& TopicDef -> String
topicTopic TopicDef
t1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== TopicDef -> String
topicTopic TopicDef
t2
= ErrorTriplet -> ExceptT ErrorTriplet m [TopicDef]
forall a. ErrorTriplet -> ExceptT ErrorTriplet m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ErrorTriplet -> ExceptT ErrorTriplet m [TopicDef])
-> ErrorTriplet -> ExceptT ErrorTriplet m [TopicDef]
forall a b. (a -> b) -> a -> b
$
String -> ErrorTriplet
cannotMergeVariableDBs String
"topics with the same scopes and different types"
| Bool
otherwise
= do [TopicDef]
ts1' <- [TopicDef] -> TopicDef -> ExceptT ErrorTriplet m [TopicDef]
forall (m :: * -> *).
Monad m =>
[TopicDef] -> TopicDef -> ExceptT ErrorTriplet m [TopicDef]
mergeTopic [TopicDef]
ts1 TopicDef
t2
[TopicDef] -> ExceptT ErrorTriplet m [TopicDef]
forall a. a -> ExceptT ErrorTriplet m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TopicDef
t1 TopicDef -> [TopicDef] -> [TopicDef]
forall a. a -> [a] -> [a]
: [TopicDef]
ts1')
mergeTypes :: Monad m
=> [TypeDef] -> [TypeDef] -> ExceptT ErrorTriplet m [TypeDef]
mergeTypes :: forall (m :: * -> *).
Monad m =>
[TypeDef] -> [TypeDef] -> ExceptT ErrorTriplet m [TypeDef]
mergeTypes [TypeDef]
ts1 [] = [TypeDef] -> ExceptT ErrorTriplet m [TypeDef]
forall a. a -> ExceptT ErrorTriplet m a
forall (m :: * -> *) a. Monad m => a -> m a
return [TypeDef]
ts1
mergeTypes [TypeDef]
ts1 (TypeDef
t2:[TypeDef]
ts2) = do
[TypeDef]
ts1' <- [TypeDef] -> TypeDef -> ExceptT ErrorTriplet m [TypeDef]
forall (m :: * -> *).
Monad m =>
[TypeDef] -> TypeDef -> ExceptT ErrorTriplet m [TypeDef]
mergeType [TypeDef]
ts1 TypeDef
t2
[TypeDef] -> [TypeDef] -> ExceptT ErrorTriplet m [TypeDef]
forall (m :: * -> *).
Monad m =>
[TypeDef] -> [TypeDef] -> ExceptT ErrorTriplet m [TypeDef]
mergeTypes [TypeDef]
ts1' [TypeDef]
ts2
mergeType :: Monad m
=> [TypeDef] -> TypeDef -> ExceptT ErrorTriplet m [TypeDef]
mergeType :: forall (m :: * -> *).
Monad m =>
[TypeDef] -> TypeDef -> ExceptT ErrorTriplet m [TypeDef]
mergeType [] TypeDef
t2 = [TypeDef] -> ExceptT ErrorTriplet m [TypeDef]
forall a. a -> ExceptT ErrorTriplet m a
forall (m :: * -> *) a. Monad m => a -> m a
return [TypeDef
t2]
mergeType (TypeDef
t1:[TypeDef]
ts1) TypeDef
t2
| TypeDef
t1 TypeDef -> TypeDef -> Bool
forall a. Eq a => a -> a -> Bool
== TypeDef
t2
= [TypeDef] -> ExceptT ErrorTriplet m [TypeDef]
forall a. a -> ExceptT ErrorTriplet m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([TypeDef] -> ExceptT ErrorTriplet m [TypeDef])
-> [TypeDef] -> ExceptT ErrorTriplet m [TypeDef]
forall a b. (a -> b) -> a -> b
$ TypeDef
t1 TypeDef -> [TypeDef] -> [TypeDef]
forall a. a -> [a] -> [a]
: [TypeDef]
ts1
| TypeDef -> String
typeFromScope TypeDef
t1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== TypeDef -> String
typeFromScope TypeDef
t2
Bool -> Bool -> Bool
&& TypeDef -> String
typeFromType TypeDef
t1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== TypeDef -> String
typeFromType TypeDef
t2
Bool -> Bool -> Bool
&& TypeDef -> String
typeToScope TypeDef
t1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== TypeDef -> String
typeToScope TypeDef
t2
= ErrorTriplet -> ExceptT ErrorTriplet m [TypeDef]
forall a. ErrorTriplet -> ExceptT ErrorTriplet m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ErrorTriplet -> ExceptT ErrorTriplet m [TypeDef])
-> ErrorTriplet -> ExceptT ErrorTriplet m [TypeDef]
forall a b. (a -> b) -> a -> b
$
String -> ErrorTriplet
cannotMergeVariableDBs
String
"types with the same scopes and from types but otherwise different"
| Bool
otherwise
= do [TypeDef]
ts1' <- [TypeDef] -> TypeDef -> ExceptT ErrorTriplet m [TypeDef]
forall (m :: * -> *).
Monad m =>
[TypeDef] -> TypeDef -> ExceptT ErrorTriplet m [TypeDef]
mergeType [TypeDef]
ts1 TypeDef
t2
[TypeDef] -> ExceptT ErrorTriplet m [TypeDef]
forall a. a -> ExceptT ErrorTriplet m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeDef
t1 TypeDef -> [TypeDef] -> [TypeDef]
forall a. a -> [a] -> [a]
: [TypeDef]
ts1')
cannotMergeVariableDBs :: String -> ErrorTriplet
cannotMergeVariableDBs :: String -> ErrorTriplet
cannotMergeVariableDBs String
element =
Int -> String -> Location -> ErrorTriplet
ErrorTriplet Int
ecCannotMergeVariableDB String
msg Location
LocationNothing
where
msg :: String
msg =
String
"Reading variable DBs has failed due to them having incompatible"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" information for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
element String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"."
ecCannotMergeVariableDB :: ErrorCode
ecCannotMergeVariableDB :: Int
ecCannotMergeVariableDB = Int
1
mergeMaybe :: Maybe a -> Maybe a -> Maybe a
mergeMaybe :: forall a. Maybe a -> Maybe a -> Maybe a
mergeMaybe Maybe a
Nothing Maybe a
x = Maybe a
x
mergeMaybe Maybe a
x Maybe a
Nothing = Maybe a
x
mergeMaybe Maybe a
x Maybe a
_ = Maybe a
x
deriveFromJSON
defaultOptions {fieldLabelModifier = toHead toLower . drop 4 }
''TypeDef
deriveFromJSON
defaultOptions {fieldLabelModifier = toHead toLower . drop 5 }
''TopicDef
deriveFromJSON
defaultOptions {fieldLabelModifier = toHead toLower . drop 10 }
''Connection
deriveFromJSON
defaultOptions {fieldLabelModifier = toHead toLower . drop 5 }
''InputDef
instance FromJSON VariableDB