{-# 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 -> ByteString
pgTextValue :: PGTextValue }
| PGBinaryValue { PGValue -> ByteString
pgBinaryValue :: PGBinaryValue }
deriving (Int -> PGValue -> ShowS
[PGValue] -> ShowS
PGValue -> String
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
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 ByteString
pgServerVersion :: Maybe BS.ByteString
} deriving (Int -> PGTypeEnv -> ShowS
[PGTypeEnv] -> ShowS
PGTypeEnv -> String
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
{ pgIntegerDatetimes :: Maybe Bool
pgIntegerDatetimes = forall a. Maybe a
Nothing
, pgServerVersion :: Maybe ByteString
pgServerVersion = forall a. Maybe a
Nothing
}
newtype PGName = PGName
{ PGName -> [Word8]
pgNameBytes :: [Word8]
}
deriving (PGName -> PGName -> Bool
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
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
Ord, Typeable, Typeable PGName
PGName -> DataType
PGName -> Constr
(forall b. Data b => b -> b) -> PGName -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> PGName -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PGName -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> PGName -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PGName -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data)
pgNameBS :: PGName -> BS.ByteString
pgNameBS :: PGName -> ByteString
pgNameBS = [Word8] -> ByteString
BS.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGName -> [Word8]
pgNameBytes
instance IsString PGName where
fromString :: String -> PGName
fromString = [Word8] -> PGName
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 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 = forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = ByteString -> ByteString
pgQuote forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgEncode PGTypeID t
t
pgEncodeValue :: PGTypeEnv -> PGTypeID t -> a -> PGValue
pgEncodeValue PGTypeEnv
_ PGTypeID t
t = ByteString -> PGValue
PGTextValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
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 ByteString
_ = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"pgDecodeBinary " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (t :: Symbol). PGType t => PGTypeID t -> PGName
pgTypeName PGTypeID t
t) forall a. [a] -> [a] -> [a]
++ String
": not supported"
pgDecodeValue :: PGTypeEnv -> PGTypeID t -> PGValue -> a
pgDecodeValue PGTypeEnv
_ PGTypeID t
t (PGTextValue ByteString
v) = forall (t :: Symbol) a.
PGColumn t a =>
PGTypeID t -> ByteString -> a
pgDecode PGTypeID t
t ByteString
v
pgDecodeValue PGTypeEnv
e PGTypeID t
t (PGBinaryValue ByteString
v) = forall (t :: Symbol) a.
PGColumn t a =>
PGTypeEnv -> PGTypeID t -> ByteString -> a
pgDecodeBinary PGTypeEnv
e PGTypeID t
t ByteString
v
pgDecodeValue PGTypeEnv
_ PGTypeID t
t PGValue
PGNullValue = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"NULL in " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (t :: Symbol). PGType t => PGTypeID t -> PGName
pgTypeName PGTypeID t
t) 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 -> ByteString
pgEncode PGTypeID t
t = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"pgEncode " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (t :: Symbol). PGType t => PGTypeID t -> PGName
pgTypeName PGTypeID t
t) forall a. [a] -> [a] -> [a]
++ String
": Nothing") (forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgEncode PGTypeID t
t)
pgLiteral :: PGTypeID t -> Maybe a -> ByteString
pgLiteral = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> ByteString
BSC.pack String
"NULL") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgLiteral
pgEncodeValue :: PGTypeEnv -> PGTypeID t -> Maybe a -> PGValue
pgEncodeValue PGTypeEnv
e = forall b a. b -> (a -> b) -> Maybe a -> b
maybe PGValue
PGNullValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> ByteString -> Maybe a
pgDecode PGTypeID t
t = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: Symbol) a.
PGColumn t a =>
PGTypeID t -> ByteString -> a
pgDecode PGTypeID t
t
pgDecodeBinary :: PGTypeEnv -> PGTypeID t -> ByteString -> Maybe a
pgDecodeBinary PGTypeEnv
e PGTypeID t
t = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: Symbol) a.
PGColumn t a =>
PGTypeEnv -> PGTypeID t -> ByteString -> a
pgDecodeBinary PGTypeEnv
e PGTypeID t
t
pgDecodeValue :: PGTypeEnv -> PGTypeID t -> PGValue -> Maybe a
pgDecodeValue PGTypeEnv
_ PGTypeID t
_ PGValue
PGNullValue = forall a. Maybe a
Nothing
pgDecodeValue PGTypeEnv
e PGTypeID t
t PGValue
v = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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 :: forall (t :: Symbol) a.
PGParameter t a =>
PGTypeEnv -> PGTypeID t -> a -> PGValue
pgEncodeParameter = forall (t :: Symbol) a.
PGParameter t a =>
PGTypeEnv -> PGTypeID t -> a -> PGValue
pgEncodeValue
pgEscapeParameter :: PGParameter t a => PGTypeEnv -> PGTypeID t -> a -> BS.ByteString
pgEscapeParameter :: forall (t :: Symbol) a.
PGParameter t a =>
PGTypeEnv -> PGTypeID t -> a -> ByteString
pgEscapeParameter PGTypeEnv
_ = forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgLiteral
pgDecodeColumn :: PGColumn t (Maybe a) => PGTypeEnv -> PGTypeID t -> PGValue -> Maybe a
pgDecodeColumn :: forall (t :: Symbol) a.
PGColumn t (Maybe a) =>
PGTypeEnv -> PGTypeID t -> PGValue -> Maybe a
pgDecodeColumn = forall (t :: Symbol) a.
PGColumn t a =>
PGTypeEnv -> PGTypeID t -> PGValue -> a
pgDecodeValue
pgDecodeColumnNotNull :: PGColumn t a => PGTypeEnv -> PGTypeID t -> PGValue -> a
pgDecodeColumnNotNull :: forall (t :: Symbol) a.
PGColumn t a =>
PGTypeEnv -> PGTypeID t -> PGValue -> a
pgDecodeColumnNotNull = forall (t :: Symbol) a.
PGColumn t a =>
PGTypeEnv -> PGTypeID t -> PGValue -> a
pgDecodeValue
pgQuoteUnsafe :: BS.ByteString -> BS.ByteString
pgQuoteUnsafe :: ByteString -> ByteString
pgQuoteUnsafe = (ByteString -> Char -> ByteString
`BSC.snoc` Char
'\'') forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString -> ByteString
BSC.cons Char
'\''
pgQuote :: BS.ByteString -> BS.ByteString
pgQuote :: ByteString -> ByteString
pgQuote ByteString
s
| Char
'\0' Char -> ByteString -> Bool
`BSC.elem` ByteString
s = forall a. HasCallStack => String -> a
error String
"pgQuote: unhandled null in literal"
| Bool
otherwise = ByteString -> ByteString
pgQuoteUnsafe forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> ByteString
BSC.intercalate (String -> ByteString
BSC.pack String
"''") forall a b. (a -> b) -> a -> b
$ Char -> ByteString -> [ByteString]
BSC.split Char
'\'' ByteString
s
buildPGValue :: BSB.Builder -> BS.ByteString
buildPGValue :: Builder -> ByteString
buildPGValue = ByteString -> ByteString
BSL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BSB.toLazyByteString
pgDQuote :: BS.ByteString -> BSB.Builder
pgDQuote :: ByteString -> Builder
pgDQuote ByteString
s = Builder
dq forall a. Semigroup a => a -> a -> a
<> BoundedPrim Word8 -> ByteString -> Builder
BSBP.primMapByteStringBounded BoundedPrim Word8
ec ByteString
s forall a. Semigroup a => a -> a -> a
<> Builder
dq where
dq :: Builder
dq = Char -> Builder
BSB.char7 Char
'"'
ec :: BoundedPrim Word8
ec = forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BSBP.condB (\Word8
c -> Word8
c forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w Char
'"' Bool -> Bool -> Bool
|| Word8
c forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w Char
'\\') BoundedPrim Word8
bs (forall a. FixedPrim a -> BoundedPrim a
BSBP.liftFixedToBounded FixedPrim Word8
BSBP.word8)
bs :: BoundedPrim Word8
bs = forall a. FixedPrim a -> BoundedPrim a
BSBP.liftFixedToBounded forall a b. (a -> b) -> a -> b
$ ((,) Char
'\\') forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
BSBP.>$< (FixedPrim Char
BSBP.char7 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 -> ByteString -> Builder
pgDQuoteFrom String
unsafe ByteString
s
| ByteString -> Bool
BS.null ByteString
s Bool -> Bool -> Bool
|| (Char -> Bool) -> ByteString -> Bool
BSC.any (\Char
c -> Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'"' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\\' Bool -> Bool -> Bool
|| Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
unsafe) ByteString
s Bool -> Bool -> Bool
|| (Char -> Char) -> ByteString -> ByteString
BSC.map Char -> Char
toLower ByteString
s forall a. Eq a => a -> a -> Bool
== String -> ByteString
BSC.pack String
"null" = ByteString -> Builder
pgDQuote ByteString
s
| Bool
otherwise = ByteString -> Builder
BSB.byteString ByteString
s
parsePGDQuote :: Bool -> [Char] -> (BS.ByteString -> Bool) -> P.Parser (Maybe BS.ByteString)
parsePGDQuote :: Bool -> String -> (ByteString -> Bool) -> Parser (Maybe ByteString)
parsePGDQuote Bool
blank String
unsafe ByteString -> Bool
isnul = (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
q) forall a. Semigroup a => a -> a -> a
<> (ByteString -> Maybe ByteString
mnul forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
uq) where
q :: Parser ByteString ByteString
q = Char -> Parser Char
P.char Char
'"' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([ByteString] -> ByteString
BS.concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString [ByteString]
qs)
qs :: Parser ByteString [ByteString]
qs = do
ByteString
p <- (Char -> Bool) -> Parser ByteString ByteString
P.takeTill (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
== Char
'"' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\\')
Char
e <- Parser Char
P.anyChar
if Char
e forall a. Eq a => a -> a -> Bool
== Char
'"'
then forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString
p]
else do
Word8
c <- Parser Word8
P.anyWord8
(ByteString
p forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> ByteString
BS.singleton Word8
c forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString [ByteString]
qs
uq :: Parser ByteString ByteString
uq = (if Bool
blank then (Char -> Bool) -> Parser ByteString ByteString
P.takeWhile else (Char -> Bool) -> Parser ByteString ByteString
P.takeWhile1) (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (Char
'"'forall a. a -> [a] -> [a]
:Char
'\\'forall a. a -> [a] -> [a]
:String
unsafe))
mnul :: ByteString -> Maybe ByteString
mnul ByteString
s
| ByteString -> Bool
isnul ByteString
s = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just ByteString
s
#ifdef VERSION_postgresql_binary
binEnc :: BinEncoder a -> a -> BS.ByteString
binEnc :: forall a. BinEncoder a -> a -> ByteString
binEnc = forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)
#if MIN_VERSION_postgresql_binary(0,12,0)
Encoding -> ByteString
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 :: forall (t :: Symbol) a.
PGType t =>
BinDecoder a -> PGTypeID t -> ByteString -> a
binDec BinDecoder a
d PGTypeID t
t = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\Text
e -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"pgDecodeBinary " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (t :: Symbol). PGType t => PGTypeID t -> PGName
pgTypeName PGTypeID t
t) forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
e) forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
.
#if MIN_VERSION_postgresql_binary(0,12,0)
forall a. Value a -> ByteString -> 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 -> ByteString -> PGValue
pgDecode PGTypeID t
_ = ByteString -> PGValue
PGTextValue
pgDecodeBinary :: PGTypeEnv -> PGTypeID t -> ByteString -> PGValue
pgDecodeBinary PGTypeEnv
_ PGTypeID t
_ = ByteString -> PGValue
PGBinaryValue
pgDecodeValue :: PGTypeEnv -> PGTypeID t -> PGValue -> PGValue
pgDecodeValue PGTypeEnv
_ PGTypeID t
_ = forall a. a -> a
id
instance PGParameter "any" PGValue where
pgEncode :: PGTypeID "any" -> PGValue -> ByteString
pgEncode PGTypeID "any"
_ (PGTextValue ByteString
v) = ByteString
v
pgEncode PGTypeID "any"
_ PGValue
PGNullValue = forall a. HasCallStack => String -> a
error String
"pgEncode any: NULL"
pgEncode PGTypeID "any"
_ (PGBinaryValue ByteString
_) = forall a. HasCallStack => String -> a
error String
"pgEncode any: binary"
pgEncodeValue :: PGTypeEnv -> PGTypeID "any" -> PGValue -> PGValue
pgEncodeValue PGTypeEnv
_ PGTypeID "any"
_ = forall a. a -> a
id
instance PGType "void" where
type PGVal "void" = ()
instance PGParameter "void" () where
pgEncode :: PGTypeID "void" -> () -> ByteString
pgEncode PGTypeID "void"
_ ()
_ = ByteString
BSC.empty
instance PGColumn "void" () where
pgDecode :: PGTypeID "void" -> ByteString -> ()
pgDecode PGTypeID "void"
_ ByteString
_ = ()
pgDecodeBinary :: PGTypeEnv -> PGTypeID "void" -> ByteString -> ()
pgDecodeBinary PGTypeEnv
_ PGTypeID "void"
_ ByteString
_ = ()
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 -> ByteString
pgEncode PGTypeID "boolean"
_ Bool
False = Char -> ByteString
BSC.singleton Char
'f'
pgEncode PGTypeID "boolean"
_ Bool
True = Char -> ByteString
BSC.singleton Char
't'
pgLiteral :: PGTypeID "boolean" -> Bool -> ByteString
pgLiteral PGTypeID "boolean"
_ Bool
False = String -> ByteString
BSC.pack String
"false"
pgLiteral PGTypeID "boolean"
_ Bool
True = String -> ByteString
BSC.pack String
"true"
BIN_ENC(BinE.bool)
instance PGColumn "boolean" Bool where
pgDecode :: PGTypeID "boolean" -> ByteString -> Bool
pgDecode PGTypeID "boolean"
_ ByteString
s = case ByteString -> Char
BSC.head ByteString
s of
Char
'f' -> Bool
False
Char
't' -> Bool
True
Char
c -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"pgDecode boolean: " 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 -> ByteString
pgEncode PGTypeID "oid"
_ = String -> ByteString
BSC.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
pgLiteral :: PGTypeID "oid" -> OID -> ByteString
pgLiteral = forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgEncode
BIN_ENC(BinE.int4_word32)
instance PGColumn "oid" OID where
pgDecode :: PGTypeID "oid" -> ByteString -> OID
pgDecode PGTypeID "oid"
_ = forall a. Read a => String -> a
read forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> 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 -> ByteString
pgEncode PGTypeID "smallint"
_ = String -> ByteString
BSC.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
pgLiteral :: PGTypeID "smallint" -> Int16 -> ByteString
pgLiteral = forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgEncode
BIN_ENC(BinE.int2_int16)
instance PGColumn "smallint" Int16 where
pgDecode :: PGTypeID "smallint" -> ByteString -> Int16
pgDecode PGTypeID "smallint"
_ = forall a. Read a => String -> a
read forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> 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 -> ByteString
pgEncode PGTypeID "integer"
_ = String -> ByteString
BSC.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
pgLiteral :: PGTypeID "integer" -> Int32 -> ByteString
pgLiteral = forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgEncode
BIN_ENC(BinE.int4_int32)
instance PGColumn "integer" Int32 where
pgDecode :: PGTypeID "integer" -> ByteString -> Int32
pgDecode PGTypeID "integer"
_ = forall a. Read a => String -> a
read forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> 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 -> ByteString
pgEncode PGTypeID "bigint"
_ = String -> ByteString
BSC.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
pgLiteral :: PGTypeID "bigint" -> Int64 -> ByteString
pgLiteral = forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgEncode
BIN_ENC(BinE.int8_int64)
instance PGColumn "bigint" Int64 where
pgDecode :: PGTypeID "bigint" -> ByteString -> Int64
pgDecode PGTypeID "bigint"
_ = forall a. Read a => String -> a
read forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> 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 -> ByteString
pgEncode PGTypeID "real"
_ = String -> ByteString
BSC.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
pgLiteral :: PGTypeID "real" -> Float -> ByteString
pgLiteral = forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgEncode
BIN_ENC(BinE.float4)
instance PGColumn "real" Float where
pgDecode :: PGTypeID "real" -> ByteString -> Float
pgDecode PGTypeID "real"
_ = forall a. Read a => String -> a
read forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BSC.unpack
BIN_DEC(BinD.float4)
instance PGColumn "real" Double where
pgDecode :: PGTypeID "real" -> ByteString -> Double
pgDecode PGTypeID "real"
_ = forall a. Read a => String -> a
read forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> 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 -> ByteString
pgEncode PGTypeID "double precision"
_ = String -> ByteString
BSC.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
pgLiteral :: PGTypeID "double precision" -> Double -> ByteString
pgLiteral = forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgEncode
BIN_ENC(BinE.float8)
instance PGParameter "double precision" Float where
pgEncode :: PGTypeID "double precision" -> Float -> ByteString
pgEncode PGTypeID "double precision"
_ = String -> ByteString
BSC.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
pgLiteral :: PGTypeID "double precision" -> Float -> ByteString
pgLiteral = forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgEncode
BIN_ENC(BinE.float8 . realToFrac)
instance PGColumn "double precision" Double where
pgDecode :: PGTypeID "double precision" -> ByteString -> Double
pgDecode PGTypeID "double precision"
_ = forall a. Read a => String -> a
read forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> 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 -> ByteString
pgEncode PGTypeID "\"char\""
_ = Word8 -> ByteString
BS.singleton
pgEncodeValue :: PGTypeEnv -> PGTypeID "\"char\"" -> Word8 -> PGValue
pgEncodeValue PGTypeEnv
_ PGTypeID "\"char\""
_ = ByteString -> PGValue
PGBinaryValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteString
BS.singleton
instance PGColumn "\"char\"" Word8 where
pgDecode :: PGTypeID "\"char\"" -> ByteString -> Word8
pgDecode PGTypeID "\"char\""
_ = HasCallStack => ByteString -> Word8
BS.head
pgDecodeBinary :: PGTypeEnv -> PGTypeID "\"char\"" -> ByteString -> Word8
pgDecodeBinary PGTypeEnv
_ PGTypeID "\"char\""
_ = HasCallStack => ByteString -> Word8
BS.head
instance PGParameter "\"char\"" Char where
pgEncode :: PGTypeID "\"char\"" -> Char -> ByteString
pgEncode PGTypeID "\"char\""
_ = Char -> ByteString
BSC.singleton
pgEncodeValue :: PGTypeEnv -> PGTypeID "\"char\"" -> Char -> PGValue
pgEncodeValue PGTypeEnv
_ PGTypeID "\"char\""
_ = ByteString -> PGValue
PGBinaryValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString
BSC.singleton
instance PGColumn "\"char\"" Char where
pgDecode :: PGTypeID "\"char\"" -> ByteString -> Char
pgDecode PGTypeID "\"char\""
_ = ByteString -> Char
BSC.head
pgDecodeBinary :: PGTypeEnv -> PGTypeID "\"char\"" -> ByteString -> Char
pgDecodeBinary PGTypeEnv
_ PGTypeID "\"char\""
_ = ByteString -> Char
BSC.head
class PGType t => PGStringType t
instance PGStringType t => PGParameter t String where
pgEncode :: PGTypeID t -> String -> ByteString
pgEncode PGTypeID t
_ = String -> ByteString
BSU.fromString
BIN_ENC(BinE.text_strict . T.pack)
instance PGStringType t => PGColumn t String where
pgDecode :: PGTypeID t -> ByteString -> String
pgDecode PGTypeID t
_ = ByteString -> 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 -> ByteString -> ByteString
pgEncode PGTypeID t
_ = 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 -> ByteString -> ByteString
pgDecode PGTypeID t
_ = 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 -> ByteString
pgEncode PGTypeID t
_ = PGName -> ByteString
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 -> ByteString -> PGName
pgDecode PGTypeID t
_ = [Word8] -> PGName
PGName forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [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 -> ByteString
pgEncode PGTypeID t
_ = ByteString -> ByteString
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 -> ByteString -> ByteString
pgDecode PGTypeID t
_ = ByteString -> 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 -> ByteString
pgEncode PGTypeID t
_ = Text -> ByteString
TE.encodeUtf8
BIN_ENC(BinE.text_strict)
instance PGStringType t => PGColumn t T.Text where
pgDecode :: PGTypeID t -> ByteString -> Text
pgDecode PGTypeID t
_ = ByteString -> Text
TE.decodeUtf8
BIN_DEC(BinD.text_strict)
instance PGStringType t => PGParameter t TL.Text where
pgEncode :: PGTypeID t -> Text -> ByteString
pgEncode PGTypeID t
_ = ByteString -> ByteString
BSL.toStrict 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 -> ByteString -> Text
pgDecode PGTypeID t
_ = Text -> Text
TL.fromStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> 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 -> ByteString
encodeBytea Builder
h = Builder -> ByteString
buildPGValue forall a b. (a -> b) -> a -> b
$ String -> Builder
BSB.string7 String
"\\x" forall a. Semigroup a => a -> a -> a
<> Builder
h
decodeBytea :: PGTextValue -> [Word8]
decodeBytea :: ByteString -> [Word8]
decodeBytea ByteString
s
| String
sm forall a. Eq a => a -> a -> Bool
/= String
"\\x" = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"pgDecode bytea: " forall a. [a] -> [a] -> [a]
++ String
sm
| Bool
otherwise = [Word8] -> [Word8]
pd forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
BS.unpack ByteString
d where
(ByteString
m, ByteString
d) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
2 ByteString
s
sm :: String
sm = ByteString -> String
BSC.unpack ByteString
m
pd :: [Word8] -> [Word8]
pd [] = []
pd (Word8
h:Word8
l:[Word8]
r) = (forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word8
unhex Word8
h) Int
4 forall a. Bits a => a -> a -> a
.|. Word8 -> Word8
unhex Word8
l) forall a. a -> [a] -> [a]
: [Word8] -> [Word8]
pd [Word8]
r
pd [Word8
x] = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"pgDecode bytea: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
x
unhex :: Word8 -> Word8
unhex = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
digitToInt 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 -> ByteString
pgEncode PGTypeID "bytea"
_ = Builder -> ByteString
encodeBytea forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
BSB.lazyByteStringHex
pgLiteral :: PGTypeID "bytea" -> ByteString -> ByteString
pgLiteral PGTypeID "bytea"
t = ByteString -> ByteString
pgQuoteUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgEncode PGTypeID "bytea"
t
BIN_ENC(BinE.bytea_lazy)
instance
#if __GLASGOW_HASKELL__ >= 710
{-# OVERLAPPING #-}
#endif
PGColumn "bytea" BSL.ByteString where
pgDecode :: PGTypeID "bytea" -> ByteString -> ByteString
pgDecode PGTypeID "bytea"
_ = [Word8] -> ByteString
BSL.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
decodeBytea
BIN_DEC(BinD.bytea_lazy)
instance
#if __GLASGOW_HASKELL__ >= 710
{-# OVERLAPPING #-}
#endif
PGParameter "bytea" BS.ByteString where
pgEncode :: PGTypeID "bytea" -> ByteString -> ByteString
pgEncode PGTypeID "bytea"
_ = Builder -> ByteString
encodeBytea forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
BSB.byteStringHex
pgLiteral :: PGTypeID "bytea" -> ByteString -> ByteString
pgLiteral PGTypeID "bytea"
t = ByteString -> ByteString
pgQuoteUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgEncode PGTypeID "bytea"
t
BIN_ENC(BinE.bytea_strict)
instance
#if __GLASGOW_HASKELL__ >= 710
{-# OVERLAPPING #-}
#endif
PGColumn "bytea" BS.ByteString where
pgDecode :: PGTypeID "bytea" -> ByteString -> ByteString
pgDecode PGTypeID "bytea"
_ = [Word8] -> ByteString
BS.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
decodeBytea
BIN_DEC(BinD.bytea_strict)
readTime :: Time.ParseTime t => String -> String -> t
readTime :: forall t. ParseTime t => String -> String -> t
readTime =
#if MIN_VERSION_time(1,5,0)
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 -> ByteString
pgEncode PGTypeID "date"
_ = String -> ByteString
BSC.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> String
Time.showGregorian
pgLiteral :: PGTypeID "date" -> Day -> ByteString
pgLiteral PGTypeID "date"
t = ByteString -> ByteString
pgQuoteUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgEncode PGTypeID "date"
t
BIN_ENC(BinE.date)
instance PGColumn "date" Time.Day where
pgDecode :: PGTypeID "date" -> ByteString -> Day
pgDecode PGTypeID "date"
_ = forall t. ParseTime t => String -> String -> t
readTime String
"%F" forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BSC.unpack
BIN_DEC(BinD.date)
binColDatetime :: PGTypeEnv -> PGTypeID t -> Bool
#ifdef VERSION_postgresql_binary
binColDatetime :: forall (t :: Symbol). 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 :: forall (t :: Symbol) a.
PGParameter t a =>
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
_ = ByteString -> PGValue
PGBinaryValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. BinEncoder a -> a -> ByteString
binEnc BinEncoder a
ff
binEncDatetime BinEncoder a
fi BinEncoder a
_ PGTypeEnv{ pgIntegerDatetimes :: PGTypeEnv -> Maybe Bool
pgIntegerDatetimes = Just Bool
True } PGTypeID t
_ = ByteString -> PGValue
PGBinaryValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. BinEncoder a -> a -> ByteString
binEnc BinEncoder a
fi
binEncDatetime BinEncoder a
_ BinEncoder a
_ PGTypeEnv{ pgIntegerDatetimes :: PGTypeEnv -> Maybe Bool
pgIntegerDatetimes = Maybe Bool
Nothing } PGTypeID t
t = ByteString -> PGValue
PGTextValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgEncode PGTypeID t
t
binDecDatetime :: PGColumn t a => BinDecoder a -> BinDecoder a -> PGTypeEnv -> PGTypeID t -> PGBinaryValue -> a
binDecDatetime :: forall (t :: Symbol) a.
PGColumn t a =>
BinDecoder a
-> BinDecoder a -> PGTypeEnv -> PGTypeID t -> ByteString -> a
binDecDatetime BinDecoder a
_ BinDecoder a
ff PGTypeEnv{ pgIntegerDatetimes :: PGTypeEnv -> Maybe Bool
pgIntegerDatetimes = Just Bool
False } = forall (t :: Symbol) a.
PGType t =>
BinDecoder a -> PGTypeID t -> ByteString -> a
binDec BinDecoder a
ff
binDecDatetime BinDecoder a
fi BinDecoder a
_ PGTypeEnv{ pgIntegerDatetimes :: PGTypeEnv -> Maybe Bool
pgIntegerDatetimes = Just Bool
True } = forall (t :: Symbol) a.
PGType t =>
BinDecoder a -> PGTypeID t -> ByteString -> a
binDec BinDecoder a
fi
binDecDatetime BinDecoder a
_ BinDecoder a
_ PGTypeEnv{ pgIntegerDatetimes :: PGTypeEnv -> Maybe Bool
pgIntegerDatetimes = Maybe Bool
Nothing } = 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
cforall 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 = forall (t :: Symbol). PGTypeEnv -> PGTypeID t -> Bool
binColDatetime
instance PGParameter "time without time zone" Time.TimeOfDay where
pgEncode :: PGTypeID "time without time zone" -> TimeOfDay -> ByteString
pgEncode PGTypeID "time without time zone"
_ = String -> ByteString
BSC.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. FormatTime t => TimeLocale -> String -> t -> String
Time.formatTime TimeLocale
defaultTimeLocale String
"%T%Q"
pgLiteral :: PGTypeID "time without time zone" -> TimeOfDay -> ByteString
pgLiteral PGTypeID "time without time zone"
t = ByteString -> ByteString
pgQuoteUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgEncode PGTypeID "time without time zone"
t
#ifdef VERSION_postgresql_binary
pgEncodeValue :: PGTypeEnv
-> PGTypeID "time without time zone" -> TimeOfDay -> PGValue
pgEncodeValue = forall (t :: Symbol) a.
PGParameter t a =>
BinEncoder a
-> BinEncoder a -> PGTypeEnv -> PGTypeID t -> a -> PGValue
binEncDatetime TimeOfDay -> Encoding
BinE.time_int TimeOfDay -> Encoding
BinE.time_float
#endif
instance PGColumn "time without time zone" Time.TimeOfDay where
pgDecode :: PGTypeID "time without time zone" -> ByteString -> TimeOfDay
pgDecode PGTypeID "time without time zone"
_ = forall t. ParseTime t => String -> String -> t
readTime String
"%T%Q" forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BSC.unpack
#ifdef VERSION_postgresql_binary
pgDecodeBinary :: PGTypeEnv
-> PGTypeID "time without time zone" -> ByteString -> TimeOfDay
pgDecodeBinary = forall (t :: Symbol) a.
PGColumn t a =>
BinDecoder a
-> BinDecoder a -> PGTypeEnv -> PGTypeID t -> ByteString -> a
binDecDatetime Value TimeOfDay
BinD.time_int Value 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 = 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) -> ByteString
pgEncode PGTypeID "time with time zone"
_ (TimeOfDay
t, TimeZone
z) = String -> ByteString
BSC.pack forall a b. (a -> b) -> a -> b
$ forall t. FormatTime t => TimeLocale -> String -> t -> String
Time.formatTime TimeLocale
defaultTimeLocale String
"%T%Q" TimeOfDay
t forall a. [a] -> [a] -> [a]
++ ShowS
fixTZ (forall t. FormatTime t => TimeLocale -> String -> t -> String
Time.formatTime TimeLocale
defaultTimeLocale String
"%z" TimeZone
z)
pgLiteral :: PGTypeID "time with time zone"
-> (TimeOfDay, TimeZone) -> ByteString
pgLiteral PGTypeID "time with time zone"
t = ByteString -> ByteString
pgQuoteUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgEncode PGTypeID "time with time zone"
t
#ifdef VERSION_postgresql_binary
pgEncodeValue :: PGTypeEnv
-> PGTypeID "time with time zone"
-> (TimeOfDay, TimeZone)
-> PGValue
pgEncodeValue = forall (t :: Symbol) a.
PGParameter t a =>
BinEncoder a
-> BinEncoder a -> PGTypeEnv -> PGTypeID t -> a -> PGValue
binEncDatetime (TimeOfDay, TimeZone) -> Encoding
BinE.timetz_int (TimeOfDay, TimeZone) -> Encoding
BinE.timetz_float
#endif
instance PGColumn "time with time zone" (Time.TimeOfDay, Time.TimeZone) where
pgDecode :: PGTypeID "time with time zone"
-> ByteString -> (TimeOfDay, TimeZone)
pgDecode PGTypeID "time with time zone"
_ = (LocalTime -> TimeOfDay
Time.localTimeOfDay forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZonedTime -> LocalTime
Time.zonedTimeToLocalTime forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ZonedTime -> TimeZone
Time.zonedTimeZone) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. ParseTime t => String -> String -> t
readTime String
"%T%Q%z" forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
fixTZ forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BSC.unpack
#ifdef VERSION_postgresql_binary
pgDecodeBinary :: PGTypeEnv
-> PGTypeID "time with time zone"
-> ByteString
-> (TimeOfDay, TimeZone)
pgDecodeBinary = forall (t :: Symbol) a.
PGColumn t a =>
BinDecoder a
-> BinDecoder a -> PGTypeEnv -> PGTypeID t -> ByteString -> a
binDecDatetime Value (TimeOfDay, TimeZone)
BinD.timetz_int Value (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 = forall (t :: Symbol). PGTypeEnv -> PGTypeID t -> Bool
binColDatetime
instance PGParameter "timestamp without time zone" Time.LocalTime where
pgEncode :: PGTypeID "timestamp without time zone" -> LocalTime -> ByteString
pgEncode PGTypeID "timestamp without time zone"
_ = String -> ByteString
BSC.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. FormatTime t => TimeLocale -> String -> t -> String
Time.formatTime TimeLocale
defaultTimeLocale String
"%F %T%Q"
pgLiteral :: PGTypeID "timestamp without time zone" -> LocalTime -> ByteString
pgLiteral PGTypeID "timestamp without time zone"
t = ByteString -> ByteString
pgQuoteUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgEncode PGTypeID "timestamp without time zone"
t
#ifdef VERSION_postgresql_binary
pgEncodeValue :: PGTypeEnv
-> PGTypeID "timestamp without time zone" -> LocalTime -> PGValue
pgEncodeValue = forall (t :: Symbol) a.
PGParameter t a =>
BinEncoder a
-> BinEncoder a -> PGTypeEnv -> PGTypeID t -> a -> PGValue
binEncDatetime LocalTime -> Encoding
BinE.timestamp_int LocalTime -> Encoding
BinE.timestamp_float
#endif
instance PGColumn "timestamp without time zone" Time.LocalTime where
pgDecode :: PGTypeID "timestamp without time zone" -> ByteString -> LocalTime
pgDecode PGTypeID "timestamp without time zone"
_ = forall t. ParseTime t => String -> String -> t
readTime String
"%F %T%Q" forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BSC.unpack
#ifdef VERSION_postgresql_binary
pgDecodeBinary :: PGTypeEnv
-> PGTypeID "timestamp without time zone"
-> ByteString
-> LocalTime
pgDecodeBinary = forall (t :: Symbol) a.
PGColumn t a =>
BinDecoder a
-> BinDecoder a -> PGTypeEnv -> PGTypeID t -> ByteString -> a
binDecDatetime Value LocalTime
BinD.timestamp_int Value 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 = forall (t :: Symbol). PGTypeEnv -> PGTypeID t -> Bool
binColDatetime
instance PGParameter "timestamp with time zone" Time.UTCTime where
pgEncode :: PGTypeID "timestamp with time zone" -> UTCTime -> ByteString
pgEncode PGTypeID "timestamp with time zone"
_ = String -> ByteString
BSC.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
fixTZ forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (t :: Symbol) a.
PGParameter t a =>
BinEncoder a
-> BinEncoder a -> PGTypeEnv -> PGTypeID t -> a -> PGValue
binEncDatetime UTCTime -> Encoding
BinE.timestamptz_int UTCTime -> Encoding
BinE.timestamptz_float
#endif
instance PGColumn "timestamp with time zone" Time.UTCTime where
pgDecode :: PGTypeID "timestamp with time zone" -> ByteString -> UTCTime
pgDecode PGTypeID "timestamp with time zone"
_ = forall t. ParseTime t => String -> String -> t
readTime String
"%F %T%Q%z" forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
fixTZ forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BSC.unpack
#ifdef VERSION_postgresql_binary
pgDecodeBinary :: PGTypeEnv
-> PGTypeID "timestamp with time zone" -> ByteString -> UTCTime
pgDecodeBinary = forall (t :: Symbol) a.
PGColumn t a =>
BinDecoder a
-> BinDecoder a -> PGTypeEnv -> PGTypeID t -> ByteString -> a
binDecDatetime Value UTCTime
BinD.timestamptz_int Value UTCTime
BinD.timestamptz_float
#endif
instance PGType "interval" where
type PGVal "interval" = Time.DiffTime
pgBinaryColumn :: PGTypeEnv -> PGTypeID "interval" -> Bool
pgBinaryColumn = forall (t :: Symbol). PGTypeEnv -> PGTypeID t -> Bool
binColDatetime
instance PGParameter "interval" Time.DiffTime where
pgEncode :: PGTypeID "interval" -> DiffTime -> ByteString
pgEncode PGTypeID "interval"
_ = String -> ByteString
BSC.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
pgLiteral :: PGTypeID "interval" -> DiffTime -> ByteString
pgLiteral PGTypeID "interval"
t = ByteString -> ByteString
pgQuoteUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgEncode PGTypeID "interval"
t
#ifdef VERSION_postgresql_binary
pgEncodeValue :: PGTypeEnv -> PGTypeID "interval" -> DiffTime -> PGValue
pgEncodeValue = forall (t :: Symbol) a.
PGParameter t a =>
BinEncoder a
-> BinEncoder a -> PGTypeEnv -> PGTypeID t -> a -> PGValue
binEncDatetime DiffTime -> Encoding
BinE.interval_int DiffTime -> Encoding
BinE.interval_float
#endif
instance PGColumn "interval" Time.DiffTime where
pgDecode :: PGTypeID "interval" -> ByteString -> DiffTime
pgDecode PGTypeID "interval"
_ ByteString
a = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"pgDecode interval (" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++ (String
"): " forall a. [a] -> [a] -> [a]
++ ByteString -> String
BSC.unpack ByteString
a))) forall a b. (Real a, Fractional b) => a -> b
realToFrac forall a b. (a -> b) -> a -> b
$ forall a. Parser a -> ByteString -> Either String a
P.parseOnly Parser ByteString Scientific
ps ByteString
a where
ps :: Parser ByteString Scientific
ps = do
Char
_ <- Char -> Parser Char
P.char Char
'P'
Scientific
d <- [(Char, Scientific)] -> Parser ByteString Scientific
units [(Char
'Y', Scientific
12forall a. Num a => a -> a -> a
*Scientific
month), (Char
'M', Scientific
month), (Char
'W', Scientific
7forall a. Num a => a -> a -> a
*Scientific
day), (Char
'D', Scientific
day)]
((Scientific
d forall a. Num a => a -> a -> a
+) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Scientific
pt) forall a. Semigroup a => a -> a -> a
<> (Scientific
d forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall t. Chunk t => Parser t ()
P.endOfInput)
pt :: Parser ByteString Scientific
pt = do
Char
_ <- Char -> Parser Char
P.char Char
'T'
Scientific
t <- [(Char, Scientific)] -> Parser ByteString Scientific
units [(Char
'H', Scientific
3600), (Char
'M', Scientific
60), (Char
'S', Scientific
1)]
forall t. Chunk t => Parser t ()
P.endOfInput
forall (m :: * -> *) a. Monad m => a -> m a
return Scientific
t
units :: [(Char, Scientific)] -> Parser ByteString Scientific
units [(Char, Scientific)]
l = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many' forall a b. (a -> b) -> a -> b
$ do
Scientific
x <- forall a. Num a => Parser a -> Parser a
P.signed Parser ByteString Scientific
P.scientific
Scientific
u <- forall (f :: * -> *) a. Alternative f => [f a] -> f a
P.choice forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(Char
c, Scientific
u) -> Scientific
u forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
P.char Char
c) [(Char, Scientific)]
l
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Scientific
x 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" -> ByteString -> DiffTime
pgDecodeBinary = forall (t :: Symbol) a.
PGColumn t a =>
BinDecoder a
-> BinDecoder a -> PGTypeEnv -> PGTypeID t -> ByteString -> a
binDecDatetime Value DiffTime
BinD.interval_int Value 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 -> ByteString
pgEncode PGTypeID "numeric"
_ Rational
r
| forall a. Ratio a -> a
denominator Rational
r forall a. Eq a => a -> a -> Bool
== Integer
0 = String -> ByteString
BSC.pack String
"NaN"
| Bool
otherwise = String -> ByteString
BSC.pack forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take Int
30 (Rational -> String
showRational (Rational
r forall a. Fractional a => a -> a -> a
/ (Rational
10 forall a b. (Fractional a, Integral b) => a -> b -> a
^^ Int
e))) forall a. [a] -> [a] -> [a]
++ Char
'e' forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show Int
e where
e :: Int
e = forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ forall a. Floating a => a -> a -> a
logBase (Double
10 :: Double) forall a b. (a -> b) -> a -> b
$ forall a. Fractional a => Rational -> a
fromRational forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a
abs Rational
r :: Int
pgLiteral :: PGTypeID "numeric" -> Rational -> ByteString
pgLiteral PGTypeID "numeric"
_ Rational
r
| forall a. Ratio a -> a
denominator Rational
r forall a. Eq a => a -> a -> Bool
== Integer
0 = String -> ByteString
BSC.pack String
"'NaN'"
| Bool
otherwise = String -> ByteString
BSC.pack forall a b. (a -> b) -> a -> b
$ Char
'(' forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show (forall a. Ratio a -> a
numerator Rational
r) forall a. [a] -> [a] -> [a]
++ Char
'/' forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show (forall a. Ratio a -> a
denominator Rational
r) forall a. [a] -> [a] -> [a]
++ String
"::numeric)"
BIN_ENC(BinE.numeric . realToFrac)
instance PGColumn "numeric" Rational where
pgDecode :: PGTypeID "numeric" -> ByteString -> Rational
pgDecode PGTypeID "numeric"
_ ByteString
bs
| String
s forall a. Eq a => a -> a -> Bool
== String
"NaN" = Integer
0 forall a. Integral a => a -> a -> Ratio a
% Integer
0
| Bool
otherwise = [(Rational, String)] -> Rational
ur forall a b. (a -> b) -> a -> b
$ forall a. RealFrac a => ReadS a
readFloat String
s where
ur :: [(Rational, String)] -> Rational
ur [(Rational
x,String
"")] = Rational
x
ur [(Rational, String)]
_ = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"pgDecode numeric: " forall a. [a] -> [a] -> [a]
++ String
s
s :: String
s = ByteString -> String
BSC.unpack ByteString
bs
BIN_DEC(realToFrac <$> BinD.numeric)
showRational :: Rational -> String
showRational :: Rational -> String
showRational Rational
r = forall a. Show a => a -> String
show (Integer
ri :: Integer) forall a. [a] -> [a] -> [a]
++ Char
'.' forall a. a -> [a] -> [a]
: forall {t}. RealFrac t => t -> String
frac (forall a. Num a => a -> a
abs Rational
rf) where
(Integer
ri, Rational
rf) = 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 forall a. a -> [a] -> [a]
: t -> String
frac t
f' where (Int
i, t
f') = forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction (t
10 forall a. Num a => a -> a -> a
* t
f)
#ifdef VERSION_scientific
instance PGParameter "numeric" Scientific where
pgEncode :: PGTypeID "numeric" -> Scientific -> ByteString
pgEncode PGTypeID "numeric"
_ = String -> ByteString
BSC.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
pgLiteral :: PGTypeID "numeric" -> Scientific -> ByteString
pgLiteral = forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgEncode
BIN_ENC(BinE.numeric)
instance PGColumn "numeric" Scientific where
pgDecode :: PGTypeID "numeric" -> ByteString -> Scientific
pgDecode PGTypeID "numeric"
_ = forall a. Read a => String -> a
read forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> 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 -> ByteString
pgEncode PGTypeID "uuid"
_ = UUID -> ByteString
UUID.toASCIIBytes
pgLiteral :: PGTypeID "uuid" -> UUID -> ByteString
pgLiteral PGTypeID "uuid"
t = ByteString -> ByteString
pgQuoteUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgEncode PGTypeID "uuid"
t
BIN_ENC(BinE.uuid)
instance PGColumn "uuid" UUID.UUID where
pgDecode :: PGTypeID "uuid" -> ByteString -> UUID
pgDecode PGTypeID "uuid"
_ ByteString
u = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"pgDecode uuid: " forall a. [a] -> [a] -> [a]
++ ByteString -> String
BSC.unpack ByteString
u) forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe UUID
UUID.fromASCIIBytes ByteString
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 -> ByteString
pgEncode PGTypeID t
_ (PGRecord [Maybe ByteString]
l) =
Builder -> ByteString
buildPGValue forall a b. (a -> b) -> a -> b
$ Char -> Builder
BSB.char7 Char
'(' forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a. a -> [a] -> [a]
intersperse (Char -> Builder
BSB.char7 Char
',') forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (String -> ByteString -> Builder
pgDQuoteFrom String
"(),")) [Maybe ByteString]
l) forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BSB.char7 Char
')'
pgLiteral :: PGTypeID t -> PGRecord -> ByteString
pgLiteral PGTypeID t
_ (PGRecord [Maybe ByteString]
l) =
String -> ByteString
BSC.pack String
"ROW(" forall a. Semigroup a => a -> a -> a
<> ByteString -> [ByteString] -> ByteString
BS.intercalate (Char -> ByteString
BSC.singleton Char
',') (forall a b. (a -> b) -> [a] -> [b]
map (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> ByteString
BSC.pack String
"NULL") ByteString -> ByteString
pgQuote) [Maybe ByteString]
l) ByteString -> Char -> ByteString
`BSC.snoc` Char
')'
instance PGRecordType t => PGColumn t PGRecord where
pgDecode :: PGTypeID t -> ByteString -> PGRecord
pgDecode PGTypeID t
_ ByteString
a = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"pgDecode record (" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++ (String
"): " forall a. [a] -> [a] -> [a]
++ ByteString -> String
BSC.unpack ByteString
a))) [Maybe ByteString] -> PGRecord
PGRecord forall a b. (a -> b) -> a -> b
$ forall a. Parser a -> ByteString -> Either String a
P.parseOnly Parser ByteString [Maybe ByteString]
pa ByteString
a where
pa :: Parser ByteString [Maybe ByteString]
pa = Char -> Parser Char
P.char Char
'(' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
P.sepBy Parser (Maybe ByteString)
el (Char -> Parser Char
P.char Char
',') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
P.char Char
')' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
P.endOfInput
el :: Parser (Maybe ByteString)
el = Bool -> String -> (ByteString -> Bool) -> Parser (Maybe ByteString)
parsePGDQuote Bool
True String
"()," ByteString -> 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 -> ByteString
pgEncode PGTypeID "json"
_ = ByteString -> ByteString
BSL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
JSON.encode
BIN_ENC(BinE.json_ast)
instance PGColumn "json" JSON.Value where
pgDecode :: PGTypeID "json" -> ByteString -> Value
pgDecode PGTypeID "json"
_ ByteString
j = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"pgDecode json (" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++ (String
"): " forall a. [a] -> [a] -> [a]
++ ByteString -> String
BSC.unpack ByteString
j))) forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a. Parser a -> ByteString -> Either String a
P.parseOnly Parser Value
JSON.json ByteString
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 -> ByteString
pgEncode PGTypeID "jsonb"
_ = ByteString -> ByteString
BSL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
JSON.encode
BIN_ENC(BinE.jsonb_ast)
instance PGColumn "jsonb" JSON.Value where
pgDecode :: PGTypeID "jsonb" -> ByteString -> Value
pgDecode PGTypeID "jsonb"
_ ByteString
j = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"pgDecode jsonb (" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++ (String
"): " forall a. [a] -> [a] -> [a]
++ ByteString -> String
BSC.unpack ByteString
j))) forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a. Parser a -> ByteString -> Either String a
P.parseOnly Parser Value
JSON.json ByteString
j
BIN_DEC(BinD.jsonb_ast)
#endif