{- |

Copyright : Flipstone Technology Partners 2023
License   : MIT
Stability : Stable

The functions in this module are named with the intent that it is imported
qualified as 'SqlValue'.

@since 1.0.0.0
-}
module Orville.PostgreSQL.Raw.SqlValue
  ( SqlValue
  , isSqlNull
  , sqlNull
  , fromInt8
  , toInt8
  , fromInt16
  , toInt16
  , fromInt32
  , toInt32
  , fromInt64
  , toInt64
  , fromInt
  , toInt
  , fromWord8
  , toWord8
  , fromWord16
  , toWord16
  , fromWord32
  , toWord32
  , fromWord64
  , toWord64
  , fromWord
  , toWord
  , fromDouble
  , toDouble
  , fromBool
  , toBool
  , fromText
  , toText
  , fromDay
  , toDay
  , fromUTCTime
  , toUTCTime
  , fromLocalTime
  , toLocalTime
  , fromRawBytes
  , fromRawBytesNullable
  , toPgValue
  )
where

import qualified Control.Exception as Exc
import qualified Data.Attoparsec.ByteString as AttoBS
import qualified Data.Attoparsec.ByteString.Char8 as AttoB8
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as BSB
import qualified Data.ByteString.Lazy as LBS
import Data.Int (Int16, Int32, Int64, Int8)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TextEnc
import qualified Data.Time as Time
import qualified Data.Typeable as Typeable
import Data.Word (Word16, Word32, Word64, Word8)

import Orville.PostgreSQL.Raw.PgTextFormatValue (PgTextFormatValue)
import qualified Orville.PostgreSQL.Raw.PgTextFormatValue as PgTextFormatValue
import qualified Orville.PostgreSQL.Raw.PgTime as PgTime

{- |
  'SqlValue' represents a value that is in encoded format for use with LibPQ.
  It is used both for values passed to LibPQ and values parsed from LibPQ. The
  conversion functions in "Orville.PostgreSQL.Raw.SqlValue" can be used to
  convert to and from the value.

@since 1.0.0.0
-}
data SqlValue
  = SqlValue PgTextFormatValue
  | SqlNull
  deriving (SqlValue -> SqlValue -> Bool
(SqlValue -> SqlValue -> Bool)
-> (SqlValue -> SqlValue -> Bool) -> Eq SqlValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SqlValue -> SqlValue -> Bool
== :: SqlValue -> SqlValue -> Bool
$c/= :: SqlValue -> SqlValue -> Bool
/= :: SqlValue -> SqlValue -> Bool
Eq)

{- |
  Checks whether the 'SqlValue' represents a SQL NULL value in the database.

@since 1.0.0.0
-}
isSqlNull :: SqlValue -> Bool
isSqlNull :: SqlValue -> Bool
isSqlNull SqlValue
sqlValue =
  case SqlValue
sqlValue of
    SqlValue PgTextFormatValue
_ -> Bool
False
    SqlValue
SqlNull -> Bool
True

{- |
  A value of 'SqlValue' that will be interpreted as a SQL NULL value when
  passed to the database.

@since 1.0.0.0
-}
sqlNull :: SqlValue
sqlNull :: SqlValue
sqlNull =
  SqlValue
SqlNull

{- |
  Converts a 'SqlValue' to its underlying raw bytes as it will be represented
  when sent to the database. The output should be recognizable as similar to
  values you would write in a query. If the value represents a SQL NULL value,
  'Nothing' is returned.

@since 1.0.0.0
-}
toPgValue :: SqlValue -> Maybe PgTextFormatValue
toPgValue :: SqlValue -> Maybe PgTextFormatValue
toPgValue SqlValue
sqlValue =
  case SqlValue
sqlValue of
    SqlValue PgTextFormatValue
value ->
      PgTextFormatValue -> Maybe PgTextFormatValue
forall a. a -> Maybe a
Just PgTextFormatValue
value
    SqlValue
SqlNull ->
      Maybe PgTextFormatValue
forall a. Maybe a
Nothing

{- |
  Creates a 'SqlValue' from a raw bytestring as if the bytes had been returned
  by the database. This function does not interpret the bytes in any way, but
  using decode functions on them might fail depending on whether the bytes can
  be parsed as the requested type.

  Note: A value to represent a SQL NULL cannot be constructed using this
  function. See 'fromRawBytesNullable' for how to represent a nullable
  raw value.

@since 1.0.0.0
-}
fromRawBytes :: BS.ByteString -> SqlValue
fromRawBytes :: ByteString -> SqlValue
fromRawBytes =
  PgTextFormatValue -> SqlValue
SqlValue (PgTextFormatValue -> SqlValue)
-> (ByteString -> PgTextFormatValue) -> ByteString -> SqlValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> PgTextFormatValue
PgTextFormatValue.fromByteString

{- |
  Creates a 'SqlValue' from a raw bytestring. If 'Nothing' is specified as the
  input parameter then the resulting 'SqlValue' will represent a NULL value in
  SQL. Otherwise, the bytes given are used in the same way as 'fromRawBytes'.

@since 1.0.0.0
-}
fromRawBytesNullable :: Maybe BS.ByteString -> SqlValue
fromRawBytesNullable :: Maybe ByteString -> SqlValue
fromRawBytesNullable =
  SqlValue
-> (ByteString -> SqlValue) -> Maybe ByteString -> SqlValue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SqlValue
sqlNull ByteString -> SqlValue
fromRawBytes

{- |
  Encodes an 'Int8' value for use with the database.

@since 1.0.0.0
-}
fromInt8 :: Int8 -> SqlValue
fromInt8 :: Int8 -> SqlValue
fromInt8 =
  (Int8 -> Builder) -> Int8 -> SqlValue
forall a. (a -> Builder) -> a -> SqlValue
fromBSBuilderWithNoNULs Int8 -> Builder
BSB.int8Dec

{- |
  Attempts to decode a 'SqlValue' as a Haskell 'Int8' value. If decoding fails,
  'Nothing' is returned.

@since 1.0.0.0
-}
toInt8 :: SqlValue -> Either String Int8
toInt8 :: SqlValue -> Either String Int8
toInt8 =
  Parser Int8 -> SqlValue -> Either String Int8
forall a. Typeable a => Parser a -> SqlValue -> Either String a
toParsedValue (Parser Int8 -> Parser Int8
forall a. Num a => Parser a -> Parser a
AttoB8.signed Parser Int8
forall a. Integral a => Parser a
AttoB8.decimal)

{- |
  Encodes an 'Int16' value for use with the database.

@since 1.0.0.0
-}
fromInt16 :: Int16 -> SqlValue
fromInt16 :: Int16 -> SqlValue
fromInt16 =
  (Int16 -> Builder) -> Int16 -> SqlValue
forall a. (a -> Builder) -> a -> SqlValue
fromBSBuilderWithNoNULs Int16 -> Builder
BSB.int16Dec

{- |
  Attempts to decode a 'SqlValue' as a Haskell 'Int16' value. If decoding
  fails, 'Nothing' is returned.

@since 1.0.0.0
-}
toInt16 :: SqlValue -> Either String Int16
toInt16 :: SqlValue -> Either String Int16
toInt16 =
  Parser Int16 -> SqlValue -> Either String Int16
forall a. Typeable a => Parser a -> SqlValue -> Either String a
toParsedValue (Parser Int16 -> Parser Int16
forall a. Num a => Parser a -> Parser a
AttoB8.signed Parser Int16
forall a. Integral a => Parser a
AttoB8.decimal)

{- |
  Encodes an 'Int32' value for use with the database.

@since 1.0.0.0
-}
fromInt32 :: Int32 -> SqlValue
fromInt32 :: Int32 -> SqlValue
fromInt32 =
  (Int32 -> Builder) -> Int32 -> SqlValue
forall a. (a -> Builder) -> a -> SqlValue
fromBSBuilderWithNoNULs Int32 -> Builder
BSB.int32Dec

{- |
  Attempts to decode a 'SqlValue' as a Haskell 'Int32' value. If decoding
  fails, 'Nothing' is returned.

@since 1.0.0.0
-}
toInt32 :: SqlValue -> Either String Int32
toInt32 :: SqlValue -> Either String Int32
toInt32 =
  Parser Int32 -> SqlValue -> Either String Int32
forall a. Typeable a => Parser a -> SqlValue -> Either String a
toParsedValue (Parser Int32 -> Parser Int32
forall a. Num a => Parser a -> Parser a
AttoB8.signed Parser Int32
forall a. Integral a => Parser a
AttoB8.decimal)

{- |
  Encodes an 'Int64' value for use with the database.

@since 1.0.0.0
-}
fromInt64 :: Int64 -> SqlValue
fromInt64 :: Int64 -> SqlValue
fromInt64 =
  (Int64 -> Builder) -> Int64 -> SqlValue
forall a. (a -> Builder) -> a -> SqlValue
fromBSBuilderWithNoNULs Int64 -> Builder
BSB.int64Dec

{- |
  Attempts to decode a 'SqlValue' as a Haskell 'Int' value. If decoding fails,
  'Nothing' is returned.

@since 1.0.0.0
-}
toInt64 :: SqlValue -> Either String Int64
toInt64 :: SqlValue -> Either String Int64
toInt64 =
  Parser Int64 -> SqlValue -> Either String Int64
forall a. Typeable a => Parser a -> SqlValue -> Either String a
toParsedValue (Parser Int64 -> Parser Int64
forall a. Num a => Parser a -> Parser a
AttoB8.signed Parser Int64
forall a. Integral a => Parser a
AttoB8.decimal)

{- |
  Encodes an 'Int' value for use with the database.

@since 1.0.0.0
-}
fromInt :: Int -> SqlValue
fromInt :: Int -> SqlValue
fromInt =
  (Int -> Builder) -> Int -> SqlValue
forall a. (a -> Builder) -> a -> SqlValue
fromBSBuilderWithNoNULs Int -> Builder
BSB.intDec

{- |
  Attempts to decode a 'SqlValue' as a Haskell 'Int' value. If decoding fails,
  'Nothing' is returned.

@since 1.0.0.0
-}
toInt :: SqlValue -> Either String Int
toInt :: SqlValue -> Either String Int
toInt =
  Parser Int -> SqlValue -> Either String Int
forall a. Typeable a => Parser a -> SqlValue -> Either String a
toParsedValue (Parser Int -> Parser Int
forall a. Num a => Parser a -> Parser a
AttoB8.signed Parser Int
forall a. Integral a => Parser a
AttoB8.decimal)

{- |
  Encodes a 'Word8' value for use with the database.

@since 1.0.0.0
-}
fromWord8 :: Word8 -> SqlValue
fromWord8 :: Word8 -> SqlValue
fromWord8 =
  (Word8 -> Builder) -> Word8 -> SqlValue
forall a. (a -> Builder) -> a -> SqlValue
fromBSBuilderWithNoNULs Word8 -> Builder
BSB.word8Dec

{- |
  Attempts to decode a 'SqlValue' as a Haskell 'Word8' value. If decoding
  fails, 'Nothing' is returned.

@since 1.0.0.0
-}
toWord8 :: SqlValue -> Either String Word8
toWord8 :: SqlValue -> Either String Word8
toWord8 =
  Parser Word8 -> SqlValue -> Either String Word8
forall a. Typeable a => Parser a -> SqlValue -> Either String a
toParsedValue (Parser Word8 -> Parser Word8
forall a. Num a => Parser a -> Parser a
AttoB8.signed Parser Word8
forall a. Integral a => Parser a
AttoB8.decimal)

