{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Here are things dealing with query parameters.
module PostgreSQL.Param
  ( -- * Basics
    Type (..)
  , typeOid
  , Info (..)

  , Types.Value (..)
  , Types.Oid
  , Types.Format (..)

  , Types.PackedParam (..)
  , packParam
  , toPrepared

  , Types.PackedParamPrepared (..)
  , packParamPrepared

    -- * Class
  , Param (..)
  , RawText (..)
  )
where

import           Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as ByteString.Char8
import           Data.Text (Text)
import           Data.Text.Encoding (encodeUtf8)
import           Database.PostgreSQL.LibPQ (invalidOid)
import           GHC.Generics (Generic)
import qualified PostgreSQL.Types as Types

-- | Parameter type
--
-- @since 0.0.0
data Type
  = InferredType
  -- ^ Type is inferred on the server side
  --
  -- @since 0.0.0
  | StaticType Types.Oid
  -- ^ Explicit static type
  --
  -- @since 0.0.0
  deriving (Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
(Int -> Type -> ShowS)
-> (Type -> String) -> ([Type] -> ShowS) -> Show Type
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type] -> ShowS
$cshowList :: [Type] -> ShowS
show :: Type -> String
$cshow :: Type -> String
showsPrec :: Int -> Type -> ShowS
$cshowsPrec :: Int -> Type -> ShowS
Show, Type -> Type -> Bool
(Type -> Type -> Bool) -> (Type -> Type -> Bool) -> Eq Type
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c== :: Type -> Type -> Bool
Eq, Eq Type
Eq Type
-> (Type -> Type -> Ordering)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Type)
-> (Type -> Type -> Type)
-> Ord Type
Type -> Type -> Bool
Type -> Type -> Ordering
Type -> Type -> Type
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Type -> Type -> Type
$cmin :: Type -> Type -> Type
max :: Type -> Type -> Type
$cmax :: Type -> Type -> Type
>= :: Type -> Type -> Bool
$c>= :: Type -> Type -> Bool
> :: Type -> Type -> Bool
$c> :: Type -> Type -> Bool
<= :: Type -> Type -> Bool
$c<= :: Type -> Type -> Bool
< :: Type -> Type -> Bool
$c< :: Type -> Type -> Bool
compare :: Type -> Type -> Ordering
$ccompare :: Type -> Type -> Ordering
$cp1Ord :: Eq Type
Ord)

-- | Get the OID for the type.
--
-- @since 0.0.0
typeOid :: Type -> Types.Oid
typeOid :: Type -> Oid
typeOid = \case
  Type
InferredType -> Oid
invalidOid
  StaticType Oid
oid -> Oid
oid

