{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
module ProjectM36.Error where
import ProjectM36.Base
import ProjectM36.MerkleHash
import ProjectM36.DatabaseContextFunctionError
import ProjectM36.AtomFunctionError
import qualified Data.Set as S
import Control.DeepSeq (NFData, rnf)
import Control.DeepSeq.Generics (genericRnf)
import GHC.Generics (Generic)
import qualified Data.Text as T
import Data.Typeable
import Control.Exception

data RelationalError = NoSuchAttributeNamesError (S.Set AttributeName)
                     | TupleAttributeCountMismatchError Int --attribute name
                     | EmptyAttributesError
                     | DuplicateAttributeNamesError (S.Set AttributeName)
                     | TupleAttributeTypeMismatchError Attributes
                     | AttributeCountMismatchError Int
                     | AttributeNamesMismatchError (S.Set AttributeName)
                     | AttributeNameInUseError AttributeName
                     | AttributeIsNotRelationValuedError AttributeName
                     | CouldNotInferAttributes
                     | RelVarNotDefinedError RelVarName
                     | RelVarAlreadyDefinedError RelVarName
                     | RelationTypeMismatchError Attributes Attributes --expected, found
                     | InclusionDependencyCheckError IncDepName (Maybe RelationalError)
                     | InclusionDependencyNameInUseError IncDepName
                     | InclusionDependencyNameNotInUseError IncDepName
                     | ParseError T.Text
                     | PredicateExpressionError T.Text
                     | NoCommonTransactionAncestorError TransactionId TransactionId
                     | NoSuchTransactionError TransactionId
                     | RootTransactionTraversalError 
                     | HeadNameSwitchingHeadProhibitedError HeadName
                     | NoSuchHeadNameError HeadName
                     | UnknownHeadError
                     | NewTransactionMayNotHaveChildrenError TransactionId
                     | ParentCountTraversalError Int Int --maximum, requested
                     | NewTransactionMissingParentError TransactionId
                     | TransactionIsNotAHeadError TransactionId
                     | TransactionGraphCycleError TransactionId
                     | SessionIdInUseError TransactionId
                     | NoSuchSessionError TransactionId
                     | FailedToFindTransactionError TransactionId
                     | TransactionIdInUseError TransactionId
                     | NoSuchFunctionError FunctionName
                     | NoSuchTypeConstructorName TypeConstructorName
                     | TypeConstructorAtomTypeMismatch TypeConstructorName AtomType
                     | AtomTypeMismatchError AtomType AtomType
                     | TypeConstructorNameMismatch TypeConstructorName TypeConstructorName
                     | AtomTypeTypeConstructorReconciliationError AtomType TypeConstructorName
                     | DataConstructorNameInUseError DataConstructorName
                     | DataConstructorUsesUndeclaredTypeVariable TypeVarName
                     | TypeConstructorTypeVarsMismatch (S.Set TypeVarName) (S.Set TypeVarName)
                     | TypeConstructorTypeVarMissing TypeVarName
                     | TypeConstructorTypeVarsTypesMismatch TypeConstructorName TypeVarMap TypeVarMap
                     | DataConstructorTypeVarsMismatch DataConstructorName TypeVarMap TypeVarMap
                     | AtomFunctionTypeVariableResolutionError FunctionName TypeVarName
                     | AtomFunctionTypeVariableMismatch TypeVarName AtomType AtomType
                     | AtomTypeNameInUseError AtomTypeName
                     | IncompletelyDefinedAtomTypeWithConstructorError
                     | AtomTypeNameNotInUseError AtomTypeName
                     | AttributeNotSortableError Attribute
                     | FunctionNameInUseError FunctionName
                     | FunctionNameNotInUseError FunctionName
                     | EmptyCommitError
                     | FunctionArgumentCountMismatchError Int Int
                     | ConstructedAtomArgumentCountMismatchError Int Int
                     | NoSuchDataConstructorError DataConstructorName
                     | NoSuchTypeConstructorError TypeConstructorName
                     | InvalidAtomTypeName AtomTypeName
                     | AtomTypeNotSupported AttributeName --used by persistent driver
                     | AtomOperatorNotSupported T.Text --used by persistent driver
                     | EmptyTuplesError -- used by persistent driver
                     | AtomTypeCountError [AtomType] [AtomType]
                     | AtomFunctionTypeError FunctionName Int AtomType AtomType --arg number
                     | AtomFunctionUserError AtomFunctionError
                     | PrecompiledFunctionRemoveError FunctionName -- pre-compiled atom functions cannot be serialized, so they cannot change over time- they are referred to in perpetuity
                     | RelationValuedAttributesNotSupportedError [AttributeName]
                     | NotificationNameInUseError NotificationName
                     | NotificationNameNotInUseError NotificationName
                     | ImportError ImportError'
                     | ExportError T.Text
                     | UnhandledExceptionError String
                     | MergeTransactionError MergeError
                     | ScriptError ScriptCompilationError
                     | LoadFunctionError
                     | SecurityLoadFunctionError
                     | DatabaseContextFunctionUserError DatabaseContextFunctionError
                     | DatabaseLoadError PersistenceError
                       
                     | SubschemaNameInUseError SchemaName
                     | SubschemaNameNotInUseError SchemaName
                       
                     | SchemaCreationError SchemaError 
                       
                     | ImproperDatabaseStateError

                     | NonConcreteSchemaPlanError

                     | NoUncommittedContextInEvalError
                     | TupleExprsReferenceMultipleMarkersError

                     | MerkleHashValidationError TransactionId MerkleHash MerkleHash

                     | RegisteredQueryValidationError RegisteredQueryName RelationalError
                     | RegisteredQueryNameInUseError RegisteredQueryName
                     | RegisteredQueryNameNotInUseError RegisteredQueryName

                     | MultipleErrors [RelationalError]
                       deriving (Int -> RelationalError -> ShowS
[RelationalError] -> ShowS
RelationalError -> String
(Int -> RelationalError -> ShowS)
-> (RelationalError -> String)
-> ([RelationalError] -> ShowS)
-> Show RelationalError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RelationalError] -> ShowS
$cshowList :: [RelationalError] -> ShowS
show :: RelationalError -> String
$cshow :: RelationalError -> String
showsPrec :: Int -> RelationalError -> ShowS
$cshowsPrec :: Int -> RelationalError -> ShowS
Show,RelationalError -> RelationalError -> Bool
(RelationalError -> RelationalError -> Bool)
-> (RelationalError -> RelationalError -> Bool)
-> Eq RelationalError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RelationalError -> RelationalError -> Bool
$c/= :: RelationalError -> RelationalError -> Bool
== :: RelationalError -> RelationalError -> Bool
$c== :: RelationalError -> RelationalError -> Bool
Eq,(forall x. RelationalError -> Rep RelationalError x)
-> (forall x. Rep RelationalError x -> RelationalError)
-> Generic RelationalError
forall x. Rep RelationalError x -> RelationalError
forall x. RelationalError -> Rep RelationalError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RelationalError x -> RelationalError
$cfrom :: forall x. RelationalError -> Rep RelationalError x
Generic,Typeable, RelationalError -> ()
(RelationalError -> ()) -> NFData RelationalError
forall a. (a -> ()) -> NFData a
rnf :: RelationalError -> ()
$crnf :: RelationalError -> ()
NFData) 

