{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE StandaloneDeriving #-}

module Hercules.API.Build.EvaluationDiff
  ( EvaluationDiff (..),
    AttributeDiff (..),
    AttributeValueDiff (..),
    Diff (..),
    IFDDiff (..),
    DerivationOutputNamePair (..),
  )
where

import Data.OpenApi qualified as O3
import Hercules.API.Attribute (Attribute)
import Hercules.API.Derivation (Derivation)
import Hercules.API.Evaluation.AttributeError (AttributeError)
import Hercules.API.Evaluation.Evaluation (Evaluation)
import Hercules.API.Prelude
import Hercules.API.Result (Result)
import Hercules.API.SimpleAttribute (SimpleAttribute)

-- | Generic type for additions, remvals and changes. Addition and removal are
-- represented by nulling the appropriate field.
--
-- This gives the best JSON representation, despite the fact that "Absence" is
-- representable: @{before: null, after: null}@. Most - if not all - endpoints
-- can be expected to not return such a value.
--
-- NOTE: Generic types must always be wrapped in a newtype, so as to avoid
--       ambiguities in the generated schema.
data Diff a = Diff {forall a. Diff a -> Maybe a
before :: Maybe a, forall a. Diff a -> Maybe a
after :: Maybe a}
  deriving ((forall x. Diff a -> Rep (Diff a) x)
-> (forall x. Rep (Diff a) x -> Diff a) -> Generic (Diff a)
forall x. Rep (Diff a) x -> Diff a
forall x. Diff a -> Rep (Diff a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Diff a) x -> Diff a
forall a x. Diff a -> Rep (Diff a) x
$cfrom :: forall a x. Diff a -> Rep (Diff a) x
from :: forall x. Diff a -> Rep (Diff a) x
$cto :: forall a x. Rep (Diff a) x -> Diff a
to :: forall x. Rep (Diff a) x -> Diff a
Generic, Int -> Diff a -> ShowS
[Diff a] -> ShowS
Diff a -> String
(Int -> Diff a -> ShowS)
-> (Diff a -> String) -> ([Diff a] -> ShowS) -> Show (Diff a)
forall a. Show a => Int -> Diff a -> ShowS
forall a. Show a => [Diff a] -> ShowS
forall a. Show a => Diff a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Diff a -> ShowS
showsPrec :: Int -> Diff a -> ShowS
$cshow :: forall a. Show a => Diff a -> String
show :: Diff a -> String
$cshowList :: forall a. Show a => [Diff a] -> ShowS
showList :: [Diff a] -> ShowS
Show, Diff a -> Diff a -> Bool
(Diff a -> Diff a -> Bool)
-> (Diff a -> Diff a -> Bool) -> Eq (Diff a)
forall a. Eq a => Diff a -> Diff a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Diff a -> Diff a -> Bool
== :: Diff a -> Diff a -> Bool
$c/= :: forall a. Eq a => Diff a -> Diff a -> Bool
/= :: Diff a -> Diff a -> Bool
Eq)
  deriving anyclass (Diff a -> ()
(Diff a -> ()) -> NFData (Diff a)
forall a. NFData a => Diff a -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall a. NFData a => Diff a -> ()
rnf :: Diff a -> ()
NFData, [Diff a] -> Value
[Diff a] -> Encoding
Diff a -> Value
Diff a -> Encoding
(Diff a -> Value)
-> (Diff a -> Encoding)
-> ([Diff a] -> Value)
-> ([Diff a] -> Encoding)
-> ToJSON (Diff a)
forall a. ToJSON a => [Diff a] -> Value
forall a. ToJSON a => [Diff a] -> Encoding
forall a. ToJSON a => Diff a -> Value
forall a. ToJSON a => Diff a -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: forall a. ToJSON a => Diff a -> Value
toJSON :: Diff a -> Value
$ctoEncoding :: forall a. ToJSON a => Diff a -> Encoding
toEncoding :: Diff a -> Encoding
$ctoJSONList :: forall a. ToJSON a => [Diff a] -> Value
toJSONList :: [Diff a] -> Value
$ctoEncodingList :: forall a. ToJSON a => [Diff a] -> Encoding
toEncodingList :: [Diff a] -> Encoding
ToJSON, Value -> Parser [Diff a]
Value -> Parser (Diff a)
(Value -> Parser (Diff a))
-> (Value -> Parser [Diff a]) -> FromJSON (Diff a)
forall a. FromJSON a => Value -> Parser [Diff a]
forall a. FromJSON a => Value -> Parser (Diff a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: forall a. FromJSON a => Value -> Parser (Diff a)
parseJSON :: Value -> Parser (Diff a)
$cparseJSONList :: forall a. FromJSON a => Value -> Parser [Diff a]
parseJSONList :: Value -> Parser [Diff a]
FromJSON)

deriving instance (ToSchema a) => ToSchema (Diff a)

deriving instance (O3.ToSchema a) => O3.ToSchema (Diff a)

newtype AttributeDiff = AttributeDiff (SimpleAttribute AttributeValueDiff)
  deriving ((forall x. AttributeDiff -> Rep AttributeDiff x)
-> (forall x. Rep AttributeDiff x -> AttributeDiff)
-> Generic AttributeDiff
forall x. Rep AttributeDiff x -> AttributeDiff
forall x. AttributeDiff -> Rep AttributeDiff x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AttributeDiff -> Rep AttributeDiff x
from :: forall x. AttributeDiff -> Rep AttributeDiff x
$cto :: forall x. Rep AttributeDiff x -> AttributeDiff
to :: forall x. Rep AttributeDiff x -> AttributeDiff
Generic, Int -> AttributeDiff -> ShowS
[AttributeDiff] -> ShowS
AttributeDiff -> String
(Int -> AttributeDiff -> ShowS)
-> (AttributeDiff -> String)
-> ([AttributeDiff] -> ShowS)
-> Show AttributeDiff
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AttributeDiff -> ShowS
showsPrec :: Int -> AttributeDiff -> ShowS
$cshow :: AttributeDiff -> String
show :: AttributeDiff -> String
$cshowList :: [AttributeDiff] -> ShowS
showList :: [AttributeDiff] -> ShowS
Show, AttributeDiff -> AttributeDiff -> Bool
(AttributeDiff -> AttributeDiff -> Bool)
-> (AttributeDiff -> AttributeDiff -> Bool) -> Eq AttributeDiff
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AttributeDiff -> AttributeDiff -> Bool
== :: AttributeDiff -> AttributeDiff -> Bool
$c/= :: AttributeDiff -> AttributeDiff -> Bool
/= :: AttributeDiff -> AttributeDiff -> Bool
Eq)
  deriving anyclass (AttributeDiff -> ()
(AttributeDiff -> ()) -> NFData AttributeDiff
forall a. (a -> ()) -> NFData a
$crnf :: AttributeDiff -> ()
rnf :: AttributeDiff -> ()
NFData, [AttributeDiff] -> Value
[AttributeDiff] -> Encoding
AttributeDiff -> Value
AttributeDiff -> Encoding
(AttributeDiff -> Value)
-> (AttributeDiff -> Encoding)
-> ([AttributeDiff] -> Value)
-> ([AttributeDiff] -> Encoding)
-> ToJSON AttributeDiff
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: AttributeDiff -> Value
toJSON :: AttributeDiff -> Value
$ctoEncoding :: AttributeDiff -> Encoding
toEncoding :: AttributeDiff -> Encoding
$ctoJSONList :: [AttributeDiff] -> Value
toJSONList :: [AttributeDiff] -> Value
$ctoEncodingList :: [AttributeDiff] -> Encoding
toEncodingList :: [AttributeDiff] -> Encoding
ToJSON, Value -> Parser [AttributeDiff]
Value -> Parser AttributeDiff
(Value -> Parser AttributeDiff)
-> (Value -> Parser [AttributeDiff]) -> FromJSON AttributeDiff
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser AttributeDiff
parseJSON :: Value -> Parser AttributeDiff
$cparseJSONList :: Value -> Parser [AttributeDiff]
parseJSONList :: Value -> Parser [AttributeDiff]
FromJSON, Proxy AttributeDiff -> Declare (Definitions Schema) NamedSchema
(Proxy AttributeDiff -> Declare (Definitions Schema) NamedSchema)
-> ToSchema AttributeDiff
forall a.
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy AttributeDiff -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy AttributeDiff -> Declare (Definitions Schema) NamedSchema
ToSchema, Typeable AttributeDiff
Typeable AttributeDiff
-> (Proxy AttributeDiff
    -> Declare (Definitions Schema) NamedSchema)
-> ToSchema AttributeDiff
Proxy AttributeDiff -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a
-> (Proxy a -> Declare (Definitions Schema) NamedSchema)
-> ToSchema a
$cdeclareNamedSchema :: Proxy AttributeDiff -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy AttributeDiff -> Declare (Definitions Schema) NamedSchema
O3.ToSchema)

newtype AttributeValueDiff = AttributeValueDiff (Diff (Attribute (Result AttributeError Derivation)))
  deriving ((forall x. AttributeValueDiff -> Rep AttributeValueDiff x)
-> (forall x. Rep AttributeValueDiff x -> AttributeValueDiff)
-> Generic AttributeValueDiff
forall x. Rep AttributeValueDiff x -> AttributeValueDiff
forall x. AttributeValueDiff -> Rep AttributeValueDiff x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AttributeValueDiff -> Rep AttributeValueDiff x
from :: forall x. AttributeValueDiff -> Rep AttributeValueDiff x
$cto :: forall x. Rep AttributeValueDiff x -> AttributeValueDiff
to :: forall x. Rep AttributeValueDiff x -> AttributeValueDiff
Generic, Int -> AttributeValueDiff -> ShowS
[AttributeValueDiff] -> ShowS
AttributeValueDiff -> String
(Int -> AttributeValueDiff -> ShowS)
-> (AttributeValueDiff -> String)
-> ([AttributeValueDiff] -> ShowS)
-> Show AttributeValueDiff
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AttributeValueDiff -> ShowS
showsPrec :: Int -> AttributeValueDiff -> ShowS
$cshow :: AttributeValueDiff -> String
show :: AttributeValueDiff -> String
$cshowList :: [AttributeValueDiff] -> ShowS
showList :: [AttributeValueDiff] -> ShowS
Show, AttributeValueDiff -> AttributeValueDiff -> Bool
(AttributeValueDiff -> AttributeValueDiff -> Bool)
-> (AttributeValueDiff -> AttributeValueDiff -> Bool)
-> Eq AttributeValueDiff
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AttributeValueDiff -> AttributeValueDiff -> Bool
== :: AttributeValueDiff -> AttributeValueDiff -> Bool
$c/= :: AttributeValueDiff -> AttributeValueDiff -> Bool
/= :: AttributeValueDiff -> AttributeValueDiff -> Bool
Eq)
  deriving anyclass (AttributeValueDiff -> ()
(AttributeValueDiff -> ()) -> NFData AttributeValueDiff
forall a. (a -> ()) -> NFData a
$crnf :: AttributeValueDiff -> ()
rnf :: AttributeValueDiff -> ()
NFData, [AttributeValueDiff] -> Value
[AttributeValueDiff] -> Encoding
AttributeValueDiff -> Value
AttributeValueDiff -> Encoding
(AttributeValueDiff -> Value)
-> (AttributeValueDiff -> Encoding)
-> ([AttributeValueDiff] -> Value)
-> ([AttributeValueDiff] -> Encoding)
-> ToJSON AttributeValueDiff
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: AttributeValueDiff -> Value
toJSON :: AttributeValueDiff -> Value
$ctoEncoding :: AttributeValueDiff -> Encoding
toEncoding :: AttributeValueDiff -> Encoding
$ctoJSONList :: [AttributeValueDiff] -> Value
toJSONList :: [AttributeValueDiff] -> Value
$ctoEncodingList :: [AttributeValueDiff] -> Encoding
toEncodingList :: [AttributeValueDiff] -> Encoding
ToJSON, Value -> Parser [AttributeValueDiff]
Value -> Parser AttributeValueDiff
(Value -> Parser AttributeValueDiff)
-> (Value -> Parser [AttributeValueDiff])
-> FromJSON AttributeValueDiff
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser AttributeValueDiff
parseJSON :: Value -> Parser AttributeValueDiff
$cparseJSONList :: Value -> Parser [AttributeValueDiff]
parseJSONList :: Value -> Parser [AttributeValueDiff]
FromJSON, Proxy AttributeValueDiff
-> Declare (Definitions Schema) NamedSchema
(Proxy AttributeValueDiff
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema AttributeValueDiff
forall a.
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy AttributeValueDiff
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy AttributeValueDiff
-> Declare (Definitions Schema) NamedSchema
ToSchema, Typeable AttributeValueDiff
Typeable AttributeValueDiff
-> (Proxy AttributeValueDiff
    -> Declare (Definitions Schema) NamedSchema)
-> ToSchema AttributeValueDiff
Proxy AttributeValueDiff
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a
-> (Proxy a -> Declare (Definitions Schema) NamedSchema)
-> ToSchema a
$cdeclareNamedSchema :: Proxy AttributeValueDiff
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy AttributeValueDiff
-> Declare (Definitions Schema) NamedSchema
O3.ToSchema)

newtype IFDDiff = IFDDiff (Diff DerivationOutputNamePair)
  deriving ((forall x. IFDDiff -> Rep IFDDiff x)
-> (forall x. Rep IFDDiff x -> IFDDiff) -> Generic IFDDiff
forall x. Rep IFDDiff x -> IFDDiff
forall x. IFDDiff -> Rep IFDDiff x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IFDDiff -> Rep IFDDiff x
from :: forall x. IFDDiff -> Rep IFDDiff x
$cto :: forall x. Rep IFDDiff x -> IFDDiff
to :: forall x. Rep IFDDiff x -> IFDDiff
Generic, Int -> IFDDiff -> ShowS
[IFDDiff] -> ShowS
IFDDiff -> String
(Int -> IFDDiff -> ShowS)
-> (IFDDiff -> String) -> ([IFDDiff] -> ShowS) -> Show IFDDiff
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IFDDiff -> ShowS
showsPrec :: Int -> IFDDiff -> ShowS
$cshow :: IFDDiff -> String
show :: IFDDiff -> String
$cshowList :: [IFDDiff] -> ShowS
showList :: [IFDDiff] -> ShowS
Show, IFDDiff -> IFDDiff -> Bool
(IFDDiff -> IFDDiff -> Bool)
-> (IFDDiff -> IFDDiff -> Bool) -> Eq IFDDiff
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IFDDiff -> IFDDiff -> Bool
== :: IFDDiff -> IFDDiff -> Bool
$c/= :: IFDDiff -> IFDDiff -> Bool
/= :: IFDDiff -> IFDDiff -> Bool
Eq)
  deriving anyclass (IFDDiff -> ()
(IFDDiff -> ()) -> NFData IFDDiff
forall a. (a -> ()) -> NFData a
$crnf :: IFDDiff -> ()
rnf :: IFDDiff -> ()
NFData, [IFDDiff] -> Value
[IFDDiff] -> Encoding
IFDDiff -> Value
IFDDiff -> Encoding
(IFDDiff -> Value)
-> (IFDDiff -> Encoding)
-> ([IFDDiff] -> Value)
-> ([IFDDiff] -> Encoding)
-> ToJSON IFDDiff
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: IFDDiff -> Value
toJSON :: IFDDiff -> Value
$ctoEncoding :: IFDDiff -> Encoding
toEncoding :: IFDDiff -> Encoding
$ctoJSONList :: [IFDDiff] -> Value
toJSONList :: [IFDDiff] -> Value
$ctoEncodingList :: [IFDDiff] -> Encoding
toEncodingList :: [IFDDiff] -> Encoding
ToJSON, Value -> Parser [IFDDiff]
Value -> Parser IFDDiff
(Value -> Parser IFDDiff)
-> (Value -> Parser [IFDDiff]) -> FromJSON IFDDiff
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser IFDDiff
parseJSON :: Value -> Parser IFDDiff
$cparseJSONList :: Value -> Parser [IFDDiff]
parseJSONList :: Value -> Parser [IFDDiff]
FromJSON, Proxy IFDDiff -> Declare (Definitions Schema) NamedSchema
(Proxy IFDDiff -> Declare (Definitions Schema) NamedSchema)
-> ToSchema IFDDiff
forall a.
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy IFDDiff -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy IFDDiff -> Declare (Definitions Schema) NamedSchema
ToSchema, Typeable IFDDiff
Typeable IFDDiff
-> (Proxy IFDDiff -> Declare (Definitions Schema) NamedSchema)
-> ToSchema IFDDiff
Proxy IFDDiff -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a
-> (Proxy a -> Declare (Definitions Schema) NamedSchema)
-> ToSchema a
$cdeclareNamedSchema :: Proxy IFDDiff -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy IFDDiff -> Declare (Definitions Schema) NamedSchema
O3.ToSchema)

data DerivationOutputNamePair = DerivationOutputNamePair
  { DerivationOutputNamePair -> Derivation
derivation :: Derivation,
    DerivationOutputNamePair -> Text
outputName :: Text
  }
  deriving ((forall x.
 DerivationOutputNamePair -> Rep DerivationOutputNamePair x)
-> (forall x.
    Rep DerivationOutputNamePair x -> DerivationOutputNamePair)
-> Generic DerivationOutputNamePair
forall x.
Rep DerivationOutputNamePair x -> DerivationOutputNamePair
forall x.
DerivationOutputNamePair -> Rep DerivationOutputNamePair x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
DerivationOutputNamePair -> Rep DerivationOutputNamePair x
from :: forall x.
DerivationOutputNamePair -> Rep DerivationOutputNamePair x
$cto :: forall x.
Rep DerivationOutputNamePair x -> DerivationOutputNamePair
to :: forall x.
Rep DerivationOutputNamePair x -> DerivationOutputNamePair
Generic, Int -> DerivationOutputNamePair -> ShowS
[DerivationOutputNamePair] -> ShowS
DerivationOutputNamePair -> String
(Int -> DerivationOutputNamePair -> ShowS)
-> (DerivationOutputNamePair -> String)
-> ([DerivationOutputNamePair] -> ShowS)
-> Show DerivationOutputNamePair
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DerivationOutputNamePair -> ShowS
showsPrec :: Int -> DerivationOutputNamePair -> ShowS
$cshow :: DerivationOutputNamePair -> String
show :: DerivationOutputNamePair -> String
$cshowList :: [DerivationOutputNamePair] -> ShowS
showList :: [DerivationOutputNamePair] -> ShowS
Show, DerivationOutputNamePair -> DerivationOutputNamePair -> Bool
(DerivationOutputNamePair -> DerivationOutputNamePair -> Bool)
-> (DerivationOutputNamePair -> DerivationOutputNamePair -> Bool)
-> Eq DerivationOutputNamePair
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DerivationOutputNamePair -> DerivationOutputNamePair -> Bool
== :: DerivationOutputNamePair -> DerivationOutputNamePair -> Bool
$c/= :: DerivationOutputNamePair -> DerivationOutputNamePair -> Bool
/= :: DerivationOutputNamePair -> DerivationOutputNamePair -> Bool
Eq)
  deriving anyclass (DerivationOutputNamePair -> ()
(DerivationOutputNamePair -> ()) -> NFData DerivationOutputNamePair
forall a. (a -> ()) -> NFData a
$crnf :: DerivationOutputNamePair -> ()
rnf :: DerivationOutputNamePair -> ()
NFData, [DerivationOutputNamePair] -> Value
[DerivationOutputNamePair] -> Encoding
DerivationOutputNamePair -> Value
DerivationOutputNamePair -> Encoding
(DerivationOutputNamePair -> Value)
-> (DerivationOutputNamePair -> Encoding)
-> ([DerivationOutputNamePair] -> Value)
-> ([DerivationOutputNamePair] -> Encoding)
-> ToJSON DerivationOutputNamePair
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: DerivationOutputNamePair -> Value
toJSON :: DerivationOutputNamePair -> Value
$ctoEncoding :: DerivationOutputNamePair -> Encoding
toEncoding :: DerivationOutputNamePair -> Encoding
$ctoJSONList :: [DerivationOutputNamePair] -> Value
toJSONList :: [DerivationOutputNamePair] -> Value
$ctoEncodingList :: [DerivationOutputNamePair] -> Encoding
toEncodingList :: [DerivationOutputNamePair] -> Encoding
ToJSON, Value -> Parser [DerivationOutputNamePair]
Value -> Parser DerivationOutputNamePair
(Value -> Parser DerivationOutputNamePair)
-> (Value -> Parser [DerivationOutputNamePair])
-> FromJSON DerivationOutputNamePair
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser DerivationOutputNamePair
parseJSON :: Value -> Parser DerivationOutputNamePair
$cparseJSONList :: Value -> Parser [DerivationOutputNamePair]
parseJSONList :: Value -> Parser [DerivationOutputNamePair]
FromJSON, Proxy DerivationOutputNamePair
-> Declare (Definitions Schema) NamedSchema
(Proxy DerivationOutputNamePair
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema DerivationOutputNamePair
forall a.
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy DerivationOutputNamePair
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy DerivationOutputNamePair
-> Declare (Definitions Schema) NamedSchema
ToSchema, Typeable DerivationOutputNamePair
Typeable DerivationOutputNamePair
-> (Proxy DerivationOutputNamePair
    -> Declare (Definitions Schema) NamedSchema)
-> ToSchema DerivationOutputNamePair
Proxy DerivationOutputNamePair
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a
-> (Proxy a -> Declare (Definitions Schema) NamedSchema)
-> ToSchema a
$cdeclareNamedSchema :: Proxy DerivationOutputNamePair
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy DerivationOutputNamePair
-> Declare (Definitions Schema) NamedSchema
O3.ToSchema)

data EvaluationDiff = EvaluationDiff
  { EvaluationDiff -> Id Evaluation
beforeId :: Id Evaluation,
    EvaluationDiff -> Id Evaluation
afterId :: Id Evaluation,
    EvaluationDiff -> [AttributeDiff]
attributes :: [AttributeDiff],
    EvaluationDiff -> [IFDDiff]
ifds :: [IFDDiff]
  }
  deriving ((forall x. EvaluationDiff -> Rep EvaluationDiff x)
-> (forall x. Rep EvaluationDiff x -> EvaluationDiff)
-> Generic EvaluationDiff
forall x. Rep EvaluationDiff x -> EvaluationDiff
forall x. EvaluationDiff -> Rep EvaluationDiff x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EvaluationDiff -> Rep EvaluationDiff x
from :: forall x. EvaluationDiff -> Rep EvaluationDiff x
$cto :: forall x. Rep EvaluationDiff x -> EvaluationDiff
to :: forall x. Rep EvaluationDiff x -> EvaluationDiff
Generic, Int -> EvaluationDiff -> ShowS
[EvaluationDiff] -> ShowS
EvaluationDiff -> String
(Int -> EvaluationDiff -> ShowS)
-> (EvaluationDiff -> String)
-> ([EvaluationDiff] -> ShowS)
-> Show EvaluationDiff
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EvaluationDiff -> ShowS
showsPrec :: Int -> EvaluationDiff -> ShowS
$cshow :: EvaluationDiff -> String
show :: EvaluationDiff -> String
$cshowList :: [EvaluationDiff] -> ShowS
showList :: [EvaluationDiff] -> ShowS
Show, EvaluationDiff -> EvaluationDiff -> Bool
(EvaluationDiff -> EvaluationDiff -> Bool)
-> (EvaluationDiff -> EvaluationDiff -> Bool) -> Eq EvaluationDiff
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EvaluationDiff -> EvaluationDiff -> Bool
== :: EvaluationDiff -> EvaluationDiff -> Bool
$c/= :: EvaluationDiff -> EvaluationDiff -> Bool
/= :: EvaluationDiff -> EvaluationDiff -> Bool
Eq)
  deriving anyclass (EvaluationDiff -> ()
(EvaluationDiff -> ()) -> NFData EvaluationDiff
forall a. (a -> ()) -> NFData a
$crnf :: EvaluationDiff -> ()
rnf :: EvaluationDiff -> ()
NFData, [EvaluationDiff] -> Value
[EvaluationDiff] -> Encoding
EvaluationDiff -> Value
EvaluationDiff -> Encoding
(EvaluationDiff -> Value)
-> (EvaluationDiff -> Encoding)
-> ([EvaluationDiff] -> Value)
-> ([EvaluationDiff] -> Encoding)
-> ToJSON EvaluationDiff
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: EvaluationDiff -> Value
toJSON :: EvaluationDiff -> Value
$ctoEncoding :: EvaluationDiff -> Encoding
toEncoding :: EvaluationDiff -> Encoding
$ctoJSONList :: [EvaluationDiff] -> Value
toJSONList :: [EvaluationDiff] -> Value
$ctoEncodingList :: [EvaluationDiff] -> Encoding
toEncodingList :: [EvaluationDiff] -> Encoding
ToJSON, Value -> Parser [EvaluationDiff]
Value -> Parser EvaluationDiff
(Value -> Parser EvaluationDiff)
-> (Value -> Parser [EvaluationDiff]) -> FromJSON EvaluationDiff
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser EvaluationDiff
parseJSON :: Value -> Parser EvaluationDiff
$cparseJSONList :: Value -> Parser [EvaluationDiff]
parseJSONList :: Value -> Parser [EvaluationDiff]
FromJSON, Proxy EvaluationDiff -> Declare (Definitions Schema) NamedSchema
(Proxy EvaluationDiff -> Declare (Definitions Schema) NamedSchema)
-> ToSchema EvaluationDiff
forall a.
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy EvaluationDiff -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy EvaluationDiff -> Declare (Definitions Schema) NamedSchema
ToSchema, Typeable EvaluationDiff
Typeable EvaluationDiff
-> (Proxy EvaluationDiff
    -> Declare (Definitions Schema) NamedSchema)
-> ToSchema EvaluationDiff
Proxy EvaluationDiff -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a
-> (Proxy a -> Declare (Definitions Schema) NamedSchema)
-> ToSchema a
$cdeclareNamedSchema :: Proxy EvaluationDiff -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy EvaluationDiff -> Declare (Definitions Schema) NamedSchema
O3.ToSchema)