{-# LANGUAGE DeriveGeneric   #-}
{-# LANGUAGE TemplateHaskell #-}
-- Copyright 2022 United States Government as represented by the Administrator
-- of the National Aeronautics and Space Administration. All Rights Reserved.
--
-- Disclaimers
--
-- No Warranty: THE SUBJECT SOFTWARE IS PROVIDED "AS IS" WITHOUT ANY WARRANTY
-- OF ANY KIND, EITHER EXPRESSED, IMPLIED, OR STATUTORY, INCLUDING, BUT NOT
-- LIMITED TO, ANY WARRANTY THAT THE SUBJECT SOFTWARE WILL CONFORM TO
-- SPECIFICATIONS, ANY IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A
-- PARTICULAR PURPOSE, OR FREEDOM FROM INFRINGEMENT, ANY WARRANTY THAT THE
-- SUBJECT SOFTWARE WILL BE ERROR FREE, OR ANY WARRANTY THAT DOCUMENTATION, IF
-- PROVIDED, WILL CONFORM TO THE SUBJECT SOFTWARE. THIS AGREEMENT DOES NOT, IN
-- ANY MANNER, CONSTITUTE AN ENDORSEMENT BY GOVERNMENT AGENCY OR ANY PRIOR
-- RECIPIENT OF ANY RESULTS, RESULTING DESIGNS, HARDWARE, SOFTWARE PRODUCTS OR
-- ANY OTHER APPLICATIONS RESULTING FROM USE OF THE SUBJECT SOFTWARE. FURTHER,
-- GOVERNMENT AGENCY DISCLAIMS ALL WARRANTIES AND LIABILITIES REGARDING
-- THIRD-PARTY SOFTWARE, IF PRESENT IN THE ORIGINAL SOFTWARE, AND DISTRIBUTES
-- IT "AS IS."
--
-- Waiver and Indemnity: RECIPIENT AGREES TO WAIVE ANY AND ALL CLAIMS AGAINST
-- THE UNITED STATES GOVERNMENT, ITS CONTRACTORS AND SUBCONTRACTORS, AS WELL AS
-- ANY PRIOR RECIPIENT. IF RECIPIENT'S USE OF THE SUBJECT SOFTWARE RESULTS IN
-- ANY LIABILITIES, DEMANDS, DAMAGES, EXPENSES OR LOSSES ARISING FROM SUCH USE,
-- INCLUDING ANY DAMAGES FROM PRODUCTS BASED ON, OR RESULTING FROM, RECIPIENT'S
-- USE OF THE SUBJECT SOFTWARE, RECIPIENT SHALL INDEMNIFY AND HOLD HARMLESS THE
-- UNITED STATES GOVERNMENT, ITS CONTRACTORS AND SUBCONTRACTORS, AS WELL AS ANY
-- PRIOR RECIPIENT, TO THE EXTENT PERMITTED BY LAW. RECIPIENT'S SOLE REMEDY
-- FOR ANY SUCH MATTER SHALL BE THE IMMEDIATE, UNILATERAL TERMINATION OF THIS
-- AGREEMENT.
--
-- | Variable DBs.
module Command.VariableDB
    ( VariableDB(..)
    , InputDef(..)
    , Connection(..)
    , TopicDef(..)
    , TypeDef(..)
    , emptyVariableDB
    , findInput
    , findConnection
    , findTopic
    , findType
    , findTypeByType
    , mergeVariableDB
    )
  where

-- External imports
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)

-- External imports: auxiliary
import Data.List.Extra (toHead)
import Data.Location (Location(..))

-- Internal imports
import Command.Errors (ErrorTriplet(..), ErrorCode)

-- * Variable Databases

-- | A variable database.
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)

-- | Definition of an input variable.
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)

-- | Definition of a connection to a topic.
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)

-- | Definition of a topic.
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)

-- | Definition of a type or type mapping.
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)

-- | A variable database with no entries.
emptyVariableDB :: VariableDB
emptyVariableDB :: VariableDB
emptyVariableDB = [InputDef] -> [TopicDef] -> [TypeDef] -> VariableDB
VariableDB [] [] []

-- | Find an input with a given name.
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)

-- | Find a connection a given scope.
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)

-- | Find a topic a given scope and name.
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)

-- | Find a type with a given input name, scope, and destination system.
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)

-- | Find a type definition for a given scope, and destination system, and
-- destination type.
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)

-- ** Merging of variable DBs

-- | Merge two variable DBs, so long as they do not contain contradictory
-- information.
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'

-- | Merge two lists of input definitions, so long as they do not contain
-- contradictory information.
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

-- | Merge an input definition into a list of input definitions, so long as it
-- does not contain contradictory information.
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'

-- | Merge two lists of connections, so long as they do not contain
-- contradictory information.
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

-- | Merge a connection into a list of connections, so long as it does not
-- contain contradictory information.
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')

-- | Merge two lists of topics, so long as they do not contain contradictory
-- information.
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

-- | Merge a topic into a list of topics, so long as it does not contain
-- contradictory information.
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')

-- | Merge two lists of type definitions, so long as they do not contain
-- contradictory information.
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

-- | Merge a type definition into a list of type definitions, so long as it
-- does not contain contradictory information.
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')

-- | Exception handler to deal with the case of variable DB files that cannot
-- be merged due to having incompatible information.
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
"."

-- | Error: one of the variable DBs provided cannot be merged.
ecCannotMergeVariableDB :: ErrorCode
ecCannotMergeVariableDB :: Int
ecCannotMergeVariableDB = Int
1

-- | Merge two @Maybe@ values, prefering the left one if two @Just@s are
-- provided.
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

-- | Implement default instances of parser to read variable DB from JSON,
-- dropping the prefix in each field name.
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