data PersistenceError = InvalidDirectoryError FilePath | 
                        MissingTransactionError TransactionId |
                        WrongDatabaseFormatVersionError String String
                      deriving (Int -> PersistenceError -> ShowS
[PersistenceError] -> ShowS
PersistenceError -> String
(Int -> PersistenceError -> ShowS)
-> (PersistenceError -> String)
-> ([PersistenceError] -> ShowS)
-> Show PersistenceError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PersistenceError] -> ShowS
$cshowList :: [PersistenceError] -> ShowS
show :: PersistenceError -> String
$cshow :: PersistenceError -> String
showsPrec :: Int -> PersistenceError -> ShowS
$cshowsPrec :: Int -> PersistenceError -> ShowS
Show, PersistenceError -> PersistenceError -> Bool
(PersistenceError -> PersistenceError -> Bool)
-> (PersistenceError -> PersistenceError -> Bool)
-> Eq PersistenceError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PersistenceError -> PersistenceError -> Bool
$c/= :: PersistenceError -> PersistenceError -> Bool
== :: PersistenceError -> PersistenceError -> Bool
$c== :: PersistenceError -> PersistenceError -> Bool
Eq, (forall x. PersistenceError -> Rep PersistenceError x)
-> (forall x. Rep PersistenceError x -> PersistenceError)
-> Generic PersistenceError
forall x. Rep PersistenceError x -> PersistenceError
forall x. PersistenceError -> Rep PersistenceError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PersistenceError x -> PersistenceError
$cfrom :: forall x. PersistenceError -> Rep PersistenceError x
Generic, PersistenceError -> ()
(PersistenceError -> ()) -> NFData PersistenceError
forall a. (a -> ()) -> NFData a
rnf :: PersistenceError -> ()
$crnf :: PersistenceError -> ()
NFData)

