module PostgREST.Request.Preferences where

import GHC.Show
import Protolude


data PreferResolution
  = MergeDuplicates
  | IgnoreDuplicates

instance Show PreferResolution where
  show :: PreferResolution -> String
show PreferResolution
MergeDuplicates  = String
"resolution=merge-duplicates"
  show PreferResolution
IgnoreDuplicates = String
"resolution=ignore-duplicates"

-- | How to return the mutated data. From https://tools.ietf.org/html/rfc7240#section-4.2
data PreferRepresentation
  = Full        -- ^ Return the body plus the Location header(in case of POST).
  | HeadersOnly -- ^ Return the Location header(in case of POST). This needs a SELECT privilege on the pk.
  | None        -- ^ Return nothing from the mutated data.
  deriving PreferRepresentation -> PreferRepresentation -> Bool
(PreferRepresentation -> PreferRepresentation -> Bool)
-> (PreferRepresentation -> PreferRepresentation -> Bool)
-> Eq PreferRepresentation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PreferRepresentation -> PreferRepresentation -> Bool
$c/= :: PreferRepresentation -> PreferRepresentation -> Bool
== :: PreferRepresentation -> PreferRepresentation -> Bool
$c== :: PreferRepresentation -> PreferRepresentation -> Bool
Eq

instance Show PreferRepresentation where
  show :: PreferRepresentation -> String
show PreferRepresentation
Full        = String
"return=representation"
  show PreferRepresentation
None        = String
"return=minimal"
  show PreferRepresentation
HeadersOnly = String
"return=headers-only"

data PreferParameters
  = SingleObject    -- ^ Pass all parameters as a single json object to a stored procedure
  | MultipleObjects -- ^ Pass an array of json objects as params to a stored procedure
  deriving PreferParameters -> PreferParameters -> Bool
(PreferParameters -> PreferParameters -> Bool)
-> (PreferParameters -> PreferParameters -> Bool)
-> Eq PreferParameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PreferParameters -> PreferParameters -> Bool
$c/= :: PreferParameters -> PreferParameters -> Bool
== :: PreferParameters -> PreferParameters -> Bool
$c== :: PreferParameters -> PreferParameters -> Bool
Eq

instance Show PreferParameters where
  show :: PreferParameters -> String
show PreferParameters
SingleObject    = String
"params=single-object"
  show PreferParameters
MultipleObjects = String
"params=multiple-objects"

data PreferCount
  = ExactCount     -- ^ exact count(slower)
  | PlannedCount   -- ^ PostgreSQL query planner rows count guess. Done by using EXPLAIN {query}.
  | EstimatedCount -- ^ use the query planner rows if the count is superior to max-rows, otherwise get the exact count.
  deriving PreferCount -> PreferCount -> Bool
(PreferCount -> PreferCount -> Bool)
-> (PreferCount -> PreferCount -> Bool) -> Eq PreferCount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PreferCount -> PreferCount -> Bool
$c/= :: PreferCount -> PreferCount -> Bool
== :: PreferCount -> PreferCount -> Bool
$c== :: PreferCount -> PreferCount -> Bool
Eq

instance Show PreferCount where
  show :: PreferCount -> String
show PreferCount
ExactCount     = String
"count=exact"
  show PreferCount
PlannedCount   = String
"count=planned"
  show PreferCount
EstimatedCount = String
"count=estimated"

data PreferTransaction
  = Commit   -- Commit transaction - the default.
  | Rollback -- Rollback transaction after sending the response - does not persist changes, e.g. for running tests.
  deriving PreferTransaction -> PreferTransaction -> Bool
(PreferTransaction -> PreferTransaction -> Bool)
-> (PreferTransaction -> PreferTransaction -> Bool)
-> Eq PreferTransaction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PreferTransaction -> PreferTransaction -> Bool
$c/= :: PreferTransaction -> PreferTransaction -> Bool
== :: PreferTransaction -> PreferTransaction -> Bool
$c== :: PreferTransaction -> PreferTransaction -> Bool
Eq

instance Show PreferTransaction where
  show :: PreferTransaction -> String
show PreferTransaction
Commit   = String
"tx=commit"
  show PreferTransaction
Rollback = String
"tx=rollback"