{- |
Module      : Model.ServerExceptions
Description : Here are exceptions for debugging.
License     : IPS
Maintainer  : jasonsychau@live.ca
Stability   : provisional
-}
module Model.ServerExceptions where

import Control.Exception


data SchemaException = ReadSchemaFileException
                     | SchemaDuplicateServerObjectException
                     | SchemaDuplicateInterfaceException
                     | ReadJsonObjectsException
                     | ReadServerNameStringException
                     | ReadScalarFieldException
                     | ReadDatabaseTableException
                     | ReadJsonStringException
                     | ReadPseudonymsException
                     | ReadInterfaceInstancesException
                     | ReadDatabaseIdsException
                     | ReadJsonStringListException
                     | ReadDatabaseRelationshipsException
                     | ScalarFieldDataTypeException
                     | ReadDatabaseRelationshipsCardinalityException
                     | PrimaryObjectNotFoundException
                     | SchemaDuplicateException
                     | InterfaceScalarTypesException
  deriving Int -> SchemaException -> ShowS
[SchemaException] -> ShowS
SchemaException -> String
(Int -> SchemaException -> ShowS)
-> (SchemaException -> String)
-> ([SchemaException] -> ShowS)
-> Show SchemaException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SchemaException] -> ShowS
$cshowList :: [SchemaException] -> ShowS
show :: SchemaException -> String
$cshow :: SchemaException -> String
showsPrec :: Int -> SchemaException -> ShowS
$cshowsPrec :: Int -> SchemaException -> ShowS
Show
instance Exception SchemaException

data VariableException = MissingVariableValueException
                       | ReadVariablesJsonException
                       | VariablesSyntaxException
                       | InvalidVariableTypeException
  deriving Int -> VariableException -> ShowS
[VariableException] -> ShowS
VariableException -> String
(Int -> VariableException -> ShowS)
-> (VariableException -> String)
-> ([VariableException] -> ShowS)
-> Show VariableException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VariableException] -> ShowS
$cshowList :: [VariableException] -> ShowS
show :: VariableException -> String
$cshow :: VariableException -> String
showsPrec :: Int -> VariableException -> ShowS
$cshowsPrec :: Int -> VariableException -> ShowS
Show
instance Exception VariableException

data QueryException = ParseFragmentException 
                    | EmptyQueryException 
                    | InvalidObjectException 
                    | FindFragmentException 
                    | ReadDirectiveException 
                    | MismatchedVariableTypeException 
                    | InvalidVariableNameException 
                    | InvalidScalarException 
                    | TransformationSyntaxException 
                    | DuplicateObjectsException
                    | ReadJsonException
                    | QuerySyntaxException
  deriving Int -> QueryException -> ShowS
[QueryException] -> ShowS
QueryException -> String
(Int -> QueryException -> ShowS)
-> (QueryException -> String)
-> ([QueryException] -> ShowS)
-> Show QueryException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QueryException] -> ShowS
$cshowList :: [QueryException] -> ShowS
show :: QueryException -> String
$cshow :: QueryException -> String
showsPrec :: Int -> QueryException -> ShowS
$cshowsPrec :: Int -> QueryException -> ShowS
Show
instance Exception QueryException

data ReferenceException = RelationshipCardinalityException
                        | RelationshipLinkageIdException
                        | UnrecognisedObjectException
                        | UnrecognisedArgumentException
                        | UnrecognisedOptionException
                        | DisagreeingObjectFieldsException
                        | UnrecognisedScalarException
                        | UnrecognisedRelationshipException
                        | InvalidPropertiesException
  deriving Int -> ReferenceException -> ShowS
[ReferenceException] -> ShowS
ReferenceException -> String
(Int -> ReferenceException -> ShowS)
-> (ReferenceException -> String)
-> ([ReferenceException] -> ShowS)
-> Show ReferenceException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReferenceException] -> ShowS
$cshowList :: [ReferenceException] -> ShowS
show :: ReferenceException -> String
$cshow :: ReferenceException -> String
showsPrec :: Int -> ReferenceException -> ShowS
$cshowsPrec :: Int -> ReferenceException -> ShowS
Show
instance Exception ReferenceException