--collapse list of errors into normal error- if there is just one, just return one
someErrors :: [RelationalError] -> RelationalError                                      
someErrors :: [RelationalError] -> RelationalError
someErrors [] = String -> RelationalError
forall a. HasCallStack => String -> a
error String
"no errors in error list: function misuse" 
someErrors [RelationalError]
errList  = if [RelationalError] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [RelationalError]
errList Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then
                        [RelationalError] -> RelationalError
forall a. [a] -> a
head [RelationalError]
errList
                      else
                        [RelationalError] -> RelationalError
MultipleErrors [RelationalError]
errList
                        
data MergeError = SelectedHeadMismatchMergeError |
                  PreferredHeadMissingMergeError HeadName |
                  StrategyViolatesConstraintMergeError |
                  InvalidMergeStrategyError MergeStrategy | -- this is an internal coding error
                  DisconnectedTransactionNotAMergeHeadError TransactionId |
                  StrategyViolatesComponentMergeError | --failed merge in inc deps, relvars, etc.
                  StrategyViolatesRelationVariableMergeError |
                  StrategyViolatesTypeConstructorMergeError |
                  StrategyViolatesRegisteredQueryMergeError [RegisteredQueryName]
                  deriving (Int -> MergeError -> ShowS
[MergeError] -> ShowS
MergeError -> String
(Int -> MergeError -> ShowS)
-> (MergeError -> String)
-> ([MergeError] -> ShowS)
-> Show MergeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MergeError] -> ShowS
$cshowList :: [MergeError] -> ShowS
show :: MergeError -> String
$cshow :: MergeError -> String
showsPrec :: Int -> MergeError -> ShowS
$cshowsPrec :: Int -> MergeError -> ShowS
Show, MergeError -> MergeError -> Bool
(MergeError -> MergeError -> Bool)
-> (MergeError -> MergeError -> Bool) -> Eq MergeError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MergeError -> MergeError -> Bool
$c/= :: MergeError -> MergeError -> Bool
== :: MergeError -> MergeError -> Bool
$c== :: MergeError -> MergeError -> Bool
Eq, (forall x. MergeError -> Rep MergeError x)
-> (forall x. Rep MergeError x -> MergeError) -> Generic MergeError
forall x. Rep MergeError x -> MergeError
forall x. MergeError -> Rep MergeError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MergeError x -> MergeError
$cfrom :: forall x. MergeError -> Rep MergeError x
Generic, Typeable)
                           
instance NFData MergeError where rnf :: MergeError -> ()
rnf = MergeError -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf                           
                                 
data ScriptCompilationError = TypeCheckCompilationError String String | --expected, got
                              SyntaxErrorCompilationError String |
                              ScriptCompilationDisabledError |
                              OtherScriptCompilationError String
                            deriving (Int -> ScriptCompilationError -> ShowS
[ScriptCompilationError] -> ShowS
ScriptCompilationError -> String
(Int -> ScriptCompilationError -> ShowS)
-> (ScriptCompilationError -> String)
-> ([ScriptCompilationError] -> ShowS)
-> Show ScriptCompilationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScriptCompilationError] -> ShowS
$cshowList :: [ScriptCompilationError] -> ShowS
show :: ScriptCompilationError -> String
$cshow :: ScriptCompilationError -> String
showsPrec :: Int -> ScriptCompilationError -> ShowS
$cshowsPrec :: Int -> ScriptCompilationError -> ShowS
Show, ScriptCompilationError -> ScriptCompilationError -> Bool
(ScriptCompilationError -> ScriptCompilationError -> Bool)
-> (ScriptCompilationError -> ScriptCompilationError -> Bool)
-> Eq ScriptCompilationError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScriptCompilationError -> ScriptCompilationError -> Bool
$c/= :: ScriptCompilationError -> ScriptCompilationError -> Bool
== :: ScriptCompilationError -> ScriptCompilationError -> Bool
$c== :: ScriptCompilationError -> ScriptCompilationError -> Bool
Eq, (forall x. ScriptCompilationError -> Rep ScriptCompilationError x)
-> (forall x.
    Rep ScriptCompilationError x -> ScriptCompilationError)