{- |
  Encodes a 'Word16' value for use with the database.

@since 1.0.0.0
-}
fromWord16 :: Word16 -> SqlValue
fromWord16 :: Word16 -> SqlValue
fromWord16 =
  (Word16 -> Builder) -> Word16 -> SqlValue
forall a. (a -> Builder) -> a -> SqlValue
fromBSBuilderWithNoNULs Word16 -> Builder
BSB.word16Dec

{- |
  Attempts to decode a 'SqlValue' as a Haskell 'Word16' value. If decoding
  fails, 'Nothing' is returned.

@since 1.0.0.0
-}
toWord16 :: SqlValue -> Either String Word16
toWord16 :: SqlValue -> Either String Word16
toWord16 =
  Parser Word16 -> SqlValue -> Either String Word16
forall a. Typeable a => Parser a -> SqlValue -> Either String a
toParsedValue (Parser Word16 -> Parser Word16
forall a. Num a => Parser a -> Parser a
AttoB8.signed Parser Word16
forall a. Integral a => Parser a
AttoB8.decimal)

{- |
  Encodes a 'Word32' value for use with the database.

@since 1.0.0.0
-}
fromWord32 :: Word32 -> SqlValue
fromWord32 :: Word32 -> SqlValue
fromWord32 =
  (Word32 -> Builder) -> Word32 -> SqlValue
forall a. (a -> Builder) -> a -> SqlValue
fromBSBuilderWithNoNULs Word32 -> Builder
BSB.word32Dec

{- |
  Attempts to decode a 'SqlValue' as a Haskell 'Word32' value. If decoding
  fails, 'Nothing' is returned.

@since 1.0.0.0
-}
toWord32 :: SqlValue -> Either String Word32
toWord32 :: SqlValue -> Either String Word32
toWord32 =
  Parser Word32 -> SqlValue -> Either String Word32
forall a. Typeable a => Parser a -> SqlValue -> Either String a
toParsedValue (Parser Word32 -> Parser Word32
forall a. Num a => Parser a -> Parser a
AttoB8.signed Parser Word32
forall a. Integral a => Parser a
AttoB8.decimal)

{- |
  Encodes a 'Word64' value for use with the database.

@since 1.0.0.0
-}
fromWord64 :: Word64 -> SqlValue
fromWord64 :: Word64 -> SqlValue
fromWord64 =
  (Word64 -> Builder) -> Word64 -> SqlValue
forall a. (a -> Builder) -> a -> SqlValue
fromBSBuilderWithNoNULs Word64 -> Builder
BSB.word64Dec

{- |
  Attempts to decode a 'SqlValue' as a Haskell 'Word64' value. If decoding
  fails, 'Nothing' is returned.

@since 1.0.0.0
-}
toWord64 :: SqlValue -> Either String Word64
toWord64 :: SqlValue -> Either String Word64
toWord64 =
  Parser Word64 -> SqlValue -> Either String Word64
forall a. Typeable a => Parser a -> SqlValue -> Either String a
toParsedValue (Parser Word64 -> Parser Word64
forall a. Num a => Parser a -> Parser a
AttoB8.signed Parser Word64
forall a. Integral a => Parser a
AttoB8.decimal)

{- |
  Encodes a 'Word' value for use with the database.

@since 1.0.0.0
-}
fromWord :: Word -> SqlValue
fromWord :: Word -> SqlValue
fromWord =
  (Word -> Builder) -> Word -> SqlValue
forall a. (a -> Builder) -> a -> SqlValue
fromBSBuilderWithNoNULs Word -> Builder
BSB.wordDec

{- |
  Attempts to decode a 'SqlValue' as a Haskell 'Word' value. If decoding fails,
  'Nothing' is returned.

@since 1.0.0.0
-}
toWord :: SqlValue -> Either String Word
toWord :: SqlValue -> Either String Word
toWord =
  Parser Word -> SqlValue -> Either String Word
