module Postgres.Error
  ( Error (..),
  )
where

import qualified Control.Exception.Safe as Exception
import qualified Log
import qualified Text
import Prelude (Show (show))

-- | A postgres query might fail with one of these errors.
data Error
  = Timeout Float
  | UniqueViolation Text
  | Other Text [Log.Context]

instance Show Error where
  show :: Error -> String
show (Timeout Float
interval) = String
"Query timed out after " String -> ShowS
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text -> String
Text.toList (Float -> Text
Text.fromFloat Float
interval) String -> ShowS
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ String
" milliseconds"
  show (UniqueViolation Text
err) = String
"Query violated uniqueness constraint: " String -> ShowS
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text -> String
Text.toList Text
err
  show (Other Text
msg [Context]
_) = String
"Query failed with unexpected error: " String -> ShowS
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text -> String
Text.toList Text
msg

instance Exception.Exception Error