-> Generic ScriptCompilationError
forall x. Rep ScriptCompilationError x -> ScriptCompilationError
forall x. ScriptCompilationError -> Rep ScriptCompilationError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ScriptCompilationError x -> ScriptCompilationError
$cfrom :: forall x. ScriptCompilationError -> Rep ScriptCompilationError x
Generic, Typeable, ScriptCompilationError -> ()
(ScriptCompilationError -> ()) -> NFData ScriptCompilationError
forall a. (a -> ()) -> NFData a
rnf :: ScriptCompilationError -> ()
$crnf :: ScriptCompilationError -> ()
NFData)
                                     
instance Exception ScriptCompilationError                                     
                                               
data SchemaError = RelVarReferencesMissing (S.Set RelVarName) |
                   RelVarInReferencedMoreThanOnce RelVarName |
                   RelVarOutReferencedMoreThanOnce RelVarName
                   deriving (Int -> SchemaError -> ShowS
[SchemaError] -> ShowS
SchemaError -> String
(Int -> SchemaError -> ShowS)
-> (SchemaError -> String)
-> ([SchemaError] -> ShowS)
-> Show SchemaError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SchemaError] -> ShowS
$cshowList :: [SchemaError] -> ShowS
show :: SchemaError -> String
$cshow :: SchemaError -> String
showsPrec :: Int -> SchemaError -> ShowS
$cshowsPrec :: Int -> SchemaError -> ShowS
Show, SchemaError -> SchemaError -> Bool
(SchemaError -> SchemaError -> Bool)
-> (SchemaError -> SchemaError -> Bool) -> Eq SchemaError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SchemaError -> SchemaError -> Bool
$c/= :: SchemaError -> SchemaError -> Bool
== :: SchemaError -> SchemaError -> Bool
$c== :: SchemaError -> SchemaError -> Bool
Eq, (forall x. SchemaError -> Rep SchemaError x)
-> (forall x. Rep SchemaError x -> SchemaError)
-> Generic SchemaError
forall x. Rep SchemaError x -> SchemaError
forall x. SchemaError -> Rep SchemaError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SchemaError x -> SchemaError
$cfrom :: forall x. SchemaError -> Rep SchemaError x
Generic, Typeable, SchemaError -> ()
(SchemaError -> ()) -> NFData SchemaError
forall a. (a -> ()) -> NFData a
rnf :: SchemaError -> ()
$crnf :: SchemaError -> ()
NFData)


data ImportError' = InvalidSHA256Error T.Text
                  | SHA256MismatchError T.Text T.Text
                  | InvalidFileURIError T.Text
                  | ImportFileDecodeError T.Text
                  | ImportFileError T.Text
                  | ImportDownloadError T.Text
                  deriving (Int -> ImportError' -> ShowS
[ImportError'] -> ShowS
ImportError' -> String
(Int -> ImportError' -> ShowS)
-> (ImportError' -> String)
-> ([ImportError'] -> ShowS)
-> Show ImportError'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportError'] -> ShowS
$cshowList :: [ImportError'] -> ShowS
show :: ImportError' -> String
$cshow :: ImportError' -> String
showsPrec :: Int -> ImportError' -> ShowS
$cshowsPrec :: Int -> ImportError' -> ShowS
Show, ImportError' -> ImportError' -> Bool
(ImportError' -> ImportError' -> Bool)
-> (ImportError' -> ImportError' -> Bool) -> Eq ImportError'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportError' -> ImportError' -> Bool
$c/= :: ImportError' -> ImportError' -> Bool
== :: ImportError' -> ImportError' -> Bool
$c== :: ImportError' -> ImportError' -> Bool
Eq, (forall x. ImportError' -> Rep ImportError' x)
-> (forall x. Rep ImportError' x -> ImportError')
-> Generic ImportError'
forall x. Rep ImportError' x -> ImportError'
forall x. ImportError' -> Rep ImportError' x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImportError' x -> ImportError'
$cfrom :: forall x. ImportError' -> Rep ImportError' x
Generic, Typeable, ImportError' -> ()
(ImportError' -> ()) -> NFData ImportError'
forall a. (a -> ()) -> NFData a
rnf :: ImportError' -> ()
$crnf :: ImportError' -> ()
NFData)