forall a. Typeable a => Parser a -> SqlValue -> Either String a
toParsedValue (Parser Word -> Parser Word
forall a. Num a => Parser a -> Parser a
AttoB8.signed Parser Word
forall a. Integral a => Parser a
AttoB8.decimal)

{- |
  Encodes a 'Double' value for use with the database.

@since 1.0.0.0
-}
fromDouble :: Double -> SqlValue
fromDouble :: Double -> SqlValue
fromDouble =
  (Double -> Builder) -> Double -> SqlValue
forall a. (a -> Builder) -> a -> SqlValue
fromBSBuilderWithNoNULs Double -> Builder
BSB.doubleDec

{- |
  Attempts to decode a 'SqlValue' as a Haskell 'Double' value. If decoding
  fails, 'Nothing' is returned.

@since 1.0.0.0
-}
toDouble :: SqlValue -> Either String Double
toDouble :: SqlValue -> Either String Double
toDouble =
  Parser Double -> SqlValue -> Either String Double
forall a. Typeable a => Parser a -> SqlValue -> Either String a
toParsedValue (Parser Double -> Parser Double
forall a. Num a => Parser a -> Parser a
AttoB8.signed Parser Double
AttoB8.double)

{- |
  Encodes a 'Bool' value for use with the database.

@since 1.0.0.0
-}
fromBool :: Bool -> SqlValue
fromBool :: Bool -> SqlValue
fromBool =
  (Bool -> Builder) -> Bool -> SqlValue
forall a. (a -> Builder) -> a -> SqlValue
fromBSBuilderWithNoNULs ((Bool -> Builder) -> Bool -> SqlValue)
-> (Bool -> Builder) -> Bool -> SqlValue
forall a b. (a -> b) -> a -> b
$ \Bool
bool ->
    case Bool
bool of
      Bool
True -> Char -> Builder
BSB.char8 Char
't'
      Bool
False -> Char -> Builder
BSB.char8 Char
'f'

{- |
  Attempts to decode a 'SqlValue' as a Haskell 'Bool' value. If decoding fails,
  'Nothing' is returned.

@since 1.0.0.0
-}
toBool :: SqlValue -> Either String Bool
toBool :: SqlValue -> Either String Bool
toBool =
  Parser Bool -> SqlValue -> Either String Bool
forall a. Typeable a => Parser a -> SqlValue -> Either String a
toParsedValue (Parser Bool -> SqlValue -> Either String Bool)
-> Parser Bool -> SqlValue -> Either String Bool
forall a b. (a -> b) -> a -> b
$ do
    Char
char <- Parser Char
AttoB8.anyChar
    case Char
char of
      Char
't' -> Bool -> Parser Bool
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
      Char
'f' -> Bool -> Parser Bool
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
      Char
_ -> String -> Parser Bool
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid boolean character value"

{- |
  Encodes a 'T.Text' value as UTF-8 so that it can be used with the database.

@since 1.0.0.0
-}
fromText :: T.Text -> SqlValue
fromText :: Text -> SqlValue
fromText =
  PgTextFormatValue -> SqlValue
SqlValue (PgTextFormatValue -> SqlValue)
-> (Text -> PgTextFormatValue) -> Text -> SqlValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> PgTextFormatValue
PgTextFormatValue.fromByteString (ByteString -> PgTextFormatValue)
-> (Text -> ByteString) -> Text -> PgTextFormatValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TextEnc.encodeUtf8

{- |
  Attempts to decode a 'SqlValue' as UTF-8 text. If the decoding fails,
  'Nothing' is returned.

  Note: This decoding _only_ fails if the bytes returned from the database
  are not a valid UTF-8 sequence of bytes. Otherwise it always succeeds.

@since 1.0.0.0
-}
toText :: SqlValue -> Either String T.Text
toText :: SqlValue -> Either String Text
toText =
  (ByteString -> Either String Text)
-> SqlValue -> Either String Text
forall a.
Typeable a =>
(ByteString -> Either String a) -> SqlValue -> Either String a
toBytesValue ((ByteString -> Either String Text)
 -> SqlValue -> Either String Text)
-> (ByteString -> Either String Text)
-> SqlValue
-> Either String Text
forall a b. (a -> b) -> a -> b
$ \ByteString
bytes ->
    case ByteString -> Either UnicodeException Text
TextEnc.decodeUtf8' ByteString
bytes of
      Right Text
t -> Text -> Either String Text
forall a b. b -> Either a b
Right Text
t
      Left UnicodeException
err -> String -> Either String Text
forall a b. a -> Either a b
Left (String -> Either String Text) -> String -> Either String Text
forall a b. (a -> b) -> a -> b
$ UnicodeException -> String
forall e. Exception e => e -> String
Exc.displayException UnicodeException
err

{- |
  Encodes a 'Time.Day' value as text in YYYY-MM-DD format so that it can be
  used with the database.

@since 1.0.0.0
-}
fromDay :: Time.Day -> SqlValue
fromDay :: Day -> SqlValue
fromDay =
  PgTextFormatValue -> SqlValue
SqlValue (PgTextFormatValue -> SqlValue)
-> (Day -> PgTextFormatValue) -> Day -> SqlValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> PgTextFormatValue
PgTextFormatValue.unsafeFromByteString (ByteString -> PgTextFormatValue)
-> (Day -> ByteString) -> Day -> PgTextFormatValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> ByteString
PgTime.dayToPostgreSQL

{- |
  Attempts to decode a 'SqlValue' as into a 'Time.Day' value by parsing it
  from YYYY-MM-DD format. If the decoding fails, 'Nothing' is returned.

@since 1.0.0.0
-}
toDay :: SqlValue -> Either String Time.Day
toDay :: SqlValue -> Either String Day
toDay =
  Parser Day -> SqlValue -> Either String Day
forall a. Typeable a => Parser a -> SqlValue -> Either String a
toParsedValue Parser Day
PgTime.day

{- |
  Encodes a 'Time.UTCTime' in ISO-8601 format for use with the database.

@since 1.0.0.0
-}
fromUTCTime :: Time.UTCTime -> SqlValue
fromUTCTime :: UTCTime -> SqlValue
fromUTCTime =
  PgTextFormatValue -> SqlValue
SqlValue
    (PgTextFormatValue -> SqlValue)
-> (UTCTime -> PgTextFormatValue) -> UTCTime -> SqlValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> PgTextFormatValue
PgTextFormatValue.unsafeFromByteString
    (ByteString -> PgTextFormatValue)
-> (UTCTime -> ByteString) -> UTCTime -> PgTextFormatValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> ByteString
PgTime.utcTimeToPostgreSQL

{- |
  Encodes a 'Time.LocalTime' in ISO-8601 format for use with the database.

@since 1.0.0.0
-}
fromLocalTime :: Time.LocalTime -> SqlValue
fromLocalTime :: LocalTime -> SqlValue
fromLocalTime =
  PgTextFormatValue -> SqlValue
SqlValue
    (PgTextFormatValue -> SqlValue)
-> (LocalTime -> PgTextFormatValue) -> LocalTime -> SqlValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> PgTextFormatValue
PgTextFormatValue.unsafeFromByteString
    (ByteString -> PgTextFormatValue)
-> (LocalTime -> ByteString) -> LocalTime -> PgTextFormatValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalTime -> ByteString
PgTime.localTimeToPostgreSQL

{- |
  Attempts to decode a 'SqlValue' as a 'Time.LocalTime' formatted in ISO-8601
  format in the default locale. If the decoding fails, 'Nothing' is returned.

@since 1.0.0.0
-}
toLocalTime :: SqlValue -> Either String Time.LocalTime
toLocalTime :: SqlValue -> Either String LocalTime
toLocalTime =
  Parser LocalTime -> SqlValue -> Either String LocalTime
