module Polysemy.Db.Data.DbError where

import Polysemy.Db.Data.DbConnectionError (DbConnectionError)

data DbError =
  Connection DbConnectionError
  |
  Query Text
  |
  Table Text
  |
  Unexpected Text
  deriving stock (DbError -> DbError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DbError -> DbError -> Bool
$c/= :: DbError -> DbError -> Bool
== :: DbError -> DbError -> Bool
$c== :: DbError -> DbError -> Bool
Eq, Int -> DbError -> ShowS
[DbError] -> ShowS
DbError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DbError] -> ShowS
$cshowList :: [DbError] -> ShowS
show :: DbError -> String
$cshow :: DbError -> String
showsPrec :: Int -> DbError -> ShowS
$cshowsPrec :: Int -> DbError -> ShowS
Show)

instance IsString DbError where
  fromString :: String -> DbError
fromString =
    Text -> DbError
Table forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString