{-# LANGUAGE DeriveAnyClass #-}

module Hercules.API.Message where

import Hercules.API.Prelude

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