{-# LANGUAGE CPP, FlexibleInstances, ScopedTypeVariables, MultiParamTypeClasses, FlexibleContexts, DataKinds, KindSignatures, TypeFamilies, DeriveDataTypeable #-}
#if __GLASGOW_HASKELL__ < 710
{-# LANGUAGE OverlappingInstances #-}
#endif
#if __GLASGOW_HASKELL__ >= 800
{-# LANGUAGE UndecidableSuperClasses #-}
#endif
module Database.PostgreSQL.Typed.Types
(
OID
, PGValue(..)
, PGValues
, PGTypeID(..)
, PGTypeEnv(..), unknownPGTypeEnv
, PGName(..), pgNameBS, pgNameString
, PGRecord(..)
, PGType(..)
, PGParameter(..)
, PGColumn(..)
, PGStringType
, PGRecordType
, pgEncodeParameter
, pgEscapeParameter
, pgDecodeColumn
, pgDecodeColumnNotNull
, pgQuote
, pgDQuote
, pgDQuoteFrom
, parsePGDQuote
, buildPGValue
) where
import qualified Codec.Binary.UTF8.String as UTF8
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>), (<$), (<*), (*>))
#endif
import Control.Arrow ((&&&))
#ifdef VERSION_aeson
import qualified Data.Aeson as JSON
#endif
import qualified Data.Attoparsec.ByteString as P (anyWord8)
import qualified Data.Attoparsec.ByteString.Char8 as P
import Data.Bits (shiftL, (.|.))
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as BSB
import qualified Data.ByteString.Builder.Prim as BSBP
import qualified Data.ByteString.Char8 as BSC
import Data.ByteString.Internal (c2w, w2c)
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.UTF8 as BSU
import Data.Char (isSpace, isDigit, digitToInt, intToDigit, toLower)
import Data.Data (Data)
import Data.Int
import Data.List (intersperse)
import Data.Maybe (fromMaybe)
import Data.Monoid ((<>))
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid (mempty, mconcat)
#endif
import Data.Ratio ((%), numerator, denominator)
#ifdef VERSION_scientific
import Data.Scientific (Scientific)
#endif
import Data.String (IsString(..))
#ifdef VERSION_text
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TLE
#endif
import qualified Data.Time as Time
#if MIN_VERSION_time(1,5,0)
import Data.Time (defaultTimeLocale)
#else
import System.Locale (defaultTimeLocale)
#endif
import Data.Typeable (Typeable)
#ifdef VERSION_uuid
import qualified Data.UUID as UUID
#endif
import Data.Word (Word8, Word32)
import GHC.TypeLits (Symbol, symbolVal, KnownSymbol)
import Numeric (readFloat)
#ifdef VERSION_postgresql_binary
#if MIN_VERSION_postgresql_binary(0,12,0)
import qualified PostgreSQL.Binary.Decoding as BinD
import qualified PostgreSQL.Binary.Encoding as BinE
#else
import qualified PostgreSQL.Binary.Decoder as BinD
import qualified PostgreSQL.Binary.Encoder as BinE
#endif
#endif
type PGTextValue = BS.ByteString
type PGBinaryValue = BS.ByteString
data PGValue
= PGNullValue
| PGTextValue { PGValue -> PGTextValue
pgTextValue :: PGTextValue }
| PGBinaryValue { PGValue -> PGTextValue
pgBinaryValue :: PGBinaryValue }
deriving (Int -> PGValue -> ShowS
[PGValue] -> ShowS
PGValue -> String
(Int -> PGValue -> ShowS)
-> (PGValue -> String) -> ([PGValue] -> ShowS) -> Show PGValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PGValue] -> ShowS
$cshowList :: [PGValue] -> ShowS
show :: PGValue -> String
$cshow :: PGValue -> String
showsPrec :: Int -> PGValue -> ShowS
$cshowsPrec :: Int -> PGValue -> ShowS
Show, PGValue -> PGValue -> Bool
(PGValue -> PGValue -> Bool)
-> (PGValue -> PGValue -> Bool) -> Eq PGValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PGValue -> PGValue -> Bool
$c/= :: PGValue -> PGValue -> Bool
== :: PGValue -> PGValue -> Bool
$c== :: PGValue -> PGValue -> Bool
Eq)
type PGValues = [PGValue]
data PGTypeEnv = PGTypeEnv
{ PGTypeEnv -> Maybe Bool
pgIntegerDatetimes :: Maybe Bool
, PGTypeEnv -> Maybe PGTextValue
pgServerVersion :: Maybe BS.ByteString
} deriving (Int -> PGTypeEnv -> ShowS
[PGTypeEnv] -> ShowS
PGTypeEnv -> String
(Int -> PGTypeEnv -> ShowS)
-> (PGTypeEnv -> String)
-> ([PGTypeEnv] -> ShowS)
-> Show PGTypeEnv
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PGTypeEnv] -> ShowS
$cshowList :: [PGTypeEnv] -> ShowS
show :: PGTypeEnv -> String
$cshow :: PGTypeEnv -> String
showsPrec :: Int -> PGTypeEnv -> ShowS
$cshowsPrec :: Int -> PGTypeEnv -> ShowS
Show)
unknownPGTypeEnv :: PGTypeEnv
unknownPGTypeEnv :: PGTypeEnv
unknownPGTypeEnv = PGTypeEnv :: Maybe Bool -> Maybe PGTextValue -> PGTypeEnv
PGTypeEnv
{ pgIntegerDatetimes :: Maybe Bool
pgIntegerDatetimes = Maybe Bool
forall a. Maybe a
Nothing
, pgServerVersion :: Maybe PGTextValue
pgServerVersion = Maybe PGTextValue
forall a. Maybe a
Nothing
}
newtype PGName = PGName
{ PGName -> [Word8]
pgNameBytes :: [Word8]
}
deriving (PGName -> PGName -> Bool
(PGName -> PGName -> Bool)
-> (PGName -> PGName -> Bool) -> Eq PGName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PGName -> PGName -> Bool
$c/= :: PGName -> PGName -> Bool
== :: PGName -> PGName -> Bool
$c== :: PGName -> PGName -> Bool
Eq, Eq PGName
Eq PGName
-> (PGName -> PGName -> Ordering)
-> (PGName -> PGName -> Bool)
-> (PGName -> PGName -> Bool)
-> (PGName -> PGName -> Bool)
-> (PGName -> PGName -> Bool)
-> (PGName -> PGName -> PGName)
-> (PGName -> PGName -> PGName)
-> Ord PGName
PGName -> PGName -> Bool
PGName -> PGName -> Ordering
PGName -> PGName -> PGName
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 :: PGName -> PGName -> PGName
$cmin :: PGName -> PGName -> PGName
max :: PGName -> PGName -> PGName
$cmax :: PGName -> PGName -> PGName
>= :: PGName -> PGName -> Bool
$c>= :: PGName -> PGName -> Bool
> :: PGName -> PGName -> Bool
$c> :: PGName -> PGName -> Bool
<= :: PGName -> PGName -> Bool
$c<= :: PGName -> PGName -> Bool
< :: PGName -> PGName -> Bool
$c< :: PGName -> PGName -> Bool
compare :: PGName -> PGName -> Ordering
$ccompare :: PGName -> PGName -> Ordering
$cp1Ord :: Eq PGName
Ord, Typeable, Typeable PGName
DataType
Constr
Typeable PGName
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PGName -> c PGName)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PGName)
-> (PGName -> Constr)
-> (PGName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PGName))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PGName))
-> ((forall b. Data b => b -> b) -> PGName -> PGName)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PGName -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PGName -> r)
-> (forall u. (forall d. Data d => d -> u) -> PGName -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> PGName -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PGName -> m PGName)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PGName -> m PGName)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PGName -> m PGName)
-> Data PGName
PGName -> DataType
PGName -> Constr
(forall b. Data b => b -> b) -> PGName -> PGName
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PGName -> c PGName
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PGName
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> PGName -> u
forall u. (forall d. Data d => d -> u) -> PGName -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PGName -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PGName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PGName -> m PGName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PGName -> m PGName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PGName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PGName -> c PGName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PGName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PGName)
$cPGName :: Constr
$tPGName :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> PGName -> m PGName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PGName -> m PGName
gmapMp :: (forall d. Data d => d -> m d) -> PGName -> m PGName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PGName -> m PGName
gmapM :: (forall d. Data d => d -> m d) -> PGName -> m PGName
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PGName -> m PGName
gmapQi :: Int -> (forall d. Data d => d -> u) -> PGName -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PGName -> u
gmapQ :: (forall d. Data d => d -> u) -> PGName -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PGName -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PGName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PGName -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PGName -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PGName -> r
gmapT :: (forall b. Data b => b -> b) -> PGName -> PGName
$cgmapT :: (forall b. Data b => b -> b) -> PGName -> PGName
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PGName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PGName)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c PGName)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PGName)
dataTypeOf :: PGName -> DataType
$cdataTypeOf :: PGName -> DataType
toConstr :: PGName -> Constr
$ctoConstr :: PGName -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PGName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PGName
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PGName -> c PGName
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PGName -> c PGName
$cp1Data :: Typeable PGName
Data)
pgNameBS :: PGName -> BS.ByteString
pgNameBS :: PGName -> PGTextValue
pgNameBS = [Word8] -> PGTextValue
BS.pack ([Word8] -> PGTextValue)
-> (PGName -> [Word8]) -> PGName -> PGTextValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGName -> [Word8]
pgNameBytes
instance IsString PGName where
fromString :: String -> PGName
fromString = [Word8] -> PGName
PGName ([Word8] -> PGName) -> (String -> [Word8]) -> String -> PGName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Word8]
UTF8.encode
instance Show PGName where
show :: PGName -> String
show = PGName -> String
pgNameString
pgNameString :: PGName -> String
pgNameString :: PGName -> String
pgNameString = [Word8] -> String
UTF8.decode ([Word8] -> String) -> (PGName -> [Word8]) -> PGName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGName -> [Word8]
pgNameBytes
data PGTypeID (t :: Symbol) = PGTypeProxy
class (KnownSymbol t
#if __GLASGOW_HASKELL__ >= 800
, PGParameter t (PGVal t), PGColumn t (PGVal t)
#endif
) => PGType t where
type PGVal t :: *
pgTypeName :: PGTypeID t -> PGName
pgTypeName = String -> PGName
forall a. IsString a => String -> a
fromString (String -> PGName)
-> (PGTypeID t -> String) -> PGTypeID t -> PGName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTypeID t -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal
pgBinaryColumn :: PGTypeEnv -> PGTypeID t -> Bool
pgBinaryColumn PGTypeEnv
_ PGTypeID t
_ = Bool
False
class PGType t => PGParameter t a where
pgEncode :: PGTypeID t -> a -> PGTextValue
pgLiteral :: PGTypeID t -> a -> BS.ByteString
pgLiteral PGTypeID t
t = PGTextValue -> PGTextValue
pgQuote (PGTextValue -> PGTextValue)
-> (a -> PGTextValue) -> a -> PGTextValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTypeID t -> a -> PGTextValue
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> PGTextValue
pgEncode PGTypeID t
t
pgEncodeValue :: PGTypeEnv -> PGTypeID t -> a -> PGValue
pgEncodeValue PGTypeEnv
_ PGTypeID t
t = PGTextValue -> PGValue
PGTextValue (PGTextValue -> PGValue) -> (a -> PGTextValue) -> a -> PGValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTypeID t -> a -> PGTextValue
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> PGTextValue
pgEncode PGTypeID t
t
class PGType t => PGColumn t a where
pgDecode :: PGTypeID t -> PGTextValue -> a
pgDecodeBinary :: PGTypeEnv -> PGTypeID t -> PGBinaryValue -> a
pgDecodeBinary PGTypeEnv
_ PGTypeID t
t PGTextValue
_ = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"pgDecodeBinary " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PGName -> String
forall a. Show a => a -> String
show (PGTypeID t -> PGName
forall (t :: Symbol). PGType t => PGTypeID t -> PGName
pgTypeName PGTypeID t
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": not supported"
pgDecodeValue :: PGTypeEnv -> PGTypeID t -> PGValue -> a
pgDecodeValue PGTypeEnv
_ PGTypeID t
t (PGTextValue PGTextValue
v) = PGTypeID t -> PGTextValue -> a
forall (t :: Symbol) a.
PGColumn t a =>
PGTypeID t -> PGTextValue -> a
pgDecode PGTypeID t
t PGTextValue
v
pgDecodeValue PGTypeEnv
e PGTypeID t
t (PGBinaryValue PGTextValue
v) = PGTypeEnv -> PGTypeID t -> PGTextValue -> a
forall (t :: Symbol) a.
PGColumn t a =>
PGTypeEnv -> PGTypeID t -> PGTextValue -> a
pgDecodeBinary PGTypeEnv
e PGTypeID t
t PGTextValue
v
pgDecodeValue PGTypeEnv
_ PGTypeID t
t PGValue
PGNullValue = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"NULL in " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PGName -> String
forall a. Show a => a -> String
show (PGTypeID t -> PGName
forall (t :: Symbol). PGType t => PGTypeID t -> PGName
pgTypeName PGTypeID t
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" column (use Maybe or COALESCE)"
instance PGParameter t a => PGParameter t (Maybe a) where
pgEncode :: PGTypeID t -> Maybe a -> PGTextValue
pgEncode PGTypeID t
t = PGTextValue -> (a -> PGTextValue) -> Maybe a -> PGTextValue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> PGTextValue
forall a. HasCallStack => String -> a
error (String -> PGTextValue) -> String -> PGTextValue
forall a b. (a -> b) -> a -> b
$ String
"pgEncode " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PGName -> String
forall a. Show a => a -> String
show (PGTypeID t -> PGName
forall (t :: Symbol). PGType t => PGTypeID t -> PGName
pgTypeName PGTypeID t
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": Nothing") (PGTypeID t -> a -> PGTextValue
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> PGTextValue
pgEncode PGTypeID t
t)
pgLiteral :: PGTypeID t -> Maybe a -> PGTextValue
pgLiteral = PGTextValue -> (a -> PGTextValue) -> Maybe a -> PGTextValue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> PGTextValue
BSC.pack String
"NULL") ((a -> PGTextValue) -> Maybe a -> PGTextValue)
-> (PGTypeID t -> a -> PGTextValue)
-> PGTypeID t
-> Maybe a
-> PGTextValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTypeID t -> a -> PGTextValue
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> PGTextValue
pgLiteral
pgEncodeValue :: PGTypeEnv -> PGTypeID t -> Maybe a -> PGValue
pgEncodeValue PGTypeEnv
e = PGValue -> (a -> PGValue) -> Maybe a -> PGValue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PGValue
PGNullValue ((a -> PGValue) -> Maybe a -> PGValue)
-> (PGTypeID t -> a -> PGValue) -> PGTypeID t -> Maybe a -> PGValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTypeEnv -> PGTypeID t -> a -> PGValue
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeEnv -> PGTypeID t -> a -> PGValue
pgEncodeValue PGTypeEnv
e
instance PGColumn t a => PGColumn t (Maybe a) where
pgDecode :: PGTypeID t -> PGTextValue -> Maybe a
pgDecode PGTypeID t
t = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (PGTextValue -> a) -> PGTextValue -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTypeID t -> PGTextValue -> a
forall (t :: Symbol) a.
PGColumn t a =>
PGTypeID t -> PGTextValue -> a
pgDecode PGTypeID t
t
pgDecodeBinary :: PGTypeEnv -> PGTypeID t -> PGTextValue -> Maybe a
pgDecodeBinary PGTypeEnv
e PGTypeID t
t = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (PGTextValue -> a) -> PGTextValue -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTypeEnv -> PGTypeID t -> PGTextValue -> a
forall (t :: Symbol) a.
PGColumn t a =>
PGTypeEnv -> PGTypeID t -> PGTextValue -> a
pgDecodeBinary PGTypeEnv
e PGTypeID t
t
pgDecodeValue :: PGTypeEnv -> PGTypeID t -> PGValue -> Maybe a
pgDecodeValue PGTypeEnv
_ PGTypeID t
_ PGValue
PGNullValue = Maybe a
forall a. Maybe a
Nothing
pgDecodeValue PGTypeEnv
e PGTypeID t
t PGValue
v = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ PGTypeEnv -> PGTypeID t -> PGValue -> a
forall (t :: Symbol) a.
PGColumn t a =>
PGTypeEnv -> PGTypeID t -> PGValue -> a
pgDecodeValue PGTypeEnv
e PGTypeID t
t PGValue
v
pgEncodeParameter :: PGParameter t a => PGTypeEnv -> PGTypeID t -> a -> PGValue
pgEncodeParameter :: PGTypeEnv -> PGTypeID t -> a -> PGValue
pgEncodeParameter = PGTypeEnv -> PGTypeID t -> a -> PGValue
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeEnv -> PGTypeID t -> a -> PGValue
pgEncodeValue
pgEscapeParameter :: PGParameter t a => PGTypeEnv -> PGTypeID t -> a -> BS.ByteString
pgEscapeParameter :: PGTypeEnv -> PGTypeID t -> a -> PGTextValue
pgEscapeParameter PGTypeEnv
_ = PGTypeID t -> a -> PGTextValue
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> PGTextValue
pgLiteral
pgDecodeColumn :: PGColumn t (Maybe a) => PGTypeEnv -> PGTypeID t -> PGValue -> Maybe a
pgDecodeColumn :: PGTypeEnv -> PGTypeID t -> PGValue -> Maybe a
pgDecodeColumn = PGTypeEnv -> PGTypeID t -> PGValue -> Maybe a
forall (t :: Symbol) a.
PGColumn t a =>
PGTypeEnv -> PGTypeID t -> PGValue -> a
pgDecodeValue
pgDecodeColumnNotNull :: PGColumn t a => PGTypeEnv -> PGTypeID t -> PGValue -> a
pgDecodeColumnNotNull :: PGTypeEnv -> PGTypeID t -> PGValue -> a
pgDecodeColumnNotNull = PGTypeEnv -> PGTypeID t -> PGValue -> a
forall (t :: Symbol) a.
PGColumn t a =>
PGTypeEnv -> PGTypeID t -> PGValue -> a
pgDecodeValue
pgQuoteUnsafe :: BS.ByteString -> BS.ByteString
pgQuoteUnsafe :: PGTextValue -> PGTextValue
pgQuoteUnsafe = (PGTextValue -> Char -> PGTextValue
`BSC.snoc` Char
'\'') (PGTextValue -> PGTextValue)
-> (PGTextValue -> PGTextValue) -> PGTextValue -> PGTextValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> PGTextValue -> PGTextValue
BSC.cons Char
'\''
pgQuote :: BS.ByteString -> BS.ByteString
pgQuote :: PGTextValue -> PGTextValue
pgQuote PGTextValue
s
| Char
'\0' Char -> PGTextValue -> Bool
`BSC.elem` PGTextValue
s = String -> PGTextValue
forall a. HasCallStack => String -> a
error String
"pgQuote: unhandled null in literal"
| Bool
otherwise = PGTextValue -> PGTextValue
pgQuoteUnsafe (PGTextValue -> PGTextValue) -> PGTextValue -> PGTextValue
forall a b. (a -> b) -> a -> b
$ PGTextValue -> [PGTextValue] -> PGTextValue
BSC.intercalate (String -> PGTextValue
BSC.pack String
"''") ([PGTextValue] -> PGTextValue) -> [PGTextValue] -> PGTextValue
forall a b. (a -> b) -> a -> b
$ Char -> PGTextValue -> [PGTextValue]
BSC.split Char
'\'' PGTextValue
s
buildPGValue :: BSB.Builder -> BS.ByteString
buildPGValue :: Builder -> PGTextValue
buildPGValue = ByteString -> PGTextValue
BSL.toStrict (ByteString -> PGTextValue)
-> (Builder -> ByteString) -> Builder -> PGTextValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BSB.toLazyByteString
pgDQuote :: BS.ByteString -> BSB.Builder
pgDQuote :: PGTextValue -> Builder
pgDQuote PGTextValue
s = Builder
dq Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> BoundedPrim Word8 -> PGTextValue -> Builder
BSBP.primMapByteStringBounded BoundedPrim Word8
ec PGTextValue
s Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
dq where
dq :: Builder
dq = Char -> Builder
BSB.char7 Char
'"'
ec :: BoundedPrim Word8
ec = (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BSBP.condB (\Word8
c -> Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w Char
'"' Bool -> Bool -> Bool
|| Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w Char
'\\') BoundedPrim Word8
bs (FixedPrim Word8 -> BoundedPrim Word8
forall a. FixedPrim a -> BoundedPrim a
BSBP.liftFixedToBounded FixedPrim Word8
BSBP.word8)
bs :: BoundedPrim Word8
bs = FixedPrim Word8 -> BoundedPrim Word8
forall a. FixedPrim a -> BoundedPrim a
BSBP.liftFixedToBounded (FixedPrim Word8 -> BoundedPrim Word8)
-> FixedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$ ((,) Char
'\\') (Word8 -> (Char, Word8))
-> FixedPrim (Char, Word8) -> FixedPrim Word8
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
BSBP.>$< (FixedPrim Char
BSBP.char7 FixedPrim Char -> FixedPrim Word8 -> FixedPrim (Char, Word8)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
BSBP.>*< FixedPrim Word8
BSBP.word8)
pgDQuoteFrom :: [Char] -> BS.ByteString -> BSB.Builder
pgDQuoteFrom :: String -> PGTextValue -> Builder
pgDQuoteFrom String
unsafe PGTextValue
s
| PGTextValue -> Bool
BS.null PGTextValue
s Bool -> Bool -> Bool
|| (Char -> Bool) -> PGTextValue -> Bool
BSC.any (\Char
c -> Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\' Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
unsafe) PGTextValue
s Bool -> Bool -> Bool
|| (Char -> Char) -> PGTextValue -> PGTextValue
BSC.map Char -> Char
toLower PGTextValue
s PGTextValue -> PGTextValue -> Bool
forall a. Eq a => a -> a -> Bool
== String -> PGTextValue
BSC.pack String
"null" = PGTextValue -> Builder
pgDQuote PGTextValue
s
| Bool
otherwise = PGTextValue -> Builder
BSB.byteString PGTextValue
s
parsePGDQuote :: Bool -> [Char] -> (BS.ByteString -> Bool) -> P.Parser (Maybe BS.ByteString)
parsePGDQuote :: Bool
-> String -> (PGTextValue -> Bool) -> Parser (Maybe PGTextValue)
parsePGDQuote Bool
blank String
unsafe PGTextValue -> Bool
isnul = (PGTextValue -> Maybe PGTextValue
forall a. a -> Maybe a
Just (PGTextValue -> Maybe PGTextValue)
-> Parser PGTextValue PGTextValue -> Parser (Maybe PGTextValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PGTextValue PGTextValue
q) Parser (Maybe PGTextValue)
-> Parser (Maybe PGTextValue) -> Parser (Maybe PGTextValue)
forall a. Semigroup a => a -> a -> a
<> (PGTextValue -> Maybe PGTextValue
mnul (PGTextValue -> Maybe PGTextValue)
-> Parser PGTextValue PGTextValue -> Parser (Maybe PGTextValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PGTextValue PGTextValue
uq) where
q :: Parser PGTextValue PGTextValue
q = Char -> Parser Char
P.char Char
'"' Parser Char
-> Parser PGTextValue PGTextValue -> Parser PGTextValue PGTextValue
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([PGTextValue] -> PGTextValue
BS.concat ([PGTextValue] -> PGTextValue)
-> Parser PGTextValue [PGTextValue]
-> Parser PGTextValue PGTextValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PGTextValue [PGTextValue]
qs)
qs :: Parser PGTextValue [PGTextValue]
qs = do
PGTextValue
p <- (Char -> Bool) -> Parser PGTextValue PGTextValue
P.takeTill (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\')
Char
e <- Parser Char
P.anyChar
if Char
e Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"'
then [PGTextValue] -> Parser PGTextValue [PGTextValue]
forall (m :: * -> *) a. Monad m => a -> m a
return [PGTextValue
p]
else do
Word8
c <- Parser Word8
P.anyWord8
(PGTextValue
p PGTextValue -> [PGTextValue] -> [PGTextValue]
forall a. a -> [a] -> [a]
:) ([PGTextValue] -> [PGTextValue])
-> ([PGTextValue] -> [PGTextValue])
-> [PGTextValue]
-> [PGTextValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> PGTextValue
BS.singleton Word8
c PGTextValue -> [PGTextValue] -> [PGTextValue]
forall a. a -> [a] -> [a]
:) ([PGTextValue] -> [PGTextValue])
-> Parser PGTextValue [PGTextValue]
-> Parser PGTextValue [PGTextValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PGTextValue [PGTextValue]
qs
uq :: Parser PGTextValue PGTextValue
uq = (if Bool
blank then (Char -> Bool) -> Parser PGTextValue PGTextValue
P.takeWhile else (Char -> Bool) -> Parser PGTextValue PGTextValue
P.takeWhile1) (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (Char
'"'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
'\\'Char -> ShowS
forall a. a -> [a] -> [a]
:String
unsafe))
mnul :: PGTextValue -> Maybe PGTextValue
mnul PGTextValue
s
| PGTextValue -> Bool
isnul PGTextValue
s = Maybe PGTextValue
forall a. Maybe a
Nothing
| Bool
otherwise = PGTextValue -> Maybe PGTextValue
forall a. a -> Maybe a
Just PGTextValue
s
#ifdef VERSION_postgresql_binary
binEnc :: BinEncoder a -> a -> BS.ByteString
binEnc :: BinEncoder a -> a -> PGTextValue
binEnc = (Encoding -> PGTextValue) -> BinEncoder a -> a -> PGTextValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)
#if MIN_VERSION_postgresql_binary(0,12,0)
Encoding -> PGTextValue
BinE.encodingBytes
type BinDecoder = BinD.Value
type BinEncoder a = a -> BinE.Encoding
#else
buildPGValue
type BinDecoder = BinD.Decoder
type BinEncoder a = BinE.Encoder a
#endif
binDec :: PGType t => BinDecoder a -> PGTypeID t -> PGBinaryValue -> a
binDec :: BinDecoder a -> PGTypeID t -> PGTextValue -> a
binDec BinDecoder a
d PGTypeID t
t = (Text -> a) -> (a -> a) -> Either Text a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\Text
e -> String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"pgDecodeBinary " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PGName -> String
forall a. Show a => a -> String
show (PGTypeID t -> PGName
forall (t :: Symbol). PGType t => PGTypeID t -> PGName
pgTypeName PGTypeID t
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
e) a -> a
forall a. a -> a
id (Either Text a -> a)
-> (PGTextValue -> Either Text a) -> PGTextValue -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
#if MIN_VERSION_postgresql_binary(0,12,0)
BinDecoder a -> PGTextValue -> Either Text a
forall a. Value a -> PGTextValue -> Either Text a
BinD.valueParser
#else
BinD.run
#endif
BinDecoder a
d
#define BIN_COL pgBinaryColumn _ _ = True
#define BIN_ENC(F) pgEncodeValue _ _ = PGBinaryValue . binEnc (F)
#define BIN_DEC(F) pgDecodeBinary _ = binDec (F)
#else
#define BIN_COL
#define BIN_ENC(F)
#define BIN_DEC(F)
#endif
instance PGType "any" where
type PGVal "any" = PGValue
instance PGType t => PGColumn t PGValue where
pgDecode :: PGTypeID t -> PGTextValue -> PGValue
pgDecode PGTypeID t
_ = PGTextValue -> PGValue
PGTextValue
pgDecodeBinary :: PGTypeEnv -> PGTypeID t -> PGTextValue -> PGValue
pgDecodeBinary PGTypeEnv
_ PGTypeID t
_ = PGTextValue -> PGValue
PGBinaryValue
pgDecodeValue :: PGTypeEnv -> PGTypeID t -> PGValue -> PGValue
pgDecodeValue PGTypeEnv
_ PGTypeID t
_ = PGValue -> PGValue
forall a. a -> a
id
instance PGParameter "any" PGValue where
pgEncode :: PGTypeID "any" -> PGValue -> PGTextValue
pgEncode PGTypeID "any"
_ (PGTextValue PGTextValue
v) = PGTextValue
v
pgEncode PGTypeID "any"
_ PGValue
PGNullValue = String -> PGTextValue
forall a. HasCallStack => String -> a
error String
"pgEncode any: NULL"
pgEncode PGTypeID "any"
_ (PGBinaryValue PGTextValue
_) = String -> PGTextValue
forall a. HasCallStack => String -> a
error String
"pgEncode any: binary"
pgEncodeValue :: PGTypeEnv -> PGTypeID "any" -> PGValue -> PGValue
pgEncodeValue PGTypeEnv
_ PGTypeID "any"
_ = PGValue -> PGValue
forall a. a -> a
id
instance PGType "void" where
type PGVal "void" = ()
instance PGParameter "void" () where
pgEncode :: PGTypeID "void" -> () -> PGTextValue
pgEncode PGTypeID "void"
_ ()
_ = PGTextValue
BSC.empty
instance PGColumn "void" () where
pgDecode :: PGTypeID "void" -> PGTextValue -> ()
pgDecode PGTypeID "void"
_ PGTextValue
_ = ()
pgDecodeBinary :: PGTypeEnv -> PGTypeID "void" -> PGTextValue -> ()
pgDecodeBinary PGTypeEnv
_ PGTypeID "void"
_ PGTextValue
_ = ()
pgDecodeValue :: PGTypeEnv -> PGTypeID "void" -> PGValue -> ()
pgDecodeValue PGTypeEnv
_ PGTypeID "void"
_ PGValue
_ = ()
instance PGType "boolean" where
type PGVal "boolean" = Bool
BIN_COL
instance PGParameter "boolean" Bool where
pgEncode :: PGTypeID "boolean" -> Bool -> PGTextValue
pgEncode PGTypeID "boolean"
_ Bool
False = Char -> PGTextValue
BSC.singleton Char
'f'
pgEncode PGTypeID "boolean"
_ Bool
True = Char -> PGTextValue
BSC.singleton Char
't'
pgLiteral :: PGTypeID "boolean" -> Bool -> PGTextValue
pgLiteral PGTypeID "boolean"
_ Bool
False = String -> PGTextValue
BSC.pack String
"false"
pgLiteral PGTypeID "boolean"
_ Bool
True = String -> PGTextValue
BSC.pack String
"true"
BIN_ENC(BinE.bool)
instance PGColumn "boolean" Bool where
pgDecode :: PGTypeID "boolean" -> PGTextValue -> Bool
pgDecode PGTypeID "boolean"
_ PGTextValue
s = case PGTextValue -> Char
BSC.head PGTextValue
s of
Char
'f' -> Bool
False
Char
't' -> Bool
True
Char
c -> String -> Bool
forall a. HasCallStack => String -> a
error (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
"pgDecode boolean: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
c]
BIN_DEC(BinD.bool)
type OID = Word32
instance PGType "oid" where
type PGVal "oid" = OID
BIN_COL
instance PGParameter "oid" OID where
pgEncode :: PGTypeID "oid" -> OID -> PGTextValue
pgEncode PGTypeID "oid"
_ = String -> PGTextValue
BSC.pack (String -> PGTextValue) -> (OID -> String) -> OID -> PGTextValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OID -> String
forall a. Show a => a -> String
show
pgLiteral :: PGTypeID "oid" -> OID -> PGTextValue
pgLiteral = PGTypeID "oid" -> OID -> PGTextValue
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> PGTextValue
pgEncode
BIN_ENC(BinE.int4_word32)
instance PGColumn "oid" OID where
pgDecode :: PGTypeID "oid" -> PGTextValue -> OID
pgDecode PGTypeID "oid"
_ = String -> OID
forall a. Read a => String -> a
read (String -> OID) -> (PGTextValue -> String) -> PGTextValue -> OID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTextValue -> String
BSC.unpack
BIN_DEC(BinD.int)
instance PGType "smallint" where
type PGVal "smallint" = Int16
BIN_COL
instance PGParameter "smallint" Int16 where
pgEncode :: PGTypeID "smallint" -> Int16 -> PGTextValue
pgEncode PGTypeID "smallint"
_ = String -> PGTextValue
BSC.pack (String -> PGTextValue)
-> (Int16 -> String) -> Int16 -> PGTextValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> String
forall a. Show a => a -> String
show
pgLiteral :: PGTypeID "smallint" -> Int16 -> PGTextValue
pgLiteral = PGTypeID "smallint" -> Int16 -> PGTextValue
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> PGTextValue
pgEncode
BIN_ENC(BinE.int2_int16)
instance PGColumn "smallint" Int16 where
pgDecode :: PGTypeID "smallint" -> PGTextValue -> Int16
pgDecode PGTypeID "smallint"
_ = String -> Int16
forall a. Read a => String -> a
read (String -> Int16)
-> (PGTextValue -> String) -> PGTextValue -> Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTextValue -> String
BSC.unpack
BIN_DEC(BinD.int)
instance PGType "integer" where
type PGVal "integer" = Int32
BIN_COL
instance PGParameter "integer" Int32 where
pgEncode :: PGTypeID "integer" -> Int32 -> PGTextValue
pgEncode PGTypeID "integer"
_ = String -> PGTextValue
BSC.pack (String -> PGTextValue)
-> (Int32 -> String) -> Int32 -> PGTextValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> String
forall a. Show a => a -> String
show
pgLiteral :: PGTypeID "integer" -> Int32 -> PGTextValue
pgLiteral = PGTypeID "integer" -> Int32 -> PGTextValue
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> PGTextValue
pgEncode
BIN_ENC(BinE.int4_int32)
instance PGColumn "integer" Int32 where
pgDecode :: PGTypeID "integer" -> PGTextValue -> Int32
pgDecode PGTypeID "integer"
_ = String -> Int32
forall a. Read a => String -> a
read (String -> Int32)
-> (PGTextValue -> String) -> PGTextValue -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTextValue -> String
BSC.unpack
BIN_DEC(BinD.int)
instance PGType "bigint" where
type PGVal "bigint" = Int64
BIN_COL
instance PGParameter "bigint" Int64 where
pgEncode :: PGTypeID "bigint" -> Int64 -> PGTextValue
pgEncode PGTypeID "bigint"
_ = String -> PGTextValue
BSC.pack (String -> PGTextValue)
-> (Int64 -> String) -> Int64 -> PGTextValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> String
forall a. Show a => a -> String
show
pgLiteral :: PGTypeID "bigint" -> Int64 -> PGTextValue
pgLiteral = PGTypeID "bigint" -> Int64 -> PGTextValue
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> PGTextValue
pgEncode
BIN_ENC(BinE.int8_int64)
instance PGColumn "bigint" Int64 where
pgDecode :: PGTypeID "bigint" -> PGTextValue -> Int64
pgDecode PGTypeID "bigint"
_ = String -> Int64
forall a. Read a => String -> a
read (String -> Int64)
-> (PGTextValue -> String) -> PGTextValue -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTextValue -> String
BSC.unpack
BIN_DEC(BinD.int)
instance PGType "real" where
type PGVal "real" = Float
BIN_COL
instance PGParameter "real" Float where
pgEncode :: PGTypeID "real" -> Float -> PGTextValue
pgEncode PGTypeID "real"
_ = String -> PGTextValue
BSC.pack (String -> PGTextValue)
-> (Float -> String) -> Float -> PGTextValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> String
forall a. Show a => a -> String
show
pgLiteral :: PGTypeID "real" -> Float -> PGTextValue
pgLiteral = PGTypeID "real" -> Float -> PGTextValue
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> PGTextValue
pgEncode
BIN_ENC(BinE.float4)
instance PGColumn "real" Float where
pgDecode :: PGTypeID "real" -> PGTextValue -> Float
pgDecode PGTypeID "real"
_ = String -> Float
forall a. Read a => String -> a
read (String -> Float)
-> (PGTextValue -> String) -> PGTextValue -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTextValue -> String
BSC.unpack
BIN_DEC(BinD.float4)
instance PGColumn "real" Double where
pgDecode :: PGTypeID "real" -> PGTextValue -> Double
pgDecode PGTypeID "real"
_ = String -> Double
forall a. Read a => String -> a
read (String -> Double)
-> (PGTextValue -> String) -> PGTextValue -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTextValue -> String
BSC.unpack
BIN_DEC(realToFrac <$> BinD.float4)
instance PGType "double precision" where
type PGVal "double precision" = Double
BIN_COL
instance PGParameter "double precision" Double where
pgEncode :: PGTypeID "double precision" -> Double -> PGTextValue
pgEncode PGTypeID "double precision"
_ = String -> PGTextValue
BSC.pack (String -> PGTextValue)
-> (Double -> String) -> Double -> PGTextValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. Show a => a -> String
show
pgLiteral :: PGTypeID "double precision" -> Double -> PGTextValue
pgLiteral = PGTypeID "double precision" -> Double -> PGTextValue
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> PGTextValue
pgEncode
BIN_ENC(BinE.float8)
instance PGParameter "double precision" Float where
pgEncode :: PGTypeID "double precision" -> Float -> PGTextValue
pgEncode PGTypeID "double precision"
_ = String -> PGTextValue
BSC.pack (String -> PGTextValue)
-> (Float -> String) -> Float -> PGTextValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> String
forall a. Show a => a -> String
show
pgLiteral :: PGTypeID "double precision" -> Float -> PGTextValue
pgLiteral = PGTypeID "double precision" -> Float -> PGTextValue
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> PGTextValue
pgEncode
BIN_ENC(BinE.float8 . realToFrac)
instance PGColumn "double precision" Double where
pgDecode :: PGTypeID "double precision" -> PGTextValue -> Double
pgDecode PGTypeID "double precision"
_ = String -> Double
forall a. Read a => String -> a
read (String -> Double)
-> (PGTextValue -> String) -> PGTextValue -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTextValue -> String
BSC.unpack
BIN_DEC(BinD.float8)
instance PGType "\"char\"" where
type PGVal "\"char\"" = Word8
BIN_COL
instance PGParameter "\"char\"" Word8 where
pgEncode :: PGTypeID "\"char\"" -> Word8 -> PGTextValue
pgEncode PGTypeID "\"char\""
_ = Word8 -> PGTextValue
BS.singleton
pgEncodeValue :: PGTypeEnv -> PGTypeID "\"char\"" -> Word8 -> PGValue
pgEncodeValue PGTypeEnv
_ PGTypeID "\"char\""
_ = PGTextValue -> PGValue
PGBinaryValue (PGTextValue -> PGValue)
-> (Word8 -> PGTextValue) -> Word8 -> PGValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> PGTextValue
BS.singleton
instance PGColumn "\"char\"" Word8 where
pgDecode :: PGTypeID "\"char\"" -> PGTextValue -> Word8
pgDecode PGTypeID "\"char\""
_ = PGTextValue -> Word8
BS.head
pgDecodeBinary :: PGTypeEnv -> PGTypeID "\"char\"" -> PGTextValue -> Word8
pgDecodeBinary PGTypeEnv
_ PGTypeID "\"char\""
_ = PGTextValue -> Word8
BS.head
instance PGParameter "\"char\"" Char where
pgEncode :: PGTypeID "\"char\"" -> Char -> PGTextValue
pgEncode PGTypeID "\"char\""
_ = Char -> PGTextValue
BSC.singleton
pgEncodeValue :: PGTypeEnv -> PGTypeID "\"char\"" -> Char -> PGValue
pgEncodeValue PGTypeEnv
_ PGTypeID "\"char\""
_ = PGTextValue -> PGValue
PGBinaryValue (PGTextValue -> PGValue)
-> (Char -> PGTextValue) -> Char -> PGValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> PGTextValue
BSC.singleton
instance PGColumn "\"char\"" Char where
pgDecode :: PGTypeID "\"char\"" -> PGTextValue -> Char
pgDecode PGTypeID "\"char\""
_ = PGTextValue -> Char
BSC.head
pgDecodeBinary :: PGTypeEnv -> PGTypeID "\"char\"" -> PGTextValue -> Char
pgDecodeBinary PGTypeEnv
_ PGTypeID "\"char\""
_ = PGTextValue -> Char
BSC.head
class PGType t => PGStringType t
instance PGStringType t => PGParameter t String where
pgEncode :: PGTypeID t -> String -> PGTextValue
pgEncode PGTypeID t
_ = String -> PGTextValue
BSU.fromString
BIN_ENC(BinE.text_strict . T.pack)
instance PGStringType t => PGColumn t String where
pgDecode :: PGTypeID t -> PGTextValue -> String
pgDecode PGTypeID t
_ = PGTextValue -> String
BSU.toString
BIN_DEC(T.unpack <$> BinD.text_strict)
instance
#if __GLASGOW_HASKELL__ >= 710
{-# OVERLAPPABLE #-}
#endif
PGStringType t => PGParameter t BS.ByteString where
pgEncode :: PGTypeID t -> PGTextValue -> PGTextValue
pgEncode PGTypeID t
_ = PGTextValue -> PGTextValue
forall a. a -> a
id
BIN_ENC(BinE.text_strict . TE.decodeUtf8)
instance
#if __GLASGOW_HASKELL__ >= 710
{-# OVERLAPPABLE #-}
#endif
PGStringType t => PGColumn t BS.ByteString where
pgDecode :: PGTypeID t -> PGTextValue -> PGTextValue
pgDecode PGTypeID t
_ = PGTextValue -> PGTextValue
forall a. a -> a
id
BIN_DEC(TE.encodeUtf8 <$> BinD.text_strict)
instance
#if __GLASGOW_HASKELL__ >= 710
{-# OVERLAPPABLE #-}
#endif
PGStringType t => PGParameter t PGName where
pgEncode :: PGTypeID t -> PGName -> PGTextValue
pgEncode PGTypeID t
_ = PGName -> PGTextValue
pgNameBS
BIN_ENC(BinE.text_strict . TE.decodeUtf8 . pgNameBS)
instance
#if __GLASGOW_HASKELL__ >= 710
{-# OVERLAPPABLE #-}
#endif
PGStringType t => PGColumn t PGName where
pgDecode :: PGTypeID t -> PGTextValue -> PGName
pgDecode PGTypeID t
_ = [Word8] -> PGName
PGName ([Word8] -> PGName)
-> (PGTextValue -> [Word8]) -> PGTextValue -> PGName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTextValue -> [Word8]
BS.unpack
BIN_DEC(PGName PGTypeEnv
. BS.unpack . TE.encodeUtf8 <$> BinD.text_strict)
instance
#if __GLASGOW_HASKELL__ >= 710
{-# OVERLAPPABLE #-}
#endif
PGStringType t => PGParameter t BSL.ByteString where
pgEncode :: PGTypeID t -> ByteString -> PGTextValue
pgEncode PGTypeID t
_ = ByteString -> PGTextValue
BSL.toStrict
BIN_ENC(BinE.text_lazy . TLE.decodeUtf8)
instance
#if __GLASGOW_HASKELL__ >= 710
{-# OVERLAPPABLE #-}
#endif
PGStringType t => PGColumn t BSL.ByteString where
pgDecode :: PGTypeID t -> PGTextValue -> ByteString
pgDecode PGTypeID t
_ = PGTextValue -> ByteString
BSL.fromStrict
BIN_DEC(TLE.encodeUtf8 <$> BinD.text_lazy)
#ifdef VERSION_text
instance PGStringType t => PGParameter t T.Text where
pgEncode :: PGTypeID t -> Text -> PGTextValue
pgEncode PGTypeID t
_ = Text -> PGTextValue
TE.encodeUtf8
BIN_ENC(BinE.text_strict)
instance PGStringType t => PGColumn t T.Text where
pgDecode :: PGTypeID t -> PGTextValue -> Text
pgDecode PGTypeID t
_ = PGTextValue -> Text
TE.decodeUtf8
BIN_DEC(BinD.text_strict)
instance PGStringType t => PGParameter t TL.Text where
pgEncode :: PGTypeID t -> Text -> PGTextValue
pgEncode PGTypeID t
_ = ByteString -> PGTextValue
BSL.toStrict (ByteString -> PGTextValue)
-> (Text -> ByteString) -> Text -> PGTextValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TLE.encodeUtf8
BIN_ENC(BinE.text_lazy)
instance PGStringType t => PGColumn t TL.Text where
pgDecode :: PGTypeID t -> PGTextValue -> Text
pgDecode PGTypeID t
_ = Text -> Text
TL.fromStrict (Text -> Text) -> (PGTextValue -> Text) -> PGTextValue -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTextValue -> Text
TE.decodeUtf8
BIN_DEC(BinD.text_lazy)
#define PGVALSTRING T.Text
#else
#define PGVALSTRING String
#endif
instance PGType "text" where
type PGVal "text" = PGVALSTRING
BIN_COL
instance PGType "character varying" where
type PGVal "character varying" = PGVALSTRING
BIN_COL
instance PGType "name" where
type PGVal "name" = PGVALSTRING
BIN_COL
instance PGType "bpchar" where
type PGVal "bpchar" = PGVALSTRING
BIN_COL
instance PGStringType "text"
instance PGStringType "character varying"
instance PGStringType "name"
instance PGStringType "bpchar"
encodeBytea :: BSB.Builder -> PGTextValue
encodeBytea :: Builder -> PGTextValue
encodeBytea Builder
h = Builder -> PGTextValue
buildPGValue (Builder -> PGTextValue) -> Builder -> PGTextValue
forall a b. (a -> b) -> a -> b
$ String -> Builder
BSB.string7 String
"\\x" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
h
decodeBytea :: PGTextValue -> [Word8]
decodeBytea :: PGTextValue -> [Word8]
decodeBytea PGTextValue
s
| String
sm String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"\\x" = String -> [Word8]
forall a. HasCallStack => String -> a
error (String -> [Word8]) -> String -> [Word8]
forall a b. (a -> b) -> a -> b
$ String
"pgDecode bytea: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
sm
| Bool
otherwise = [Word8] -> [Word8]
pd ([Word8] -> [Word8]) -> [Word8] -> [Word8]
forall a b. (a -> b) -> a -> b
$ PGTextValue -> [Word8]
BS.unpack PGTextValue
d where
(PGTextValue
m, PGTextValue
d) = Int -> PGTextValue -> (PGTextValue, PGTextValue)
BS.splitAt Int
2 PGTextValue
s
sm :: String
sm = PGTextValue -> String
BSC.unpack PGTextValue
m
pd :: [Word8] -> [Word8]
pd [] = []
pd (Word8
h:Word8
l:[Word8]
r) = (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word8
unhex Word8
h) Int
4 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8 -> Word8
unhex Word8
l) Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: [Word8] -> [Word8]
pd [Word8]
r
pd [Word8
x] = String -> [Word8]
forall a. HasCallStack => String -> a
error (String -> [Word8]) -> String -> [Word8]
forall a b. (a -> b) -> a -> b
$ String
"pgDecode bytea: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
x
unhex :: Word8 -> Word8
unhex = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Word8 -> Int) -> Word8 -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
digitToInt (Char -> Int) -> (Word8 -> Char) -> Word8 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
w2c
instance PGType "bytea" where
type PGVal "bytea" = BS.ByteString
BIN_COL
instance
#if __GLASGOW_HASKELL__ >= 710
{-# OVERLAPPING #-}
#endif
PGParameter "bytea" BSL.ByteString where
pgEncode :: PGTypeID "bytea" -> ByteString -> PGTextValue
pgEncode PGTypeID "bytea"
_ = Builder -> PGTextValue
encodeBytea (Builder -> PGTextValue)
-> (ByteString -> Builder) -> ByteString -> PGTextValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
BSB.lazyByteStringHex
pgLiteral :: PGTypeID "bytea" -> ByteString -> PGTextValue
pgLiteral PGTypeID "bytea"
t = PGTextValue -> PGTextValue
pgQuoteUnsafe (PGTextValue -> PGTextValue)
-> (ByteString -> PGTextValue) -> ByteString -> PGTextValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTypeID "bytea" -> ByteString -> PGTextValue
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> PGTextValue
pgEncode PGTypeID "bytea"
t
BIN_ENC(BinE.bytea_lazy)
instance
#if __GLASGOW_HASKELL__ >= 710
{-# OVERLAPPING #-}
#endif
PGColumn "bytea" BSL.ByteString where
pgDecode :: PGTypeID "bytea" -> PGTextValue -> ByteString
pgDecode PGTypeID "bytea"
_ = [Word8] -> ByteString
BSL.pack ([Word8] -> ByteString)
-> (PGTextValue -> [Word8]) -> PGTextValue -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTextValue -> [Word8]
decodeBytea
BIN_DEC(BinD.bytea_lazy)
instance
#if __GLASGOW_HASKELL__ >= 710
{-# OVERLAPPING #-}
#endif
PGParameter "bytea" BS.ByteString where
pgEncode :: PGTypeID "bytea" -> PGTextValue -> PGTextValue
pgEncode PGTypeID "bytea"
_ = Builder -> PGTextValue
encodeBytea (Builder -> PGTextValue)
-> (PGTextValue -> Builder) -> PGTextValue -> PGTextValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTextValue -> Builder
BSB.byteStringHex
pgLiteral :: PGTypeID "bytea" -> PGTextValue -> PGTextValue
pgLiteral PGTypeID "bytea"
t = PGTextValue -> PGTextValue
pgQuoteUnsafe (PGTextValue -> PGTextValue)
-> (PGTextValue -> PGTextValue) -> PGTextValue -> PGTextValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTypeID "bytea" -> PGTextValue -> PGTextValue
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> PGTextValue
pgEncode PGTypeID "bytea"
t
BIN_ENC(BinE.bytea_strict)
instance
#if __GLASGOW_HASKELL__ >= 710
{-# OVERLAPPING #-}
#endif
PGColumn "bytea" BS.ByteString where
pgDecode :: PGTypeID "bytea" -> PGTextValue -> PGTextValue
pgDecode PGTypeID "bytea"
_ = [Word8] -> PGTextValue
BS.pack ([Word8] -> PGTextValue)
-> (PGTextValue -> [Word8]) -> PGTextValue -> PGTextValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTextValue -> [Word8]
decodeBytea
BIN_DEC(BinD.bytea_strict)
readTime :: Time.ParseTime t => String -> String -> t
readTime :: String -> String -> t
readTime =
#if MIN_VERSION_time(1,5,0)
Bool -> TimeLocale -> String -> String -> t
forall t.
ParseTime t =>
Bool -> TimeLocale -> String -> String -> t
Time.parseTimeOrError Bool
False
#else
Time.readTime
#endif
TimeLocale
defaultTimeLocale
instance PGType "date" where
type PGVal "date" = Time.Day
BIN_COL
instance PGParameter "date" Time.Day where
pgEncode :: PGTypeID "date" -> Day -> PGTextValue
pgEncode PGTypeID "date"
_ = String -> PGTextValue
BSC.pack (String -> PGTextValue) -> (Day -> String) -> Day -> PGTextValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> String
Time.showGregorian
pgLiteral :: PGTypeID "date" -> Day -> PGTextValue
pgLiteral PGTypeID "date"
t = PGTextValue -> PGTextValue
pgQuoteUnsafe (PGTextValue -> PGTextValue)
-> (Day -> PGTextValue) -> Day -> PGTextValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTypeID "date" -> Day -> PGTextValue
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> PGTextValue
pgEncode PGTypeID "date"
t
BIN_ENC(BinE.date)
instance PGColumn "date" Time.Day where
pgDecode :: PGTypeID "date" -> PGTextValue -> Day
pgDecode PGTypeID "date"
_ = String -> String -> Day
forall t. ParseTime t => String -> String -> t
readTime String
"%F" (String -> Day) -> (PGTextValue -> String) -> PGTextValue -> Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTextValue -> String
BSC.unpack
BIN_DEC(BinD.date)
binColDatetime :: PGTypeEnv -> PGTypeID t -> Bool
#ifdef VERSION_postgresql_binary
binColDatetime :: PGTypeEnv -> PGTypeID t -> Bool
binColDatetime PGTypeEnv{ pgIntegerDatetimes :: PGTypeEnv -> Maybe Bool
pgIntegerDatetimes = Just Bool
_ } PGTypeID t
_ = Bool
True
#endif
binColDatetime PGTypeEnv
_ PGTypeID t
_ = Bool
False
#ifdef VERSION_postgresql_binary
binEncDatetime :: PGParameter t a => BinEncoder a -> BinEncoder a -> PGTypeEnv -> PGTypeID t -> a -> PGValue
binEncDatetime :: BinEncoder a
-> BinEncoder a -> PGTypeEnv -> PGTypeID t -> a -> PGValue
binEncDatetime BinEncoder a
_ BinEncoder a
ff PGTypeEnv{ pgIntegerDatetimes :: PGTypeEnv -> Maybe Bool
pgIntegerDatetimes = Just Bool
False } PGTypeID t
_ = PGTextValue -> PGValue
PGBinaryValue (PGTextValue -> PGValue) -> (a -> PGTextValue) -> a -> PGValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinEncoder a -> a -> PGTextValue
forall a. BinEncoder a -> a -> PGTextValue
binEnc BinEncoder a
ff
binEncDatetime BinEncoder a
fi BinEncoder a
_ PGTypeEnv{ pgIntegerDatetimes :: PGTypeEnv -> Maybe Bool
pgIntegerDatetimes = Just Bool
True } PGTypeID t
_ = PGTextValue -> PGValue
PGBinaryValue (PGTextValue -> PGValue) -> (a -> PGTextValue) -> a -> PGValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinEncoder a -> a -> PGTextValue
forall a. BinEncoder a -> a -> PGTextValue
binEnc BinEncoder a
fi
binEncDatetime BinEncoder a
_ BinEncoder a
_ PGTypeEnv{ pgIntegerDatetimes :: PGTypeEnv -> Maybe Bool
pgIntegerDatetimes = Maybe Bool
Nothing } PGTypeID t
t = PGTextValue -> PGValue
PGTextValue (PGTextValue -> PGValue) -> (a -> PGTextValue) -> a -> PGValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTypeID t -> a -> PGTextValue
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> PGTextValue
pgEncode PGTypeID t
t
binDecDatetime :: PGColumn t a => BinDecoder a -> BinDecoder a -> PGTypeEnv -> PGTypeID t -> PGBinaryValue -> a
binDecDatetime :: BinDecoder a
-> BinDecoder a -> PGTypeEnv -> PGTypeID t -> PGTextValue -> a
binDecDatetime BinDecoder a
_ BinDecoder a
ff PGTypeEnv{ pgIntegerDatetimes :: PGTypeEnv -> Maybe Bool
pgIntegerDatetimes = Just Bool
False } = BinDecoder a -> PGTypeID t -> PGTextValue -> a
forall (t :: Symbol) a.
PGType t =>
BinDecoder a -> PGTypeID t -> PGTextValue -> a
binDec BinDecoder a
ff
binDecDatetime BinDecoder a
fi BinDecoder a
_ PGTypeEnv{ pgIntegerDatetimes :: PGTypeEnv -> Maybe Bool
pgIntegerDatetimes = Just Bool
True } = BinDecoder a -> PGTypeID t -> PGTextValue -> a
forall (t :: Symbol) a.
PGType t =>
BinDecoder a -> PGTypeID t -> PGTextValue -> a
binDec BinDecoder a
fi
binDecDatetime BinDecoder a
_ BinDecoder a
_ PGTypeEnv{ pgIntegerDatetimes :: PGTypeEnv -> Maybe Bool
pgIntegerDatetimes = Maybe Bool
Nothing } = String -> PGTypeID t -> PGTextValue -> a
forall a. HasCallStack => String -> a
error String
"pgDecodeBinary: unknown integer_datetimes value"
#endif
fixTZ :: String -> String
fixTZ :: ShowS
fixTZ String
"" = String
""
fixTZ [Char
'+',Char
h1,Char
h2] | Char -> Bool
isDigit Char
h1 Bool -> Bool -> Bool
&& Char -> Bool
isDigit Char
h2 = [Char
'+',Char
h1,Char
h2,Char
':',Char
'0',Char
'0']
fixTZ [Char
'-',Char
h1,Char
h2] | Char -> Bool
isDigit Char
h1 Bool -> Bool -> Bool
&& Char -> Bool
isDigit Char
h2 = [Char
'-',Char
h1,Char
h2,Char
':',Char
'0',Char
'0']
fixTZ [Char
'+',Char
h1,Char
h2,Char
m1,Char
m2] | Char -> Bool
isDigit Char
h1 Bool -> Bool -> Bool
&& Char -> Bool
isDigit Char
h2 Bool -> Bool -> Bool
&& Char -> Bool
isDigit Char
m1 Bool -> Bool -> Bool
&& Char -> Bool
isDigit Char
m2 = [Char
'+',Char
h1,Char
h2,Char
':',Char
m1,Char
m2]
fixTZ [Char
'-',Char
h1,Char
h2,Char
m1,Char
m2] | Char -> Bool
isDigit Char
h1 Bool -> Bool -> Bool
&& Char -> Bool
isDigit Char
h2 Bool -> Bool -> Bool
&& Char -> Bool
isDigit Char
m1 Bool -> Bool -> Bool
&& Char -> Bool
isDigit Char
m2 = [Char
'-',Char
h1,Char
h2,Char
':',Char
m1,Char
m2]
fixTZ (Char
c:String
s) = Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:ShowS
fixTZ String
s
instance PGType "time without time zone" where
type PGVal "time without time zone" = Time.TimeOfDay
pgBinaryColumn :: PGTypeEnv -> PGTypeID "time without time zone" -> Bool
pgBinaryColumn = PGTypeEnv -> PGTypeID "time without time zone" -> Bool
forall (t :: Symbol). PGTypeEnv -> PGTypeID t -> Bool
binColDatetime
instance PGParameter "time without time zone" Time.TimeOfDay where
pgEncode :: PGTypeID "time without time zone" -> TimeOfDay -> PGTextValue
pgEncode PGTypeID "time without time zone"
_ = String -> PGTextValue
BSC.pack (String -> PGTextValue)
-> (TimeOfDay -> String) -> TimeOfDay -> PGTextValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> TimeOfDay -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
Time.formatTime TimeLocale
defaultTimeLocale String
"%T%Q"
pgLiteral :: PGTypeID "time without time zone" -> TimeOfDay -> PGTextValue
pgLiteral PGTypeID "time without time zone"
t = PGTextValue -> PGTextValue
pgQuoteUnsafe (PGTextValue -> PGTextValue)
-> (TimeOfDay -> PGTextValue) -> TimeOfDay -> PGTextValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTypeID "time without time zone" -> TimeOfDay -> PGTextValue
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> PGTextValue
pgEncode PGTypeID "time without time zone"
t
#ifdef VERSION_postgresql_binary
pgEncodeValue :: PGTypeEnv
-> PGTypeID "time without time zone" -> TimeOfDay -> PGValue
pgEncodeValue = BinEncoder TimeOfDay
-> BinEncoder TimeOfDay
-> PGTypeEnv
-> PGTypeID "time without time zone"
-> TimeOfDay
-> PGValue
forall (t :: Symbol) a.
PGParameter t a =>
BinEncoder a
-> BinEncoder a -> PGTypeEnv -> PGTypeID t -> a -> PGValue
binEncDatetime BinEncoder TimeOfDay
BinE.time_int BinEncoder TimeOfDay
BinE.time_float
#endif
instance PGColumn "time without time zone" Time.TimeOfDay where
pgDecode :: PGTypeID "time without time zone" -> PGTextValue -> TimeOfDay
pgDecode PGTypeID "time without time zone"
_ = String -> String -> TimeOfDay
forall t. ParseTime t => String -> String -> t
readTime String
"%T%Q" (String -> TimeOfDay)
-> (PGTextValue -> String) -> PGTextValue -> TimeOfDay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTextValue -> String
BSC.unpack
#ifdef VERSION_postgresql_binary
pgDecodeBinary :: PGTypeEnv
-> PGTypeID "time without time zone" -> PGTextValue -> TimeOfDay
pgDecodeBinary = BinDecoder TimeOfDay
-> BinDecoder TimeOfDay
-> PGTypeEnv
-> PGTypeID "time without time zone"
-> PGTextValue
-> TimeOfDay
forall (t :: Symbol) a.
PGColumn t a =>
BinDecoder a
-> BinDecoder a -> PGTypeEnv -> PGTypeID t -> PGTextValue -> a
binDecDatetime BinDecoder TimeOfDay
BinD.time_int BinDecoder TimeOfDay
BinD.time_float
#endif
instance PGType "time with time zone" where
type PGVal "time with time zone" = (Time.TimeOfDay, Time.TimeZone)
pgBinaryColumn :: PGTypeEnv -> PGTypeID "time with time zone" -> Bool
pgBinaryColumn = PGTypeEnv -> PGTypeID "time with time zone" -> Bool
forall (t :: Symbol). PGTypeEnv -> PGTypeID t -> Bool
binColDatetime
instance PGParameter "time with time zone" (Time.TimeOfDay, Time.TimeZone) where
pgEncode :: PGTypeID "time with time zone"
-> (TimeOfDay, TimeZone) -> PGTextValue
pgEncode PGTypeID "time with time zone"
_ (TimeOfDay
t, TimeZone
z) = String -> PGTextValue
BSC.pack (String -> PGTextValue) -> String -> PGTextValue
forall a b. (a -> b) -> a -> b
$ TimeLocale -> String -> TimeOfDay -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
Time.formatTime TimeLocale
defaultTimeLocale String
"%T%Q" TimeOfDay
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
fixTZ (TimeLocale -> String -> TimeZone -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
Time.formatTime TimeLocale
defaultTimeLocale String
"%z" TimeZone
z)
pgLiteral :: PGTypeID "time with time zone"
-> (TimeOfDay, TimeZone) -> PGTextValue
pgLiteral PGTypeID "time with time zone"
t = PGTextValue -> PGTextValue
pgQuoteUnsafe (PGTextValue -> PGTextValue)
-> ((TimeOfDay, TimeZone) -> PGTextValue)
-> (TimeOfDay, TimeZone)
-> PGTextValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTypeID "time with time zone"
-> (TimeOfDay, TimeZone) -> PGTextValue
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> PGTextValue
pgEncode PGTypeID "time with time zone"
t
#ifdef VERSION_postgresql_binary
pgEncodeValue :: PGTypeEnv
-> PGTypeID "time with time zone"
-> (TimeOfDay, TimeZone)
-> PGValue
pgEncodeValue = BinEncoder (TimeOfDay, TimeZone)
-> BinEncoder (TimeOfDay, TimeZone)
-> PGTypeEnv
-> PGTypeID "time with time zone"
-> (TimeOfDay, TimeZone)
-> PGValue
forall (t :: Symbol) a.
PGParameter t a =>
BinEncoder a
-> BinEncoder a -> PGTypeEnv -> PGTypeID t -> a -> PGValue
binEncDatetime BinEncoder (TimeOfDay, TimeZone)
BinE.timetz_int BinEncoder (TimeOfDay, TimeZone)
BinE.timetz_float
#endif
instance PGColumn "time with time zone" (Time.TimeOfDay, Time.TimeZone) where
pgDecode :: PGTypeID "time with time zone"
-> PGTextValue -> (TimeOfDay, TimeZone)
pgDecode PGTypeID "time with time zone"
_ = (LocalTime -> TimeOfDay
Time.localTimeOfDay (LocalTime -> TimeOfDay)
-> (ZonedTime -> LocalTime) -> ZonedTime -> TimeOfDay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZonedTime -> LocalTime
Time.zonedTimeToLocalTime (ZonedTime -> TimeOfDay)
-> (ZonedTime -> TimeZone) -> ZonedTime -> (TimeOfDay, TimeZone)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ZonedTime -> TimeZone
Time.zonedTimeZone) (ZonedTime -> (TimeOfDay, TimeZone))
-> (PGTextValue -> ZonedTime)
-> PGTextValue
-> (TimeOfDay, TimeZone)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> ZonedTime
forall t. ParseTime t => String -> String -> t
readTime String
"%T%Q%z" (String -> ZonedTime)
-> (PGTextValue -> String) -> PGTextValue -> ZonedTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
fixTZ ShowS -> (PGTextValue -> String) -> PGTextValue -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTextValue -> String
BSC.unpack
#ifdef VERSION_postgresql_binary
pgDecodeBinary :: PGTypeEnv
-> PGTypeID "time with time zone"
-> PGTextValue
-> (TimeOfDay, TimeZone)
pgDecodeBinary = BinDecoder (TimeOfDay, TimeZone)
-> BinDecoder (TimeOfDay, TimeZone)
-> PGTypeEnv
-> PGTypeID "time with time zone"
-> PGTextValue
-> (TimeOfDay, TimeZone)
forall (t :: Symbol) a.
PGColumn t a =>
BinDecoder a
-> BinDecoder a -> PGTypeEnv -> PGTypeID t -> PGTextValue -> a
binDecDatetime BinDecoder (TimeOfDay, TimeZone)
BinD.timetz_int BinDecoder (TimeOfDay, TimeZone)
BinD.timetz_float
#endif
instance PGType "timestamp without time zone" where
type PGVal "timestamp without time zone" = Time.LocalTime
pgBinaryColumn :: PGTypeEnv -> PGTypeID "timestamp without time zone" -> Bool
pgBinaryColumn = PGTypeEnv -> PGTypeID "timestamp without time zone" -> Bool
forall (t :: Symbol). PGTypeEnv -> PGTypeID t -> Bool
binColDatetime
instance PGParameter "timestamp without time zone" Time.LocalTime where
pgEncode :: PGTypeID "timestamp without time zone" -> LocalTime -> PGTextValue
pgEncode PGTypeID "timestamp without time zone"
_ = String -> PGTextValue
BSC.pack (String -> PGTextValue)
-> (LocalTime -> String) -> LocalTime -> PGTextValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> LocalTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
Time.formatTime TimeLocale
defaultTimeLocale String
"%F %T%Q"
pgLiteral :: PGTypeID "timestamp without time zone" -> LocalTime -> PGTextValue
pgLiteral PGTypeID "timestamp without time zone"
t = PGTextValue -> PGTextValue
pgQuoteUnsafe (PGTextValue -> PGTextValue)
-> (LocalTime -> PGTextValue) -> LocalTime -> PGTextValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTypeID "timestamp without time zone" -> LocalTime -> PGTextValue
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> PGTextValue
pgEncode PGTypeID "timestamp without time zone"
t
#ifdef VERSION_postgresql_binary
pgEncodeValue :: PGTypeEnv
-> PGTypeID "timestamp without time zone" -> LocalTime -> PGValue
pgEncodeValue = BinEncoder LocalTime
-> BinEncoder LocalTime
-> PGTypeEnv
-> PGTypeID "timestamp without time zone"
-> LocalTime
-> PGValue
forall (t :: Symbol) a.
PGParameter t a =>
BinEncoder a
-> BinEncoder a -> PGTypeEnv -> PGTypeID t -> a -> PGValue
binEncDatetime BinEncoder LocalTime
BinE.timestamp_int BinEncoder LocalTime
BinE.timestamp_float
#endif
instance PGColumn "timestamp without time zone" Time.LocalTime where
pgDecode :: PGTypeID "timestamp without time zone" -> PGTextValue -> LocalTime
pgDecode PGTypeID "timestamp without time zone"
_ = String -> String -> LocalTime
forall t. ParseTime t => String -> String -> t
readTime String
"%F %T%Q" (String -> LocalTime)
-> (PGTextValue -> String) -> PGTextValue -> LocalTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTextValue -> String
BSC.unpack
#ifdef VERSION_postgresql_binary
pgDecodeBinary :: PGTypeEnv
-> PGTypeID "timestamp without time zone"
-> PGTextValue
-> LocalTime
pgDecodeBinary = BinDecoder LocalTime
-> BinDecoder LocalTime
-> PGTypeEnv
-> PGTypeID "timestamp without time zone"
-> PGTextValue
-> LocalTime
forall (t :: Symbol) a.
PGColumn t a =>
BinDecoder a
-> BinDecoder a -> PGTypeEnv -> PGTypeID t -> PGTextValue -> a
binDecDatetime BinDecoder LocalTime
BinD.timestamp_int BinDecoder LocalTime
BinD.timestamp_float
#endif
instance PGType "timestamp with time zone" where
type PGVal "timestamp with time zone" = Time.UTCTime
pgBinaryColumn :: PGTypeEnv -> PGTypeID "timestamp with time zone" -> Bool
pgBinaryColumn = PGTypeEnv -> PGTypeID "timestamp with time zone" -> Bool
forall (t :: Symbol). PGTypeEnv -> PGTypeID t -> Bool
binColDatetime
instance PGParameter "timestamp with time zone" Time.UTCTime where
pgEncode :: PGTypeID "timestamp with time zone" -> UTCTime -> PGTextValue
pgEncode PGTypeID "timestamp with time zone"
_ = String -> PGTextValue
BSC.pack (String -> PGTextValue)
-> (UTCTime -> String) -> UTCTime -> PGTextValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
fixTZ ShowS -> (UTCTime -> String) -> UTCTime -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
Time.formatTime TimeLocale
defaultTimeLocale String
"%F %T%Q%z"
#ifdef VERSION_postgresql_binary
pgEncodeValue :: PGTypeEnv
-> PGTypeID "timestamp with time zone" -> UTCTime -> PGValue
pgEncodeValue = BinEncoder UTCTime
-> BinEncoder UTCTime
-> PGTypeEnv
-> PGTypeID "timestamp with time zone"
-> UTCTime
-> PGValue
forall (t :: Symbol) a.
PGParameter t a =>
BinEncoder a
-> BinEncoder a -> PGTypeEnv -> PGTypeID t -> a -> PGValue
binEncDatetime BinEncoder UTCTime
BinE.timestamptz_int BinEncoder UTCTime
BinE.timestamptz_float
#endif
instance PGColumn "timestamp with time zone" Time.UTCTime where
pgDecode :: PGTypeID "timestamp with time zone" -> PGTextValue -> UTCTime
pgDecode PGTypeID "timestamp with time zone"
_ = String -> String -> UTCTime
forall t. ParseTime t => String -> String -> t
readTime String
"%F %T%Q%z" (String -> UTCTime)
-> (PGTextValue -> String) -> PGTextValue -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
fixTZ ShowS -> (PGTextValue -> String) -> PGTextValue -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTextValue -> String
BSC.unpack
#ifdef VERSION_postgresql_binary
pgDecodeBinary :: PGTypeEnv
-> PGTypeID "timestamp with time zone" -> PGTextValue -> UTCTime
pgDecodeBinary = BinDecoder UTCTime
-> BinDecoder UTCTime
-> PGTypeEnv
-> PGTypeID "timestamp with time zone"
-> PGTextValue
-> UTCTime
forall (t :: Symbol) a.
PGColumn t a =>
BinDecoder a
-> BinDecoder a -> PGTypeEnv -> PGTypeID t -> PGTextValue -> a
binDecDatetime BinDecoder UTCTime
BinD.timestamptz_int BinDecoder UTCTime
BinD.timestamptz_float
#endif
instance PGType "interval" where
type PGVal "interval" = Time.DiffTime
pgBinaryColumn :: PGTypeEnv -> PGTypeID "interval" -> Bool
pgBinaryColumn = PGTypeEnv -> PGTypeID "interval" -> Bool
forall (t :: Symbol). PGTypeEnv -> PGTypeID t -> Bool
binColDatetime
instance PGParameter "interval" Time.DiffTime where
pgEncode :: PGTypeID "interval" -> DiffTime -> PGTextValue
pgEncode PGTypeID "interval"
_ = String -> PGTextValue
BSC.pack (String -> PGTextValue)
-> (DiffTime -> String) -> DiffTime -> PGTextValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> String
forall a. Show a => a -> String
show
pgLiteral :: PGTypeID "interval" -> DiffTime -> PGTextValue
pgLiteral PGTypeID "interval"
t = PGTextValue -> PGTextValue
pgQuoteUnsafe (PGTextValue -> PGTextValue)
-> (DiffTime -> PGTextValue) -> DiffTime -> PGTextValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTypeID "interval" -> DiffTime -> PGTextValue
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> PGTextValue
pgEncode PGTypeID "interval"
t
#ifdef VERSION_postgresql_binary
pgEncodeValue :: PGTypeEnv -> PGTypeID "interval" -> DiffTime -> PGValue
pgEncodeValue = BinEncoder DiffTime
-> BinEncoder DiffTime
-> PGTypeEnv
-> PGTypeID "interval"
-> DiffTime
-> PGValue
forall (t :: Symbol) a.
PGParameter t a =>
BinEncoder a
-> BinEncoder a -> PGTypeEnv -> PGTypeID t -> a -> PGValue
binEncDatetime BinEncoder DiffTime
BinE.interval_int BinEncoder DiffTime
BinE.interval_float
#endif
instance PGColumn "interval" Time.DiffTime where
pgDecode :: PGTypeID "interval" -> PGTextValue -> DiffTime
pgDecode PGTypeID "interval"
_ PGTextValue
a = (String -> DiffTime)
-> (Scientific -> DiffTime) -> Either String Scientific -> DiffTime
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> DiffTime
forall a. HasCallStack => String -> a
error (String -> DiffTime) -> ShowS -> String -> DiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"pgDecode interval (" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ShowS
forall a. [a] -> [a] -> [a]
++ (String
"): " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PGTextValue -> String
BSC.unpack PGTextValue
a))) Scientific -> DiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Either String Scientific -> DiffTime)
-> Either String Scientific -> DiffTime
forall a b. (a -> b) -> a -> b
$ Parser Scientific -> PGTextValue -> Either String Scientific
forall a. Parser a -> PGTextValue -> Either String a
P.parseOnly Parser Scientific
ps PGTextValue
a where
ps :: Parser Scientific
ps = do
Char
_ <- Char -> Parser Char
P.char Char
'P'
Scientific
d <- [(Char, Scientific)] -> Parser Scientific
units [(Char
'Y', Scientific
12Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
*Scientific
month), (Char
'M', Scientific
month), (Char
'W', Scientific
7Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
*Scientific
day), (Char
'D', Scientific
day)]
((Scientific
d Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
+) (Scientific -> Scientific)
-> Parser Scientific -> Parser Scientific
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Scientific
pt) Parser Scientific -> Parser Scientific -> Parser Scientific
forall a. Semigroup a => a -> a -> a
<> (Scientific
d Scientific -> Parser PGTextValue () -> Parser Scientific
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser PGTextValue ()
forall t. Chunk t => Parser t ()
P.endOfInput)
pt :: Parser Scientific
pt = do
Char
_ <- Char -> Parser Char
P.char Char
'T'
Scientific
t <- [(Char, Scientific)] -> Parser Scientific
units [(Char
'H', Scientific
3600), (Char
'M', Scientific
60), (Char
'S', Scientific
1)]
Parser PGTextValue ()
forall t. Chunk t => Parser t ()
P.endOfInput
Scientific -> Parser Scientific
forall (m :: * -> *) a. Monad m => a -> m a
return Scientific
t
units :: [(Char, Scientific)] -> Parser Scientific
units [(Char, Scientific)]
l = ([Scientific] -> Scientific)
-> Parser PGTextValue [Scientific] -> Parser Scientific
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Scientific] -> Scientific
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (Parser PGTextValue [Scientific] -> Parser Scientific)
-> Parser PGTextValue [Scientific] -> Parser Scientific
forall a b. (a -> b) -> a -> b
$ Parser Scientific -> Parser PGTextValue [Scientific]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many' (Parser Scientific -> Parser PGTextValue [Scientific])
-> Parser Scientific -> Parser PGTextValue [Scientific]
forall a b. (a -> b) -> a -> b
$ do
Scientific
x <- Parser Scientific -> Parser Scientific
forall a. Num a => Parser a -> Parser a
P.signed Parser Scientific
P.scientific
Scientific
u <- [Parser Scientific] -> Parser Scientific
forall (f :: * -> *) a. Alternative f => [f a] -> f a
P.choice ([Parser Scientific] -> Parser Scientific)
-> [Parser Scientific] -> Parser Scientific
forall a b. (a -> b) -> a -> b
$ ((Char, Scientific) -> Parser Scientific)
-> [(Char, Scientific)] -> [Parser Scientific]
forall a b. (a -> b) -> [a] -> [b]
map (\(Char
c, Scientific
u) -> Scientific
u Scientific -> Parser Char -> Parser Scientific
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
P.char Char
c) [(Char, Scientific)]
l
Scientific -> Parser Scientific
forall (m :: * -> *) a. Monad m => a -> m a
return (Scientific -> Parser Scientific)
-> Scientific -> Parser Scientific
forall a b. (a -> b) -> a -> b
$ Scientific
x Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
* Scientific
u
day :: Scientific
day = Scientific
86400
month :: Scientific
month = Scientific
2629746
#ifdef VERSION_postgresql_binary
pgDecodeBinary :: PGTypeEnv -> PGTypeID "interval" -> PGTextValue -> DiffTime
pgDecodeBinary = BinDecoder DiffTime
-> BinDecoder DiffTime
-> PGTypeEnv
-> PGTypeID "interval"
-> PGTextValue
-> DiffTime
forall (t :: Symbol) a.
PGColumn t a =>
BinDecoder a
-> BinDecoder a -> PGTypeEnv -> PGTypeID t -> PGTextValue -> a
binDecDatetime BinDecoder DiffTime
BinD.interval_int BinDecoder DiffTime
BinD.interval_float
#endif
instance PGType "numeric" where
type PGVal "numeric" =
#ifdef VERSION_scientific
Scientific
#else
Rational
#endif
BIN_COL
instance PGParameter "numeric" Rational where
pgEncode :: PGTypeID "numeric" -> Rational -> PGTextValue
pgEncode PGTypeID "numeric"
_ Rational
r
| Rational -> Integer
forall a. Ratio a -> a
denominator Rational
r Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = String -> PGTextValue
BSC.pack String
"NaN"
| Bool
otherwise = String -> PGTextValue
BSC.pack (String -> PGTextValue) -> String -> PGTextValue
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
30 (Rational -> String
showRational (Rational
r Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ (Rational
10 Rational -> Int -> Rational
forall a b. (Fractional a, Integral b) => a -> b -> a
^^ Int
e))) String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'e' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show Int
e where
e :: Int
e = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase (Double
10 :: Double) (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Rational -> Double) -> Rational -> Double
forall a b. (a -> b) -> a -> b
$ Rational -> Rational
forall a. Num a => a -> a
abs Rational
r :: Int
pgLiteral :: PGTypeID "numeric" -> Rational -> PGTextValue
pgLiteral PGTypeID "numeric"
_ Rational
r
| Rational -> Integer
forall a. Ratio a -> a
denominator Rational
r Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = String -> PGTextValue
BSC.pack String
"'NaN'"
| Bool
otherwise = String -> PGTextValue
BSC.pack (String -> PGTextValue) -> String -> PGTextValue
forall a b. (a -> b) -> a -> b
$ Char
'(' Char -> ShowS
forall a. a -> [a] -> [a]
: Integer -> String
forall a. Show a => a -> String
show (Rational -> Integer
forall a. Ratio a -> a
numerator Rational
r) String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'/' Char -> ShowS
forall a. a -> [a] -> [a]
: Integer -> String
forall a. Show a => a -> String
show (Rational -> Integer
forall a. Ratio a -> a
denominator Rational
r) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"::numeric)"
BIN_ENC(BinE.numeric . realToFrac)
instance PGColumn "numeric" Rational where
pgDecode :: PGTypeID "numeric" -> PGTextValue -> Rational
pgDecode PGTypeID "numeric"
_ PGTextValue
bs
| String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"NaN" = Integer
0 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0
| Bool
otherwise = [(Rational, String)] -> Rational
ur ([(Rational, String)] -> Rational)
-> [(Rational, String)] -> Rational
forall a b. (a -> b) -> a -> b
$ ReadS Rational
forall a. RealFrac a => ReadS a
readFloat String
s where
ur :: [(Rational, String)] -> Rational
ur [(Rational
x,String
"")] = Rational
x
ur [(Rational, String)]
_ = String -> Rational
forall a. HasCallStack => String -> a
error (String -> Rational) -> String -> Rational
forall a b. (a -> b) -> a -> b
$ String
"pgDecode numeric: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
s :: String
s = PGTextValue -> String
BSC.unpack PGTextValue
bs
BIN_DEC(realToFrac <$> BinD.numeric)
showRational :: Rational -> String
showRational :: Rational -> String
showRational Rational
r = Integer -> String
forall a. Show a => a -> String
show (Integer
ri :: Integer) String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'.' Char -> ShowS
forall a. a -> [a] -> [a]
: Rational -> String
forall t. RealFrac t => t -> String
frac (Rational -> Rational
forall a. Num a => a -> a
abs Rational
rf) where
(Integer
ri, Rational
rf) = Rational -> (Integer, Rational)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction Rational
r
frac :: t -> String
frac t
0 = String
""
frac t
f = Int -> Char
intToDigit Int
i Char -> ShowS
forall a. a -> [a] -> [a]
: t -> String
frac t
f' where (Int
i, t
f') = t -> (Int, t)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction (t
10 t -> t -> t
forall a. Num a => a -> a -> a
* t
f)
#ifdef VERSION_scientific
instance PGParameter "numeric" Scientific where
pgEncode :: PGTypeID "numeric" -> Scientific -> PGTextValue
pgEncode PGTypeID "numeric"
_ = String -> PGTextValue
BSC.pack (String -> PGTextValue)
-> (Scientific -> String) -> Scientific -> PGTextValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> String
forall a. Show a => a -> String
show
pgLiteral :: PGTypeID "numeric" -> Scientific -> PGTextValue
pgLiteral = PGTypeID "numeric" -> Scientific -> PGTextValue
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> PGTextValue
pgEncode
BIN_ENC(BinE.numeric)
instance PGColumn "numeric" Scientific where
pgDecode :: PGTypeID "numeric" -> PGTextValue -> Scientific
pgDecode PGTypeID "numeric"
_ = String -> Scientific
forall a. Read a => String -> a
read (String -> Scientific)
-> (PGTextValue -> String) -> PGTextValue -> Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTextValue -> String
BSC.unpack
BIN_DEC(BinD.numeric)
#endif
#ifdef VERSION_uuid
instance PGType "uuid" where
type PGVal "uuid" = UUID.UUID
BIN_COL
instance PGParameter "uuid" UUID.UUID where
pgEncode :: PGTypeID "uuid" -> UUID -> PGTextValue
pgEncode PGTypeID "uuid"
_ = UUID -> PGTextValue
UUID.toASCIIBytes
pgLiteral :: PGTypeID "uuid" -> UUID -> PGTextValue
pgLiteral PGTypeID "uuid"
t = PGTextValue -> PGTextValue
pgQuoteUnsafe (PGTextValue -> PGTextValue)
-> (UUID -> PGTextValue) -> UUID -> PGTextValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTypeID "uuid" -> UUID -> PGTextValue
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> PGTextValue
pgEncode PGTypeID "uuid"
t
BIN_ENC(BinE.uuid)
instance PGColumn "uuid" UUID.UUID where
pgDecode :: PGTypeID "uuid" -> PGTextValue -> UUID
pgDecode PGTypeID "uuid"
_ PGTextValue
u = UUID -> Maybe UUID -> UUID
forall a. a -> Maybe a -> a
fromMaybe (String -> UUID
forall a. HasCallStack => String -> a
error (String -> UUID) -> String -> UUID
forall a b. (a -> b) -> a -> b
$ String
"pgDecode uuid: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PGTextValue -> String
BSC.unpack PGTextValue
u) (Maybe UUID -> UUID) -> Maybe UUID -> UUID
forall a b. (a -> b) -> a -> b
$ PGTextValue -> Maybe UUID
UUID.fromASCIIBytes PGTextValue
u
BIN_DEC(BinD.uuid)
#endif
newtype PGRecord = PGRecord [Maybe PGTextValue]
class PGType t => PGRecordType t
instance PGRecordType t => PGParameter t PGRecord where
pgEncode :: PGTypeID t -> PGRecord -> PGTextValue
pgEncode PGTypeID t
_ (PGRecord [Maybe PGTextValue]
l) =
Builder -> PGTextValue
buildPGValue (Builder -> PGTextValue) -> Builder -> PGTextValue
forall a b. (a -> b) -> a -> b
$ Char -> Builder
BSB.char7 Char
'(' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (Char -> Builder
BSB.char7 Char
',') ([Builder] -> [Builder]) -> [Builder] -> [Builder]
forall a b. (a -> b) -> a -> b
$ (Maybe PGTextValue -> Builder) -> [Maybe PGTextValue] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Builder -> (PGTextValue -> Builder) -> Maybe PGTextValue -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
forall a. Monoid a => a
mempty (String -> PGTextValue -> Builder
pgDQuoteFrom String
"(),")) [Maybe PGTextValue]
l) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BSB.char7 Char
')'
pgLiteral :: PGTypeID t -> PGRecord -> PGTextValue
pgLiteral PGTypeID t
_ (PGRecord [Maybe PGTextValue]
l) =
String -> PGTextValue
BSC.pack String
"ROW(" PGTextValue -> PGTextValue -> PGTextValue
forall a. Semigroup a => a -> a -> a
<> PGTextValue -> [PGTextValue] -> PGTextValue
BS.intercalate (Char -> PGTextValue
BSC.singleton Char
',') ((Maybe PGTextValue -> PGTextValue)
-> [Maybe PGTextValue] -> [PGTextValue]
forall a b. (a -> b) -> [a] -> [b]
map (PGTextValue
-> (PGTextValue -> PGTextValue) -> Maybe PGTextValue -> PGTextValue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> PGTextValue
BSC.pack String
"NULL") PGTextValue -> PGTextValue
pgQuote) [Maybe PGTextValue]
l) PGTextValue -> Char -> PGTextValue
`BSC.snoc` Char
')'
instance PGRecordType t => PGColumn t PGRecord where
pgDecode :: PGTypeID t -> PGTextValue -> PGRecord
pgDecode PGTypeID t
_ PGTextValue
a = (String -> PGRecord)
-> ([Maybe PGTextValue] -> PGRecord)
-> Either String [Maybe PGTextValue]
-> PGRecord
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> PGRecord
forall a. HasCallStack => String -> a
error (String -> PGRecord) -> ShowS -> String -> PGRecord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"pgDecode record (" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ShowS
forall a. [a] -> [a] -> [a]
++ (String
"): " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PGTextValue -> String
BSC.unpack PGTextValue
a))) [Maybe PGTextValue] -> PGRecord
PGRecord (Either String [Maybe PGTextValue] -> PGRecord)
-> Either String [Maybe PGTextValue] -> PGRecord
forall a b. (a -> b) -> a -> b
$ Parser [Maybe PGTextValue]
-> PGTextValue -> Either String [Maybe PGTextValue]
forall a. Parser a -> PGTextValue -> Either String a
P.parseOnly Parser [Maybe PGTextValue]
pa PGTextValue
a where
pa :: Parser [Maybe PGTextValue]
pa = Char -> Parser Char
P.char Char
'(' Parser Char
-> Parser [Maybe PGTextValue] -> Parser [Maybe PGTextValue]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Maybe PGTextValue)
-> Parser Char -> Parser [Maybe PGTextValue]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
P.sepBy Parser (Maybe PGTextValue)
el (Char -> Parser Char
P.char Char
',') Parser [Maybe PGTextValue]
-> Parser Char -> Parser [Maybe PGTextValue]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
P.char Char
')' Parser [Maybe PGTextValue]
-> Parser PGTextValue () -> Parser [Maybe PGTextValue]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser PGTextValue ()
forall t. Chunk t => Parser t ()
P.endOfInput
el :: Parser (Maybe PGTextValue)
el = Bool
-> String -> (PGTextValue -> Bool) -> Parser (Maybe PGTextValue)
parsePGDQuote Bool
True String
"()," PGTextValue -> Bool
BS.null
instance PGType "record" where
type PGVal "record" = PGRecord
instance PGRecordType "record"
#ifdef VERSION_aeson
instance PGType "json" where
type PGVal "json" = JSON.Value
BIN_COL
instance PGParameter "json" JSON.Value where
pgEncode :: PGTypeID "json" -> Value -> PGTextValue
pgEncode PGTypeID "json"
_ = ByteString -> PGTextValue
BSL.toStrict (ByteString -> PGTextValue)
-> (Value -> ByteString) -> Value -> PGTextValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
JSON.encode
BIN_ENC(BinE.json_ast)
instance PGColumn "json" JSON.Value where
pgDecode :: PGTypeID "json" -> PGTextValue -> Value
pgDecode PGTypeID "json"
_ PGTextValue
j = (String -> Value)
-> (Value -> Value) -> Either String Value -> Value
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Value
forall a. HasCallStack => String -> a
error (String -> Value) -> ShowS -> String -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"pgDecode json (" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ShowS
forall a. [a] -> [a] -> [a]
++ (String
"): " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PGTextValue -> String
BSC.unpack PGTextValue
j))) Value -> Value
forall a. a -> a
id (Either String Value -> Value) -> Either String Value -> Value
forall a b. (a -> b) -> a -> b
$ Parser Value -> PGTextValue -> Either String Value
forall a. Parser a -> PGTextValue -> Either String a
P.parseOnly Parser Value
JSON.json PGTextValue
j
BIN_DEC(BinD.json_ast)
instance PGType "jsonb" where
type PGVal "jsonb" = JSON.Value
BIN_COL
instance PGParameter "jsonb" JSON.Value where
pgEncode :: PGTypeID "jsonb" -> Value -> PGTextValue
pgEncode PGTypeID "jsonb"
_ = ByteString -> PGTextValue
BSL.toStrict (ByteString -> PGTextValue)
-> (Value -> ByteString) -> Value -> PGTextValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
JSON.encode
BIN_ENC(BinE.jsonb_ast)
instance PGColumn "jsonb" JSON.Value where
pgDecode :: PGTypeID "jsonb" -> PGTextValue -> Value
pgDecode PGTypeID "jsonb"
_ PGTextValue
j = (String -> Value)
-> (Value -> Value) -> Either String Value -> Value
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Value
forall a. HasCallStack => String -> a
error (String -> Value) -> ShowS -> String -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"pgDecode jsonb (" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ShowS
forall a. [a] -> [a] -> [a]
++ (String
"): " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PGTextValue -> String
BSC.unpack PGTextValue
j))) Value -> Value
forall a. a -> a
id (Either String Value -> Value) -> Either String Value -> Value
forall a b. (a -> b) -> a -> b
$ Parser Value -> PGTextValue -> Either String Value
forall a. Parser a -> PGTextValue -> Either String a
P.parseOnly Parser Value
JSON.json PGTextValue
j
BIN_DEC(BinD.jsonb_ast)
#endif