forall a. Typeable a => Parser a -> SqlValue -> Either String a
toParsedValue Parser LocalTime
PgTime.localTime

{- |
  Attempts to decode a 'SqlValue' as a 'Time.UTCTime' formatted in ISO-8601
  format with time zone. If the decoding fails, 'Nothing' is returned.

@since 1.0.0.0
-}
toUTCTime :: SqlValue -> Either String Time.UTCTime
toUTCTime :: SqlValue -> Either String UTCTime
toUTCTime =
  Parser UTCTime -> SqlValue -> Either String UTCTime
forall a. Typeable a => Parser a -> SqlValue -> Either String a
toParsedValue Parser UTCTime
PgTime.utcTime

{- |
  An internal helper function that constructs a 'SqlValue' via a bytestring
  'BS8.Builder'.

@since 1.0.0.0
-}
fromBSBuilderWithNoNULs :: (a -> BSB.Builder) -> a -> SqlValue
fromBSBuilderWithNoNULs :: forall a. (a -> Builder) -> a -> SqlValue
fromBSBuilderWithNoNULs a -> Builder
builder =
  PgTextFormatValue -> SqlValue
SqlValue
    (PgTextFormatValue -> SqlValue)
-> (a -> PgTextFormatValue) -> a -> SqlValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> PgTextFormatValue
PgTextFormatValue.unsafeFromByteString
    (ByteString -> PgTextFormatValue)
-> (a -> ByteString) -> a -> PgTextFormatValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.toStrict
    (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BSB.toLazyByteString
    (Builder -> ByteString) -> (a -> Builder) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder
builder

{- |
  An internal helper function that parses 'SqlValue' via an Attoparsec parser.

@since 1.0.0.0
-}
toParsedValue ::
  Typeable.Typeable a =>
  AttoB8.Parser a ->
  SqlValue ->
  Either String a
toParsedValue :: forall a. Typeable a => Parser a -> SqlValue -> Either String a
toParsedValue Parser a
parser =
  (ByteString -> Either String a) -> SqlValue -> Either String a
forall a.
Typeable a =>
(ByteString -> Either String a) -> SqlValue -> Either String a
toBytesValue (Parser a -> ByteString -> Either String a
forall a. Parser a -> ByteString -> Either String a
AttoBS.parseOnly Parser a
parser)

{- |
  An internal helper function that parses the bytes from a 'SqlValue' with the
  given parsing function. If the 'SqlValue' is NULL, this function returns an
  error an a 'Left' value. If the parsing function fails (by returning 'Left'),
  the error it returns in returned by this function.

@since 1.0.0.0
-}
toBytesValue ::
  Typeable.Typeable a =>
  (BS.ByteString -> Either String a) ->
  SqlValue ->
  Either String a
toBytesValue :: forall a.
Typeable a =>
(ByteString -> Either String a) -> SqlValue -> Either String a
toBytesValue ByteString -> Either String a
byteParser SqlValue
sqlValue =
  let
    result :: Either String a
result =
      case SqlValue
sqlValue of
        SqlValue
SqlNull ->
          String -> Either String a
forall a b. a -> Either a b
Left String
"Unexpected SQL NULL value"
        SqlValue PgTextFormatValue
bytes ->
          ByteString -> Either String a
byteParser (PgTextFormatValue -> ByteString
PgTextFormatValue.toByteString PgTextFormatValue
bytes)

    typeRepOfA :: TypeRep
typeRepOfA =
      -- result is the 'proxy a' for typeRep
      Either String a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Typeable.typeRep Either String a
result
  in
    case Either String a
result of
      Right a
_ ->
        Either String a
result
      Left String
err ->
        String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"Failed to decode PostgreSQL value as " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TypeRep -> String -> String
Typeable.showsTypeRep TypeRep
typeRepOfA (String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
err)