    {-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor  #-}
    {-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
    {-# LANGUAGE PolyKinds #-}

    ------------------------------------------------------------------------------
    -- |
    -- Module:      Database.PostgreSQL.Simple.ToField
    -- Copyright:   (c) 2011 MailRank, Inc.
    --              (c) 2011-2012 Leon P Smith
    -- License:     BSD3
    -- Maintainer:  Leon P Smith <leon@melding-monads.com>
    -- Stability:   experimental
    --
    -- The 'ToField' typeclass, for rendering a parameter to a SQL query.
    --
    ------------------------------------------------------------------------------

    module Database.PostgreSQL.Simple.ToField
        (
          Action(..)
        , ToField(..)
        , toJSONField
        , inQuotes
        ) where

    import Control.Applicative (Const(Const))
    import qualified Data.Aeson as JSON
    import           Data.ByteString (ByteString)
    import           Data.ByteString.Builder
                       ( Builder, byteString, char8, stringUtf8
                       , intDec, int8Dec, int16Dec, int32Dec, int64Dec, integerDec
                       , wordDec, word8Dec, word16Dec, word32Dec, word64Dec
                       , floatDec, doubleDec
                       )
    import Data.Functor.Identity (Identity(Identity))
    import Data.Int (Int8, Int16, Int32, Int64)
    import Data.List (intersperse)
    import Data.Monoid (mappend)
    import Data.Time.Compat (Day, TimeOfDay, LocalTime, UTCTime, ZonedTime, NominalDiffTime)
    import Data.Time.LocalTime.Compat (CalendarDiffTime)
    import Data.Typeable (Typeable)
    import Data.Word (Word, Word8, Word16, Word32, Word64)
    import {-# SOURCE #-} Database.PostgreSQL.Simple.ToRow
    import Database.PostgreSQL.Simple.Types
    import Database.PostgreSQL.Simple.Compat (toByteString)

    import qualified Data.ByteString as SB
    import qualified Data.ByteString.Lazy as LB
    import           Data.CaseInsensitive (CI)
    import qualified Data.CaseInsensitive as CI
    import qualified Data.Text as ST
    import qualified Data.Text.Encoding as ST
    import qualified Data.Text.Lazy as LT
    import qualified Data.Text.Lazy.Builder as LT
    import           Data.UUID.Types   (UUID)
    import qualified Data.UUID.Types as UUID
    import           Data.Vector (Vector)
    import qualified Data.Vector as V
    import qualified Database.PostgreSQL.LibPQ as PQ
    import           Database.PostgreSQL.Simple.Time
    import           Data.Scientific (Scientific)
    import           Data.Text.Lazy.Builder.Scientific (scientificBuilder)
    import           Foreign.C.Types (CUInt(..))

    -- | How to render an element when substituting it into a query.
    data Action =
        Plain Builder
        -- ^ Render without escaping or quoting. Use for non-text types
        -- such as numbers, when you are /certain/ that they will not
        -- introduce formatting vulnerabilities via use of characters such
        -- as spaces or \"@'@\".
      | Escape ByteString
        -- ^ Escape and enclose in quotes before substituting. Use for all
        -- text-like types, and anything else that may contain unsafe
        -- characters when rendered.
      | EscapeByteA ByteString
        -- ^ Escape binary data for use as a @bytea@ literal.  Include surrounding
        -- quotes.  This is used by the 'Binary' newtype wrapper.
      | EscapeIdentifier ByteString
        -- ^ Escape before substituting. Use for all sql identifiers like
        -- table, column names, etc. This is used by the 'Identifier' newtype
        -- wrapper.
      | Many [Action]
        -- ^ Concatenate a series of rendering actions.
        deriving (Typeable)

    instance Show Action where
        show :: Action -> String
    show (Plain Builder
    b)            = String
    "Plain " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ StrictByteString -> String
    forall a. Show a => a -> String
    show (Builder -> StrictByteString
    toByteString Builder
    b)
        show (Escape StrictByteString
    b)           = String
    "Escape " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ StrictByteString -> String
    forall a. Show a => a -> String
    show StrictByteString
    b
        show (EscapeByteA StrictByteString
    b)      = String
    "EscapeByteA " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ StrictByteString -> String
    forall a. Show a => a -> String
    show StrictByteString
    b
        show (EscapeIdentifier StrictByteString
    b) = String
    "EscapeIdentifier " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ StrictByteString -> String
    forall a. Show a => a -> String
    show StrictByteString
    b
        show (Many [Action]
    b)             = String
    "Many " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Action] -> String
    forall a. Show a => a -> String
    show [Action]
    b

    -- | A type that may be used as a single parameter to a SQL query.
    class ToField a where
        toField :: a -> Action
        -- ^ Prepare a value for substitution into a query string.

    instance ToField Action where
        toField :: Action -> Action
    toField Action
    a = Action
    a
        {-# INLINE toField #-}

    instance (ToField a) => ToField (Const a b) where
      toField :: Const a b -> Action
    toField (Const a
    a) = a -> Action
    forall a. ToField a => a -> Action
    toField a
    a
      {-# INLINE toField #-}

    instance (ToField a) => ToField (Identity a) where
      toField :: Identity a -> Action
    toField (Identity a
    a) = a -> Action
    forall a. ToField a => a -> Action
    toField a
    a
      {-# INLINE toField #-}

    instance (ToField a) => ToField (Maybe a) where
        toField :: Maybe a -> Action
    toField Maybe a
    Nothing  = Action
    renderNull
        toField (Just a
    a) = a -> Action
    forall a. ToField a => a -> Action
    toField a
    a
        {-# INLINE toField #-}

    instance (ToField a) => ToField (In [a]) where
        toField :: In [a] -> Action
    toField (In []) = Builder -> Action
    Plain (Builder -> Action) -> Builder -> Action
    forall a b. (a -> b) -> a -> b
    $ StrictByteString -> Builder
    byteString StrictByteString
    "(null)"
        toField (In [a]
    xs) = [Action] -> Action
    Many ([Action] -> Action) -> [Action] -> Action
    forall a b. (a -> b) -> a -> b
    $
            Builder -> Action
    Plain (Char -> Builder
    char8 Char
    '(') Action -> [Action] -> [Action]
    forall a. a -> [a] -> [a]
    :
            (Action -> [Action] -> [Action]
    forall a. a -> [a] -> [a]
    intersperse (Builder -> Action
    Plain (Char -> Builder
    char8 Char
    ',')) ([Action] -> [Action]) -> ([a] -> [Action]) -> [a] -> [Action]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> Action) -> [a] -> [Action]
    forall a b. (a -> b) -> [a] -> [b]
    map a -> Action
    forall a. ToField a => a -> Action
    toField ([a] -> [Action]) -> [a] -> [Action]
    forall a b. (a -> b) -> a -> b
    $ [a]
    xs) [Action] -> [Action] -> [Action]
    forall a. [a] -> [a] -> [a]
    ++
            [Builder -> Action
    Plain (Char -> Builder
    char8 Char
    ')')]

    renderNull :: Action
    renderNull :: Action
    renderNull = Builder -> Action
    Plain (StrictByteString -> Builder
    byteString StrictByteString
    "null")

    instance ToField Null where
        toField :: Null -> Action
    toField Null
    _ = Action
    renderNull
        {-# INLINE toField #-}

    instance ToField Default where
        toField :: Default -> Action
    toField Default
    _ = Builder -> Action
    Plain (StrictByteString -> Builder
    byteString StrictByteString
    "default")
        {-# INLINE toField #-}

    instance ToField Bool where
        toField :: Bool -> Action
    toField Bool
    True  = Builder -> Action
    Plain (StrictByteString -> Builder
    byteString StrictByteString
    "true")
        toField Bool
    False = Builder -> Action
    Plain (StrictByteString -> Builder
    byteString StrictByteString
    "false")
        {-# INLINE toField #-}

    instance ToField Int8 where
        toField :: Int8 -> Action
    toField = Builder -> Action
    Plain (Builder -> Action) -> (Int8 -> Builder) -> Int8 -> Action
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int8 -> Builder
    int8Dec
        {-# INLINE toField #-}

    instance ToField Int16 where
        toField :: Int16 -> Action
    toField = Builder -> Action
    Plain (Builder -> Action) -> (Int16 -> Builder) -> Int16 -> Action
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int16 -> Builder
    int16Dec
        {-# INLINE toField #-}

    instance ToField Int32 where
        toField :: Int32 -> Action
    toField = Builder -> Action
    Plain (Builder -> Action) -> (Int32 -> Builder) -> Int32 -> Action
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int32 -> Builder
    int32Dec
        {-# INLINE toField #-}

    instance ToField Int where
        toField :: Int -> Action
    toField = Builder -> Action
    Plain (Builder -> Action) -> (Int -> Builder) -> Int -> Action
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Builder
    intDec
        {-# INLINE toField #-}

    instance ToField Int64 where
        toField :: Int64 -> Action
    toField = Builder -> Action
    Plain (Builder -> Action) -> (Int64 -> Builder) -> Int64 -> Action
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int64 -> Builder
    int64Dec
        {-# INLINE toField #-}

    instance ToField Integer where
        toField :: Integer -> Action
    toField = Builder -> Action
    Plain (Builder -> Action) -> (Integer -> Builder) -> Integer -> Action
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Builder
    integerDec
        {-# INLINE toField #-}

    instance ToField Word8 where
        toField :: Word8 -> Action
    toField = Builder -> Action
    Plain (Builder -> Action) -> (Word8 -> Builder) -> Word8 -> Action
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word8 -> Builder
    word8Dec
        {-# INLINE toField #-}

    instance ToField Word16 where
        toField :: Word16 -> Action
    toField = Builder -> Action
    Plain (Builder -> Action) -> (Word16 -> Builder) -> Word16 -> Action
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word16 -> Builder
    word16Dec
        {-# INLINE toField #-}

    instance ToField Word32 where
        toField :: Word32 -> Action
    toField = Builder -> Action
    Plain (Builder -> Action) -> (Word32 -> Builder) -> Word32 -> Action
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word32 -> Builder
    word32Dec
        {-# INLINE toField #-}

    instance ToField Word where
        toField :: Word -> Action
    toField = Builder -> Action
    Plain (Builder -> Action) -> (Word -> Builder) -> Word -> Action
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word -> Builder
    wordDec
        {-# INLINE toField #-}

    instance ToField Word64 where
        toField :: Word64 -> Action
    toField = Builder -> Action
    Plain (Builder -> Action) -> (Word64 -> Builder) -> Word64 -> Action
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word64 -> Builder
    word64Dec
        {-# INLINE toField #-}

    instance ToField PQ.Oid where
        toField :: Oid -> Action
    toField = Builder -> Action
    Plain (Builder -> Action) -> (Oid -> Builder) -> Oid -> Action
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . \(PQ.Oid (CUInt Word32
    x)) -> Word32 -> Builder
    word32Dec Word32
    x
        {-# INLINE toField #-}

    instance ToField Float where
        toField :: Float -> Action
    toField Float
    v | Float -> Bool
    forall a. RealFloat a => a -> Bool
    isNaN Float
    v Bool -> Bool -> Bool
    || Float -> Bool
    forall a. RealFloat a => a -> Bool
    isInfinite Float
    v = Builder -> Action
    Plain (Builder -> Builder
    inQuotes (Float -> Builder
    floatDec Float
    v))
                  | Bool
    otherwise               = Builder -> Action
    Plain (Float -> Builder
    floatDec Float
    v)
        {-# INLINE toField #-}

    instance ToField Double where
        toField :: Double -> Action
    toField Double
    v | Double -> Bool
    forall a. RealFloat a => a -> Bool
    isNaN Double
    v Bool -> Bool -> Bool
    || Double -> Bool
    forall a. RealFloat a => a -> Bool
    isInfinite Double
    v = Builder -> Action
    Plain (Builder -> Builder
    inQuotes (Double -> Builder
    doubleDec Double
    v))
                  | Bool
    otherwise               = Builder -> Action
    Plain (Double -> Builder
    doubleDec Double
    v)
        {-# INLINE toField #-}

    instance ToField Scientific where
        toField :: Scientific -> Action
    toField Scientific
    x = Text -> Action
    forall a. ToField a => a -> Action
    toField (Builder -> Text
    LT.toLazyText (Scientific -> Builder
    scientificBuilder Scientific
    x))
        {-# INLINE toField #-}

    instance ToField (Binary SB.ByteString) where
        toField :: Binary StrictByteString -> Action
    toField (Binary StrictByteString
    bs) = StrictByteString -> Action
    EscapeByteA StrictByteString
    bs
        {-# INLINE toField #-}

    instance ToField (Binary LB.ByteString) where
        toField :: Binary ByteString -> Action
    toField (Binary ByteString
    bs) = (StrictByteString -> Action
    EscapeByteA (StrictByteString -> Action)
    -> (ByteString -> StrictByteString) -> ByteString -> Action
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [StrictByteString] -> StrictByteString
    SB.concat ([StrictByteString] -> StrictByteString)
    -> (ByteString -> [StrictByteString])
    -> ByteString
    -> StrictByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> [StrictByteString]
    LB.toChunks) ByteString
    bs
        {-# INLINE toField #-}

    instance ToField Identifier where
        toField :: Identifier -> Action
    toField (Identifier Text
    bs) = StrictByteString -> Action
    EscapeIdentifier (Text -> StrictByteString
    ST.encodeUtf8 Text
    bs)
        {-# INLINE toField #-}

    instance ToField QualifiedIdentifier where
        toField :: QualifiedIdentifier -> Action
    toField (QualifiedIdentifier (Just Text
    s) Text
    t) =
            [Action] -> Action
    Many [ StrictByteString -> Action
    EscapeIdentifier (Text -> StrictByteString
    ST.encodeUtf8 Text
    s)
                 , Builder -> Action
    Plain (Char -> Builder
    char8 Char
    '.')
                 , StrictByteString -> Action
    EscapeIdentifier (Text -> StrictByteString
    ST.encodeUtf8 Text
    t)
                 ]
        toField (QualifiedIdentifier Maybe Text
    Nothing  Text
    t) =
                   StrictByteString -> Action
    EscapeIdentifier (Text -> StrictByteString
    ST.encodeUtf8 Text
    t)
        {-# INLINE toField #-}

    instance ToField SB.ByteString where
        toField :: StrictByteString -> Action
    toField = StrictByteString -> Action
    Escape
        {-# INLINE toField #-}

    instance ToField LB.ByteString where
        toField :: ByteString -> Action
    toField = StrictByteString -> Action
    forall a. ToField a => a -> Action
    toField (StrictByteString -> Action)
    -> (ByteString -> StrictByteString) -> ByteString -> Action
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [StrictByteString] -> StrictByteString
    SB.concat ([StrictByteString] -> StrictByteString)
    -> (ByteString -> [StrictByteString])
    -> ByteString
    -> StrictByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> [StrictByteString]
    LB.toChunks
        {-# INLINE toField #-}

    instance ToField ST.Text where
        toField :: Text -> Action
    toField = StrictByteString -> Action
    Escape (StrictByteString -> Action)
    -> (Text -> StrictByteString) -> Text -> Action
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> StrictByteString
    ST.encodeUtf8
        {-# INLINE toField #-}

    instance ToField [Char] where
        toField :: String -> Action
    toField = StrictByteString -> Action
    Escape (StrictByteString -> Action)
    -> (String -> StrictByteString) -> String -> Action
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Builder -> StrictByteString
    toByteString (Builder -> StrictByteString)
    -> (String -> Builder) -> String -> StrictByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Builder
    stringUtf8
        {-# INLINE toField #-}

    instance ToField LT.Text where
        toField :: Text -> Action
    toField = Text -> Action
    forall a. ToField a => a -> Action
    toField (Text -> Action) -> (Text -> Text) -> Text -> Action
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Text
    LT.toStrict
        {-# INLINE toField #-}

    -- | citext
    instance ToField (CI ST.Text) where
        toField :: CI Text -> Action
    toField = Text -> Action
    forall a. ToField a => a -> Action
    toField (Text -> Action) -> (CI Text -> Text) -> CI Text -> Action
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CI Text -> Text
    forall s. CI s -> s
    CI.original
        {-# INLINE toField #-}

    -- | citext
    instance ToField (CI LT.Text) where
        toField :: CI Text -> Action
    toField = Text -> Action
    forall a. ToField a => a -> Action
    toField (Text -> Action) -> (CI Text -> Text) -> CI Text -> Action
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Text
    LT.toStrict (Text -> Text) -> (CI Text -> Text) -> CI Text -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CI Text -> Text
    forall s. CI s -> s
    CI.original
        {-# INLINE toField #-}

    instance ToField UTCTime where
        toField :: UTCTime -> Action
    toField = Builder -> Action
    Plain (Builder -> Action) -> (UTCTime -> Builder) -> UTCTime -> Action
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Builder -> Builder
    inQuotes (Builder -> Builder) -> (UTCTime -> Builder) -> UTCTime -> Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . UTCTime -> Builder
    utcTimeToBuilder
        {-# INLINE toField #-}

    instance ToField ZonedTime where
        toField :: ZonedTime -> Action
    toField = Builder -> Action
    Plain (Builder -> Action)
    -> (ZonedTime -> Builder) -> ZonedTime -> Action
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Builder -> Builder
    inQuotes (Builder -> Builder)
    -> (ZonedTime -> Builder) -> ZonedTime -> Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ZonedTime -> Builder
    zonedTimeToBuilder
        {-# INLINE toField #-}

    instance ToField LocalTime where
        toField :: LocalTime -> Action
    toField = Builder -> Action
    Plain (Builder -> Action)
    -> (LocalTime -> Builder) -> LocalTime -> Action
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Builder -> Builder
    inQuotes (Builder -> Builder)
    -> (LocalTime -> Builder) -> LocalTime -> Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LocalTime -> Builder
    localTimeToBuilder
        {-# INLINE toField #-}

    instance ToField Day where
        toField :: Day -> Action
    toField = Builder -> Action
    Plain (Builder -> Action) -> (Day -> Builder) -> Day -> Action
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Builder -> Builder
    inQuotes (Builder -> Builder) -> (Day -> Builder) -> Day -> Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Day -> Builder
    dayToBuilder
        {-# INLINE toField #-}

    instance ToField TimeOfDay where
        toField :: TimeOfDay -> Action
    toField = Builder -> Action
    Plain (Builder -> Action)
    -> (TimeOfDay -> Builder) -> TimeOfDay -> Action
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Builder -> Builder
    inQuotes (Builder -> Builder)
    -> (TimeOfDay -> Builder) -> TimeOfDay -> Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TimeOfDay -> Builder
    timeOfDayToBuilder
        {-# INLINE toField #-}

    instance ToField UTCTimestamp where
        toField :: UTCTimestamp -> Action
    toField = Builder -> Action
    Plain (Builder -> Action)
    -> (UTCTimestamp -> Builder) -> UTCTimestamp -> Action
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Builder -> Builder
    inQuotes (Builder -> Builder)
    -> (UTCTimestamp -> Builder) -> UTCTimestamp -> Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . UTCTimestamp -> Builder
    utcTimestampToBuilder
        {-# INLINE toField #-}

    instance ToField ZonedTimestamp where
        toField :: ZonedTimestamp -> Action
    toField = Builder -> Action
    Plain (Builder -> Action)
    -> (ZonedTimestamp -> Builder) -> ZonedTimestamp -> Action
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Builder -> Builder
    inQuotes (Builder -> Builder)
    -> (ZonedTimestamp -> Builder) -> ZonedTimestamp -> Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ZonedTimestamp -> Builder
    zonedTimestampToBuilder
        {-# INLINE toField #-}

    instance ToField LocalTimestamp where
        toField :: LocalTimestamp -> Action
    toField = Builder -> Action
    Plain (Builder -> Action)
    -> (LocalTimestamp -> Builder) -> LocalTimestamp -> Action
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Builder -> Builder
    inQuotes (Builder -> Builder)
    -> (LocalTimestamp -> Builder) -> LocalTimestamp -> Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LocalTimestamp -> Builder
    localTimestampToBuilder
        {-# INLINE toField #-}

    instance ToField Date where
        toField :: Date -> Action
    toField = Builder -> Action
    Plain (Builder -> Action) -> (Date -> Builder) -> Date -> Action
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Builder -> Builder
    inQuotes (Builder -> Builder) -> (Date -> Builder) -> Date -> Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Date -> Builder
    dateToBuilder
        {-# INLINE toField #-}

    instance ToField NominalDiffTime where
        toField :: NominalDiffTime -> Action
    toField = Builder -> Action
    Plain (Builder -> Action)
    -> (NominalDiffTime -> Builder) -> NominalDiffTime -> Action
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Builder -> Builder
    inQuotes (Builder -> Builder)
    -> (NominalDiffTime -> Builder) -> NominalDiffTime -> Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NominalDiffTime -> Builder
    nominalDiffTimeToBuilder
        {-# INLINE toField #-}

    instance ToField CalendarDiffTime where
        toField :: CalendarDiffTime -> Action
    toField = Builder -> Action
    Plain (Builder -> Action)
    -> (CalendarDiffTime -> Builder) -> CalendarDiffTime -> Action
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Builder -> Builder
    inQuotes (Builder -> Builder)
    -> (CalendarDiffTime -> Builder) -> CalendarDiffTime -> Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CalendarDiffTime -> Builder
    calendarDiffTimeToBuilder
        {-# INLINE toField #-}

    instance (ToField a) => ToField (PGArray a) where
        toField :: PGArray a -> Action
    toField PGArray a
    pgArray =
          case PGArray a -> [a]
    forall a. PGArray a -> [a]
    fromPGArray PGArray a
    pgArray of
            [] -> Builder -> Action
    Plain (StrictByteString -> Builder
    byteString StrictByteString
    "'{}'")
            [a]
    xs -> [Action] -> Action
    Many ([Action] -> Action) -> [Action] -> Action
    forall a b. (a -> b) -> a -> b
    $
              Builder -> Action
    Plain (StrictByteString -> Builder
    byteString StrictByteString
    "ARRAY[") Action -> [Action] -> [Action]
    forall a. a -> [a] -> [a]
    :
              (Action -> [Action] -> [Action]
    forall a. a -> [a] -> [a]
    intersperse (Builder -> Action
    Plain (Char -> Builder
    char8 Char
    ',')) ([Action] -> [Action]) -> ([a] -> [Action]) -> [a] -> [Action]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> Action) -> [a] -> [Action]
    forall a b. (a -> b) -> [a] -> [b]
    map a -> Action
    forall a. ToField a => a -> Action
    toField ([a] -> [Action]) -> [a] -> [Action]
    forall a b. (a -> b) -> a -> b
    $ [a]
    xs) [Action] -> [Action] -> [Action]
    forall a. [a] -> [a] -> [a]
    ++
              [Builder -> Action
    Plain (Char -> Builder
    char8 Char
    ']')]
              -- Because the ARRAY[...] input syntax is being used, it is possible
              -- that the use of type-specific separator characters is unnecessary.

    instance (ToField a) => ToField (Vector a) where
        toField :: Vector a -> Action
    toField = PGArray a -> Action
    forall a. ToField a => a -> Action
    toField (PGArray a -> Action)
    -> (Vector a -> PGArray a) -> Vector a -> Action
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [a] -> PGArray a
    forall a. [a] -> PGArray a
    PGArray ([a] -> PGArray a) -> (Vector a -> [a]) -> Vector a -> PGArray a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Vector a -> [a]
    forall a. Vector a -> [a]
    V.toList

    instance ToField UUID where
        toField :: UUID -> Action
    toField = Builder -> Action
    Plain (Builder -> Action) -> (UUID -> Builder) -> UUID -> Action
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Builder -> Builder
    inQuotes (Builder -> Builder) -> (UUID -> Builder) -> UUID -> Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StrictByteString -> Builder
    byteString (StrictByteString -> Builder)
    -> (UUID -> StrictByteString) -> UUID -> Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . UUID -> StrictByteString
    UUID.toASCIIBytes

    instance ToField JSON.Value where
        toField :: Value -> Action
    toField = ByteString -> Action
    forall a. ToField a => a -> Action
    toField (ByteString -> Action) -> (Value -> ByteString) -> Value -> Action
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Value -> ByteString
    forall a. ToJSON a => a -> ByteString
    JSON.encode

    -- | Convert a Haskell value to JSON using 'JSON.toEncoding'.
    --
    -- This can be used as the default implementation for the 'toField'
    -- method for Haskell types that have a JSON representation in
    -- PostgreSQL.
    toJSONField :: JSON.ToJSON a => a -> Action
    toJSONField :: forall a. ToJSON a => a -> Action
    toJSONField = ByteString -> Action
    forall a. ToField a => a -> Action
    toField (ByteString -> Action) -> (a -> ByteString) -> a -> Action
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> ByteString
    forall a. ToJSON a => a -> ByteString
    JSON.encode

    -- | Surround a string with single-quote characters: \"@'@\"
    --
    -- This function /does not/ perform any other escaping.
    inQuotes :: Builder -> Builder
    inQuotes :: Builder -> Builder
    inQuotes Builder
    b = Builder
    quote Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Builder
    b Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Builder
    quote
      where quote :: Builder
    quote = Char -> Builder
    char8 Char
    '\''

    interleaveFoldr :: (a -> [b] -> [b]) -> b -> [b] -> [a] -> [b]
    interleaveFoldr :: forall a b. (a -> [b] -> [b]) -> b -> [b] -> [a] -> [b]
    interleaveFoldr a -> [b] -> [b]
    f b
    b [b]
    bs' [a]
    as = (a -> [b] -> [b]) -> [b] -> [a] -> [b]
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (\a
    a [b]
    bs -> b
    b b -> [b] -> [b]
    forall a. a -> [a] -> [a]
    : a -> [b] -> [b]
    f a
    a [b]
    bs) [b]
    bs' [a]
    as
    {-# INLINE interleaveFoldr #-}

    instance ToRow a => ToField (Values a) where
        toField :: Values a -> Action
    toField (Values [QualifiedIdentifier]
    types [a]
    rows) =
            case [a]
    rows of
              []    -> case [QualifiedIdentifier]
    types of
                         []    -> String -> Action
    forall a. HasCallStack => String -> a
    error String
    norows
                         (QualifiedIdentifier
    _:[QualifiedIdentifier]
    _) -> [Action] -> Action
    values ([Action] -> Action) -> [Action] -> Action
    forall a b. (a -> b) -> a -> b
    $ [Action] -> [QualifiedIdentifier] -> [Action] -> [Action]
    typedRow (Action -> [Action]
    forall a. a -> [a]
    repeat (StrictByteString -> Action
    lit StrictByteString
    "null"))
                                                    [QualifiedIdentifier]
    types
                                                    [StrictByteString -> Action
    lit StrictByteString
    " LIMIT 0)"]
              (a
    _:[a]
    _) -> case [QualifiedIdentifier]
    types of
                         []    -> [Action] -> Action
    values ([Action] -> Action) -> [Action] -> Action
    forall a b. (a -> b) -> a -> b
    $ [a] -> [Action] -> [Action]
    forall a. ToRow a => [a] -> [Action] -> [Action]
    untypedRows [a]
    rows [Char -> Action
    litC Char
    ')']
                         (QualifiedIdentifier
    _:[QualifiedIdentifier]
    _) -> [Action] -> Action
    values ([Action] -> Action) -> [Action] -> Action
    forall a b. (a -> b) -> a -> b
    $ [a] -> [QualifiedIdentifier] -> [Action] -> [Action]
    forall a.
    ToRow a =>
    [a] -> [QualifiedIdentifier] -> [Action] -> [Action]
    typedRows [a]
    rows [QualifiedIdentifier]
    types [Char -> Action
    litC Char
    ')']
          where
            funcname :: String
    funcname = String
    "Database.PostgreSQL.Simple.toField :: Values a -> Action"
            norows :: String
    norows   = String
    funcname String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "  either values or types must be non-empty"
            emptyrow :: String
    emptyrow = String
    funcname String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "  each row must contain at least one column"
            lit :: StrictByteString -> Action
    lit  = Builder -> Action
    Plain (Builder -> Action)
    -> (StrictByteString -> Builder) -> StrictByteString -> Action
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StrictByteString -> Builder
    byteString
            litC :: Char -> Action
    litC = Builder -> Action
    Plain (Builder -> Action) -> (Char -> Builder) -> Char -> Action
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Builder
    char8
            values :: [Action] -> Action
    values [Action]
    x = [Action] -> Action
    Many (StrictByteString -> Action
    lit StrictByteString
    "(VALUES "Action -> [Action] -> [Action]
    forall a. a -> [a] -> [a]
    : [Action]
    x)

            typedField :: (Action, QualifiedIdentifier) -> [Action] -> [Action]
            typedField :: (Action, QualifiedIdentifier) -> [Action] -> [Action]
    typedField (Action
    val,QualifiedIdentifier
    typ) [Action]
    rest = Action
    val Action -> [Action] -> [Action]
    forall a. a -> [a] -> [a]
    : StrictByteString -> Action
    lit StrictByteString
    "::" Action -> [Action] -> [Action]
    forall a. a -> [a] -> [a]
    : QualifiedIdentifier -> Action
    forall a. ToField a => a -> Action
    toField QualifiedIdentifier
    typ Action -> [Action] -> [Action]
    forall a. a -> [a] -> [a]
    : [Action]
    rest

            typedRow :: [Action] -> [QualifiedIdentifier] -> [Action] -> [Action]
            typedRow :: [Action] -> [QualifiedIdentifier] -> [Action] -> [Action]
    typedRow (Action
    val:[Action]
    vals) (QualifiedIdentifier
    typ:[QualifiedIdentifier]
    typs) [Action]
    rest =
                Char -> Action
    litC Char
    '(' Action -> [Action] -> [Action]
    forall a. a -> [a] -> [a]
    :
                  (Action, QualifiedIdentifier) -> [Action] -> [Action]
    typedField (Action
    val,QualifiedIdentifier
    typ) ( ((Action, QualifiedIdentifier) -> [Action] -> [Action])
    -> Action
    -> [Action]
    -> [(Action, QualifiedIdentifier)]
    -> [Action]
    forall a b. (a -> [b] -> [b]) -> b -> [b] -> [a] -> [b]
    interleaveFoldr
                                            (Action, QualifiedIdentifier) -> [Action] -> [Action]
    typedField
                                            (Char -> Action
    litC Char
    ',')
                                            (Char -> Action
    litC Char
    ')' Action -> [Action] -> [Action]
    forall a. a -> [a] -> [a]
    : [Action]
    rest)
                                            ([Action]
    -> [QualifiedIdentifier] -> [(Action, QualifiedIdentifier)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Action]
    vals [QualifiedIdentifier]
    typs)   )
            typedRow [Action]
    _ [QualifiedIdentifier]
    _ [Action]
    _ = String -> [Action]
    forall a. HasCallStack => String -> a
    error String
    emptyrow

            untypedRow :: [Action] -> [Action] -> [Action]
            untypedRow :: [Action] -> [Action] -> [Action]
    untypedRow (Action
    val:[Action]
    vals) [Action]
    rest =
                Char -> Action
    litC Char
    '(' Action -> [Action] -> [Action]
    forall a. a -> [a] -> [a]
    : Action
    val Action -> [Action] -> [Action]
    forall a. a -> [a] -> [a]
    :
                (Action -> [Action] -> [Action])
    -> Action -> [Action] -> [Action] -> [Action]
    forall a b. (a -> [b] -> [b]) -> b -> [b] -> [a] -> [b]
    interleaveFoldr
                     (:)
                     (Char -> Action
    litC Char
    ',')
                     (Char -> Action
    litC Char
    ')' Action -> [Action] -> [Action]
    forall a. a -> [a] -> [a]
    : [Action]
    rest)
                     [Action]
    vals
            untypedRow [Action]
    _ [Action]
    _ = String -> [Action]
    forall a. HasCallStack => String -> a
    error String
    emptyrow

            typedRows :: ToRow a => [a] -> [QualifiedIdentifier] -> [Action] -> [Action]
            typedRows :: forall a.
    ToRow a =>
    [a] -> [QualifiedIdentifier] -> [Action] -> [Action]
    typedRows [] [QualifiedIdentifier]
    _ [Action]
    _ = String -> [Action]
    forall a. HasCallStack => String -> a
    error String
    funcname
            typedRows (a
    val:[a]
    vals) [QualifiedIdentifier]
    typs [Action]
    rest =
                [Action] -> [QualifiedIdentifier] -> [Action] -> [Action]
    typedRow (a -> [Action]
    forall a. ToRow a => a -> [Action]
    toRow a
    val) [QualifiedIdentifier]
    typs ([a] -> [Action] -> [Action]
    forall a. ToRow a => [a] -> [Action] -> [Action]
    multiRows [a]
    vals [Action]
    rest)

            untypedRows :: ToRow a => [a] -> [Action] -> [Action]
            untypedRows :: forall a. ToRow a => [a] -> [Action] -> [Action]
    untypedRows [] [Action]
    _ = String -> [Action]
    forall a. HasCallStack => String -> a
    error String
    funcname
            untypedRows (a
    val:[a]
    vals) [Action]
    rest =
                [Action] -> [Action] -> [Action]
    untypedRow (a -> [Action]
    forall a. ToRow a => a -> [Action]
    toRow a
    val) ([a] -> [Action] -> [Action]
    forall a. ToRow a => [a] -> [Action] -> [Action]
    multiRows [a]
    vals [Action]
    rest)

            multiRows :: ToRow a => [a] -> [Action] -> [Action]
            multiRows :: forall a. ToRow a => [a] -> [Action] -> [Action]
    multiRows [a]
    vals [Action]
    rest = (a -> [Action] -> [Action])
    -> Action -> [Action] -> [a] -> [Action]
    forall a b. (a -> [b] -> [b]) -> b -> [b] -> [a] -> [b]
    interleaveFoldr
                                    ([Action] -> [Action] -> [Action]
    untypedRow ([Action] -> [Action] -> [Action])
    -> (a -> [Action]) -> a -> [Action] -> [Action]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> [Action]
    forall a. ToRow a => a -> [Action]
    toRow)
                                    (Char -> Action
    litC Char
    ',')
                                    [Action]
    rest
                                    [a]
    vals