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

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

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 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
$cto :: forall a x. Rep (Diff a) x -> Diff a
$cfrom :: forall a x. Diff a -> Rep (Diff a) x
Generic, Int -> Diff a -> ShowS
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
showList :: [Diff a] -> ShowS
$cshowList :: forall a. Show a => [Diff a] -> ShowS
show :: Diff a -> String
$cshow :: forall a. Show a => Diff a -> String
showsPrec :: Int -> Diff a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Diff a -> ShowS
Show, Diff a -> Diff a -> Bool
forall a. Eq a => Diff a -> Diff a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Diff a -> Diff a -> Bool
$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
Eq)
  deriving anyclass (forall a. NFData a => Diff a -> ()
forall a. (a -> ()) -> NFData a
rnf :: Diff a -> ()
$crnf :: forall a. NFData a => Diff a -> ()
NFData, forall a. ToJSON a => [Diff a] -> Encoding
forall a. ToJSON a => [Diff a] -> Value
forall a. ToJSON a => Diff a -> Encoding
forall a. ToJSON a => Diff a -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Diff a] -> Encoding
$ctoEncodingList :: forall a. ToJSON a => [Diff a] -> Encoding
toJSONList :: [Diff a] -> Value
$ctoJSONList :: forall a. ToJSON a => [Diff a] -> Value
toEncoding :: Diff a -> Encoding
$ctoEncoding :: forall a. ToJSON a => Diff a -> Encoding
toJSON :: Diff a -> Value
$ctoJSON :: forall a. ToJSON a => Diff a -> Value
ToJSON, 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
parseJSONList :: Value -> Parser [Diff a]
$cparseJSONList :: forall a. FromJSON a => Value -> Parser [Diff a]
parseJSON :: Value -> Parser (Diff a)
$cparseJSON :: forall a. FromJSON a => Value -> Parser (Diff a)
FromJSON)

deriving instance ToSchema a => ToSchema (Diff a)

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

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

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

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