{-# INLINE typeOid #-}

-- | Static parameter information
--
-- @since 0.0.0
data Info a = Info
  { Info a -> Type
info_type :: Type
  , Info a -> Maybe Text
info_typeName :: Maybe Text
  -- ^ This may be used as an explicit type annotation when used in a 'Statement' or 'Template'
  , Info a -> Format
info_format :: Types.Format
  , Info a -> a
info_pack :: a
  }
  deriving stock (a -> Info b -> Info a
(a -> b) -> Info a -> Info b
(forall a b. (a -> b) -> Info a -> Info b)
-> (forall a b. a -> Info b -> Info a) -> Functor Info
forall a b. a -> Info b -> Info a
forall a b. (a -> b) -> Info a -> Info b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Info b -> Info a
$c<$ :: forall a b. a -> Info b -> Info a
fmap :: (a -> b) -> Info a -> Info b
$cfmap :: forall a b. (a -> b) -> Info a -> Info b
Functor, Info a -> Bool
(a -> m) -> Info a -> m
(a -> b -> b) -> b -> Info a -> b
(forall m. Monoid m => Info m -> m)
-> (forall m a. Monoid m => (a -> m) -> Info a -> m)
-> (forall m a. Monoid m => (a -> m) -> Info a -> m)
-> (forall a b. (a -> b -> b) -> b -> Info a -> b)
-> (forall a b. (a -> b -> b) -> b -> Info a -> b)
-> (forall b a. (b -> a -> b) -> b -> Info a -> b)
-> (forall b a. (b -> a -> b) -> b -> Info a -> b)
-> (forall a. (a -> a -> a) -> Info a -> a)
-> (forall a. (a -> a -> a) -> Info a -> a)
-> (forall a. Info a -> [a])
-> (forall a. Info a -> Bool)
-> (forall a. Info a -> Int)
-> (forall a. Eq a => a -> Info a -> Bool)
-> (forall a. Ord a => Info a -> a)
-> (forall a. Ord a => Info a -> a)
-> (forall a. Num a => Info a -> a)
-> (forall a. Num a => Info a -> a)
-> Foldable Info
forall a. Eq a => a -> Info a -> Bool
forall a. Num a => Info a -> a
forall a. Ord a => Info a -> a
forall m. Monoid m => Info m -> m
forall a. Info a -> Bool
forall a. Info a -> Int
forall a. Info a -> [a]
forall a. (a -> a -> a) -> Info a -> a
forall m a. Monoid m => (a -> m) -> Info a -> m
forall b a. (b -> a -> b) -> b -> Info a -> b
forall a b. (a -> b -> b) -> b -> Info a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Info a -> a
$cproduct :: forall a. Num a => Info a -> a
sum :: Info a -> a
$csum :: forall a. Num a => Info a -> a
minimum :: Info a -> a
$cminimum :: forall a. Ord a => Info a -> a
maximum :: Info a -> a
$cmaximum :: forall a. Ord a => Info a -> a
elem :: a -> Info a -> Bool
$celem :: forall a. Eq a => a -> Info a -> Bool
length :: Info a -> Int
$clength :: forall a. Info a -> Int
null :: Info a -> Bool
$cnull :: forall a. Info a -> Bool
toList :: Info a -> [a]
$ctoList :: forall a. Info a -> [a]
foldl1 :: (a -> a -> a) -> Info a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Info a -> a
foldr1 :: (a -> a -> a) -> Info a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Info a -> a
foldl' :: (b -> a -> b) -> b -> Info a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Info a -> b
foldl :: (b -> a -> b) -> b -> Info a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Info a -> b
foldr' :: (a -> b -> b) -> b -> Info a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Info a -> b
foldr :: (a -> b -> b) -> b -> Info a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Info a -> b
foldMap' :: (a -> m) -> Info a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Info a -> m
foldMap :: (a -> m) -> Info a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Info a -> m
fold :: Info m -> m
$cfold :: forall m. Monoid m => Info m -> m
Foldable, Functor Info
Foldable Info
Functor Info
-> Foldable Info
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Info a -> f (Info b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Info (f a) -> f (Info a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Info a -> m (Info b))
-> (forall (m :: * -> *) a. Monad m => Info (m a) -> m (Info a))
-> Traversable Info
(a -> f b) -> Info a -> f (Info b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Info (m a) -> m (Info a)
forall (f :: * -> *) a. Applicative f => Info (f a) -> f (Info a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Info a -> m (Info b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Info a -> f (Info b)
sequence :: Info (m a) -> m (Info a)
$csequence :: forall (m :: * -> *) a. Monad m => Info (m a) -> m (Info a)
mapM :: (a -> m b) -> Info a -> m (Info b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Info a -> m (Info b)
sequenceA :: Info (f a) -> f (Info a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Info (f a) -> f (Info a)
traverse :: (a -> f b) -> Info a -> f (Info b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Info a -> f (Info b)
$cp2Traversable :: Foldable Info
$cp1Traversable :: Functor Info
Traversable, (forall x. Info a -> Rep (Info a) x)
-> (forall x. Rep (Info a) x -> Info a) -> Generic (Info a)
forall x. Rep (Info a) x -> Info a
forall x. Info a -> Rep (Info a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Info a) x -> Info a
forall a x. Info a -> Rep (Info a) x
$cto :: forall a x. Rep (Info a) x -> Info a
$cfrom :: forall a x. Info a -> Rep (Info a) x
Generic)

-- | Pack a parameter into a @postgresql-libpq@ format.
--
-- @since 0.0.0
packParam :: Info Types.Value -> Types.PackedParam
packParam :: Info Value -> PackedParam
packParam Info Value
paramInfo = Maybe (Oid, ByteString, Format) -> PackedParam
Types.PackedParam (Maybe (Oid, ByteString, Format) -> PackedParam)
-> Maybe (Oid, ByteString, Format) -> PackedParam
forall a b. (a -> b) -> a -> b
$
  case Info Value -> Value
forall a. Info a -> a
info_pack Info Value
paramInfo of
    Value
Types.Null -> Maybe (Oid, ByteString, Format)
forall a. Maybe a
Nothing
    Types.Value ByteString
datas -> (Oid, ByteString, Format) -> Maybe (Oid, ByteString, Format)
forall a. a -> Maybe a
Just (Oid
oid, ByteString
datas, Info Value -> Format
forall a. Info a -> Format
info_format Info Value
paramInfo)
  where
    oid :: Oid
oid = Type -> Oid
typeOid (Type -> Oid) -> Type -> Oid
forall a b. (a -> b) -> a -> b
$ Info Value -> Type
forall a. Info a -> Type
info_type Info Value
paramInfo

{-# INLINE packParam #-}

-- | Convert 'PackedParam'.
--
-- @since 0.0.0
toPrepared :: Types.PackedParam -> Types.PackedParamPrepared
toPrepared :: PackedParam -> PackedParamPrepared
toPrepared (Types.PackedParam Maybe (Oid, ByteString, Format)
param) = Maybe (ByteString, Format) -> PackedParamPrepared
Types.PackedParamPrepared (Maybe (ByteString, Format) -> PackedParamPrepared)
-> Maybe (ByteString, Format) -> PackedParamPrepared
forall a b. (a -> b) -> a -> b
$ do
  (Oid
_, ByteString
datas, Format
format) <- Maybe (Oid, ByteString, Format)
param
  (ByteString, Format) -> Maybe (ByteString, Format)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString
datas, Format
format)

{-# INLINE toPrepared #-}

-- | Pack a parameter for a prepared query into a @postgresql-libpq@ format.
--
-- @since 0.0.0
packParamPrepared :: Info Types.Value -> Types.PackedParamPrepared
packParamPrepared :: Info Value -> PackedParamPrepared
packParamPrepared Info Value
paramInfo = Maybe (ByteString, Format) -> PackedParamPrepared
Types.PackedParamPrepared (Maybe (ByteString, Format) -> PackedParamPrepared)
-> Maybe (ByteString, Format) -> PackedParamPrepared
forall a b. (a -> b) -> a -> b
$
  case Info Value -> Value
forall a. Info a -> a
info_pack Info Value
paramInfo of
    Value
Types.Null -> Maybe (ByteString, Format)
forall a. Maybe a
Nothing
    Types.Value ByteString
datas -> (ByteString, Format) -> Maybe (ByteString, Format)
forall a. a -> Maybe a
Just (ByteString
datas, Info Value -> Format
forall a. Info a -> Format
info_format Info Value
paramInfo)

{-# INLINE packParamPrepared #-}

-- | @a@ can be used as a parameter
--
-- @since 0.0.0
class Param a where
  -- | Parameter information
  --
  -- @since 0.0.0
  paramInfo :: Info (a -> Types.Value)

-- | @since 0.0.0
instance Param Integer where
  paramInfo :: Info (Integer -> Value)
paramInfo = Info :: forall a. Type -> Maybe Text -> Format -> a -> Info a
Info
    { info_type :: Type
info_type = Type
InferredType
    , info_typeName :: Maybe Text
info_typeName = Maybe Text
forall a. Maybe a
Nothing
    , info_format :: Format
info_format = Format
Types.Text
    , info_pack :: Integer -> Value
info_pack = ByteString -> Value
Types.Value (ByteString -> Value)
-> (Integer -> ByteString) -> Integer -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
ByteString.Char8.pack (String -> ByteString)
-> (Integer -> String) -> Integer -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show
    }

-- | @since 0.0.0
instance Param Double where
  paramInfo :: Info (Double -> Value)
paramInfo = Info :: forall a. Type -> Maybe Text -> Format -> a -> Info a
Info
    { info_type :: Type
info_type = Type
InferredType
    , info_typeName :: Maybe Text
info_typeName = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"float8"
    , info_format :: Format
info_format = Format
Types.Text
    , info_pack :: Double -> Value
info_pack = ByteString -> Value
Types.Value (ByteString -> Value) -> (Double -> ByteString) -> Double -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
ByteString.Char8.pack (String -> ByteString)
-> (Double -> String) -> Double -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. Show a => a -> String
show
    }

-- | @since 0.0.0
instance Param Text where
  paramInfo :: Info (Text -> Value)
paramInfo = Info :: forall a. Type -> Maybe Text -> Format -> a -> Info a
Info
    { info_type :: Type
info_type = Type
InferredType
    , info_typeName :: Maybe Text
info_typeName = Maybe Text
forall a. Maybe a
Nothing
    , info_format :: Format
info_format = Format
Types.Text
    , info_pack :: Text -> Value
info_pack = ByteString -> Value
Types.Value (ByteString -> Value) -> (Text -> ByteString) -> Text -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8
    }

-- | @since 0.0.0
instance Param Types.Oid where
  paramInfo :: Info (Oid -> Value)
paramInfo = Info :: forall a. Type -> Maybe Text -> Format -> a -> Info a
Info
    { info_type :: Type
info_type = Type
InferredType
    , info_typeName :: Maybe Text
info_typeName = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"oid"
    , info_format :: Format
info_format = Format
Types.Text
    , info_pack :: Oid -> Value
info_pack = \(Types.Oid CUInt
inner) -> ByteString -> Value
Types.Value (ByteString -> Value) -> ByteString -> Value
forall a b. (a -> b) -> a -> b
$ String -> ByteString
ByteString.Char8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ CUInt -> String
forall a. Show a => a -> String
show CUInt
inner
    }

-- | @since 0.0.0
instance Param Types.RegType where
  paramInfo :: Info (RegType -> Value)
paramInfo = Info :: forall a. Type -> Maybe Text -> Format -> a -> Info a
Info
    { info_type :: Type
info_type = Type
InferredType
    , info_typeName :: Maybe Text
info_typeName = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"regtype"
    , info_format :: Format
info_format = Format
Types.Text
    , info_pack :: RegType -> Value
info_pack = ByteString -> Value
Types.Value (ByteString -> Value)
-> (RegType -> ByteString) -> RegType -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 (Text -> ByteString) -> (RegType -> Text) -> RegType -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegType -> Text
Types.unRegType
    }

-- | Raw textual parameter
--
-- @since 0.0.0
newtype RawText = RawText
  { RawText -> ByteString
unRawText :: ByteString }
  deriving (Int -> RawText -> ShowS
[RawText] -> ShowS
RawText -> String
(Int -> RawText -> ShowS)
-> (RawText -> String) -> ([RawText] -> ShowS) -> Show RawText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RawText] -> ShowS
$cshowList :: [RawText] -> ShowS
show :: RawText -> String
$cshow :: RawText -> String
showsPrec :: Int -> RawText -> ShowS
$cshowsPrec :: Int -> RawText -> ShowS
Show, RawText -> RawText -> Bool
(RawText -> RawText -> Bool)
-> (RawText -> RawText -> Bool) -> Eq RawText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RawText -> RawText -> Bool
$c/= :: RawText -> RawText -> Bool
== :: RawText -> RawText -> Bool
$c== :: RawText -> RawText -> Bool
Eq, Eq RawText
Eq RawText
-> (RawText -> RawText -> Ordering)
-> (RawText -> RawText -> Bool)
-> (RawText -> RawText -> Bool)
-> (RawText -> RawText -> Bool)
-> (RawText -> RawText -> Bool)
-> (RawText -> RawText -> RawText)
-> (RawText -> RawText -> RawText)
-> Ord RawText
RawText -> RawText -> Bool
RawText -> RawText -> Ordering
RawText -> RawText -> RawText
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RawText -> RawText -> RawText
$cmin :: RawText -> RawText -> RawText
max :: RawText -> RawText -> RawText
$cmax :: RawText -> RawText -> RawText
>= :: RawText -> RawText -> Bool
$c>= :: RawText -> RawText -> Bool
> :: RawText -> RawText -> Bool
$c> :: RawText -> RawText -> Bool
<= :: RawText -> RawText -> Bool
$c<= :: RawText -> RawText -> Bool
< :: RawText -> RawText -> Bool
$c< :: RawText -> RawText -> Bool
compare :: RawText -> RawText -> Ordering
$ccompare :: RawText -> RawText -> Ordering
$cp1Ord :: Eq RawText
Ord)

-- | @since 0.0.0
instance Param RawText where
  paramInfo :: Info (RawText -> Value)
paramInfo = Info :: forall a. Type -> Maybe Text -> Format -> a -> Info a
Info
    { info_type :: Type
info_type = Type
InferredType
    , info_typeName :: Maybe Text
info_typeName = Maybe Text
forall a. Maybe a
Nothing
    , info_format :: Format
info_format = Format
Types.Text
    , info_pack :: RawText -> Value
info_pack = ByteString -> Value
Types.Value (ByteString -> Value)
-> (RawText -> ByteString) -> RawText -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawText -> ByteString
unRawText
    }

-- | @since 0.0.0
instance Param Types.Value where
  paramInfo :: Info (Value -> Value)
paramInfo = Info :: forall a. Type -> Maybe Text -> Format -> a -> Info a
Info
    { info_type :: Type
info_type = Type
InferredType
    , info_typeName :: Maybe Text
info_typeName = Maybe Text
forall a. Maybe a
Nothing
    , info_format :: Format
info_format = Format
Types.Text
    , info_pack :: Value -> Value
info_pack = Value -> Value
forall a. a -> a
id
    }