{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}

module Hercules.API.Message where

import Data.OpenApi qualified as O3
import Hercules.API.Prelude

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

data Type
  = -- | Something went wrong, inform user about possible
    -- cause. Examples: source could not be fetched, could not
    -- find a nix expression file to call.
    Error
  | -- | The nix expression contained a @builtins.trace@
    -- call. Ideally we should keep track of during which
    -- attribute it was encountered. It is not an attribute
    -- property because we can not reasonably know which
    -- attributes (plural) trigger the evaluation of
    -- @trace@. Indeed side effecting evaluation breaks the
    -- abstraction.
    Trace
  deriving ((forall x. Type -> Rep Type x)
-> (forall x. Rep Type x -> Type) -> Generic Type
forall x. Rep Type x -> Type
forall x. Type -> Rep Type x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Type -> Rep Type x
from :: forall x. Type -> Rep Type x
$cto :: forall x. Rep Type x -> Type
to :: forall x. Rep Type x -> Type
Generic, Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
(Int -> Type -> ShowS)
-> (Type -> String) -> ([Type] -> ShowS) -> Show Type
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Type -> ShowS
showsPrec :: Int -> Type -> ShowS
$cshow :: Type -> String
show :: Type -> String
$cshowList :: [Type] -> ShowS
showList :: [Type] -> ShowS
Show, Type -> Type -> Bool
(Type -> Type -> Bool) -> (Type -> Type -> Bool) -> Eq Type
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
/= :: Type -> Type -> Bool
Eq)
  deriving anyclass (Type -> ()
(Type -> ()) -> NFData Type
forall a. (a -> ()) -> NFData a
$crnf :: Type -> ()
rnf :: Type -> ()
NFData, [Type] -> Value
[Type] -> Encoding
Type -> Value
Type -> Encoding
(Type -> Value)
-> (Type -> Encoding)
-> ([Type] -> Value)
-> ([Type] -> Encoding)
-> ToJSON Type
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Type -> Value
toJSON :: Type -> Value
$ctoEncoding :: Type -> Encoding
toEncoding :: Type -> Encoding
$ctoJSONList :: [Type] -> Value
toJSONList :: [Type] -> Value
$ctoEncodingList :: [Type] -> Encoding
toEncodingList :: [Type] -> Encoding
ToJSON, Value -> Parser [Type]
Value -> Parser Type
(Value -> Parser Type) -> (Value -> Parser [Type]) -> FromJSON Type
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Type
parseJSON :: Value -> Parser Type
$cparseJSONList :: Value -> Parser [Type]
parseJSONList :: Value -> Parser [Type]
FromJSON, Proxy Type -> Declare (Definitions Schema) NamedSchema
(Proxy Type -> Declare (Definitions Schema) NamedSchema)
-> ToSchema Type
forall a.
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy Type -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy Type -> Declare (Definitions Schema) NamedSchema
ToSchema, Typeable Type
Typeable Type
-> (Proxy Type -> Declare (Definitions Schema) NamedSchema)
-> ToSchema Type
Proxy Type -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a
-> (Proxy a -> Declare (Definitions Schema) NamedSchema)
-> ToSchema a
$cdeclareNamedSchema :: Proxy Type -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy Type -> Declare (Definitions Schema) NamedSchema
O3.ToSchema)