{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE ViewPatterns #-}

{- |
Module      : Database.DuckDB.Simple.FromField
Description : Conversion from DuckDB column values to Haskell types.
-}
module Database.DuckDB.Simple.FromField (
    Field (..),
    FieldValue (..),
    BitString(..),
    bsFromBool,
    BigNum (..),
    fromBigNumBytes,
    toBigNumBytes,
    DecimalValue (..),
    IntervalValue (..),
    TimeWithZone (..),
    ResultError (..),
    FieldParser,
    FromField (..),
    returnError,
) where

import Control.Exception (Exception, SomeException (..))
import Data.Bits (Bits (..), finiteBitSize)
import qualified Data.ByteString as BS
import Data.Data (Typeable, typeRep)
import Data.Int (Int16, Int32, Int64, Int8)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Proxy (Proxy (..))
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as TextEncoding
import Data.Time.Calendar (Day)
import Data.Time.Clock (UTCTime (..))
import Data.Time.LocalTime (
    LocalTime (..),
    TimeOfDay (..),
    TimeZone (..),
    localTimeToUTC,
    utc,
    utcToLocalTime,
 )
import Data.Word (Word16, Word32, Word64, Word8)
import Database.DuckDB.Simple.Ok
import Database.DuckDB.Simple.Types (Null (..))
import GHC.Num.Integer (integerFromWordList)
import Numeric.Natural (Natural)
import qualified Data.UUID as UUID

-- | Internal representation of a column value.
data FieldValue
    = FieldNull
    | FieldInt8 Int8
    | FieldInt16 Int16
    | FieldInt32 Int32
    | FieldInt64 Int64
    | FieldWord8 Word8
    | FieldWord16 Word16
    | FieldWord32 Word32
    | FieldWord64 Word64
    | FieldUUID UUID.UUID
    | FieldFloat Float
    | FieldDouble Double
    | FieldText Text
    | FieldBool Bool
    | FieldBlob BS.ByteString
    | FieldDate Day
    | FieldTime TimeOfDay
    | FieldTimestamp LocalTime
    | FieldInterval IntervalValue
    | FieldHugeInt Integer
    | FieldUHugeInt Integer
    | FieldDecimal DecimalValue
    | FieldTimestampTZ UTCTime
    | FieldTimeTZ TimeWithZone
    | FieldBit BitString
    | FieldBigNum BigNum
    | FieldEnum Word32
    | FieldList [FieldValue]
    | FieldMap [(FieldValue, FieldValue)]
    deriving (FieldValue -> FieldValue -> Bool
(FieldValue -> FieldValue -> Bool)
-> (FieldValue -> FieldValue -> Bool) -> Eq FieldValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FieldValue -> FieldValue -> Bool
== :: FieldValue -> FieldValue -> Bool
$c/= :: FieldValue -> FieldValue -> Bool
/= :: FieldValue -> FieldValue -> Bool
Eq, Int -> FieldValue -> ShowS
[FieldValue] -> ShowS
FieldValue -> String
(Int -> FieldValue -> ShowS)
-> (FieldValue -> String)
-> ([FieldValue] -> ShowS)
-> Show FieldValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FieldValue -> ShowS
showsPrec :: Int -> FieldValue -> ShowS
$cshow :: FieldValue -> String
show :: FieldValue -> String
$cshowList :: [FieldValue] -> ShowS
showList :: [FieldValue] -> ShowS
Show)

data DecimalValue = DecimalValue
    { DecimalValue -> Word8
decimalWidth :: !Word8
    , DecimalValue -> Word8
decimalScale :: !Word8
    , DecimalValue -> Integer
decimalInteger :: !Integer
    }
    deriving (DecimalValue -> DecimalValue -> Bool
(DecimalValue -> DecimalValue -> Bool)
-> (DecimalValue -> DecimalValue -> Bool) -> Eq DecimalValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DecimalValue -> DecimalValue -> Bool
== :: DecimalValue -> DecimalValue -> Bool
$c/= :: DecimalValue -> DecimalValue -> Bool
/= :: DecimalValue -> DecimalValue -> Bool
Eq, Int -> DecimalValue -> ShowS
[DecimalValue] -> ShowS
DecimalValue -> String
(Int -> DecimalValue -> ShowS)
-> (DecimalValue -> String)
-> ([DecimalValue] -> ShowS)
-> Show DecimalValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DecimalValue -> ShowS
showsPrec :: Int -> DecimalValue -> ShowS
$cshow :: DecimalValue -> String
show :: DecimalValue -> String
$cshowList :: [DecimalValue] -> ShowS
showList :: [DecimalValue] -> ShowS
Show)

data IntervalValue = IntervalValue
    { IntervalValue -> Int32
intervalMonths :: !Int32
    , IntervalValue -> Int32
intervalDays :: !Int32
    , IntervalValue -> Int64
intervalMicros :: !Int64
    }
    deriving (IntervalValue -> IntervalValue -> Bool
(IntervalValue -> IntervalValue -> Bool)
-> (IntervalValue -> IntervalValue -> Bool) -> Eq IntervalValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IntervalValue -> IntervalValue -> Bool
== :: IntervalValue -> IntervalValue -> Bool
$c/= :: IntervalValue -> IntervalValue -> Bool
/= :: IntervalValue -> IntervalValue -> Bool
Eq, Int -> IntervalValue -> ShowS
[IntervalValue] -> ShowS
IntervalValue -> String
(Int -> IntervalValue -> ShowS)
-> (IntervalValue -> String)
-> ([IntervalValue] -> ShowS)
-> Show IntervalValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IntervalValue -> ShowS
showsPrec :: Int -> IntervalValue -> ShowS
$cshow :: IntervalValue -> String
show :: IntervalValue -> String
$cshowList :: [IntervalValue] -> ShowS
showList :: [IntervalValue] -> ShowS
Show)


newtype BigNum = BigNum Integer
    deriving stock (BigNum -> BigNum -> Bool
(BigNum -> BigNum -> Bool)
-> (BigNum -> BigNum -> Bool) -> Eq BigNum
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BigNum -> BigNum -> Bool
== :: BigNum -> BigNum -> Bool
$c/= :: BigNum -> BigNum -> Bool
/= :: BigNum -> BigNum -> Bool
Eq, Int -> BigNum -> ShowS
[BigNum] -> ShowS
BigNum -> String
(Int -> BigNum -> ShowS)
-> (BigNum -> String) -> ([BigNum] -> ShowS) -> Show BigNum
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BigNum -> ShowS
showsPrec :: Int -> BigNum -> ShowS
$cshow :: BigNum -> String
show :: BigNum -> String
$cshowList :: [BigNum] -> ShowS
showList :: [BigNum] -> ShowS
Show)
    deriving (Integer -> BigNum
BigNum -> BigNum
BigNum -> BigNum -> BigNum
(BigNum -> BigNum -> BigNum)
-> (BigNum -> BigNum -> BigNum)
-> (BigNum -> BigNum -> BigNum)
-> (BigNum -> BigNum)
-> (BigNum -> BigNum)
-> (BigNum -> BigNum)
-> (Integer -> BigNum)
-> Num BigNum
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: BigNum -> BigNum -> BigNum
+ :: BigNum -> BigNum -> BigNum
$c- :: BigNum -> BigNum -> BigNum
- :: BigNum -> BigNum -> BigNum
$c* :: BigNum -> BigNum -> BigNum
* :: BigNum -> BigNum -> BigNum
$cnegate :: BigNum -> BigNum
negate :: BigNum -> BigNum
$cabs :: BigNum -> BigNum
abs :: BigNum -> BigNum
$csignum :: BigNum -> BigNum
signum :: BigNum -> BigNum
$cfromInteger :: Integer -> BigNum
fromInteger :: Integer -> BigNum
Num) via Integer

{- | Decode DuckDB’s BIGNUM blob (3-byte header + big-endian payload where negative magnitudes are
bitwise complemented) back into a Haskell 'Integer'. We undo the complement when needed, then chunk
the remaining bytes into machine-word limbs (MSB chunk first) for 'integerFromWordList'.
-}
fromBigNumBytes :: [Word8] -> Integer
fromBigNumBytes :: [Word8] -> Integer
fromBigNumBytes [Word8]
bytes =
    let header :: [Word8]
header = Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
take Int
3 [Word8]
bytes
        payloadRaw :: [Word8]
payloadRaw = Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
drop Int
3 [Word8]
bytes
        isNeg :: Bool
isNeg = [Word8] -> Word8
forall a. HasCallStack => [a] -> a
head [Word8]
header Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x80 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0
        payload :: [Word8]
payload = if Bool
isNeg then (Word8 -> Word8) -> [Word8] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Word8
forall a. Bits a => a -> a
complement [Word8]
payloadRaw else [Word8]
payloadRaw
        bytesPerWord :: Int
bytesPerWord = Word -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (Word
0 :: Word) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8 -- 8 on 64-bit, 4 on 32-bit
        len :: Int
len = [Word8] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
payload
        ([Word8]
firstChunk, [Word8]
rest) = Int -> [Word8] -> ([Word8], [Word8])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
bytesPerWord) [Word8]
payload

        chunkWords :: [a] -> [[a]]
chunkWords [] = []
        chunkWords [a]
xs =
            let ([a]
chunk, [a]
remainder) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
bytesPerWord [a]
xs
             in [a]
chunk [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
chunkWords [a]
remainder

        toWord :: [Word8] -> Word
toWord = (Word -> Word8 -> Word) -> Word -> [Word8] -> Word
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Word
acc Word8
b -> (Word
acc Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b) Word
0
        limbs :: [[Word8]]
limbs = (if [Word8] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Word8]
firstChunk then [[Word8]] -> [[Word8]]
forall a. a -> a
id else ([Word8]
firstChunk [Word8] -> [[Word8]] -> [[Word8]]
forall a. a -> [a] -> [a]
:)) ([Word8] -> [[Word8]]
forall {a}. [a] -> [[a]]
chunkWords [Word8]
rest)
     in Bool -> [Word] -> Integer
integerFromWordList Bool
isNeg (([Word8] -> Word) -> [[Word8]] -> [Word]
forall a b. (a -> b) -> [a] -> [b]
map [Word8] -> Word
toWord [[Word8]]
limbs)

{- | Encode an 'Integer' into DuckDB’s BIGNUM blob layout: emit the 3-byte header
  (sign bit plus payload length) followed by the magnitude bytes in the same
  big-endian / complemented-on-negative form that DuckDB stores internally.
-}
toBigNumBytes :: Integer -> [Word8]
toBigNumBytes :: Integer -> [Word8]
toBigNumBytes Integer
value =
    let isNeg :: Bool
isNeg = Integer
value Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0
        magnitude :: Integer
magnitude = if Bool
isNeg then Integer -> Integer
forall a. Num a => a -> a
negate Integer
value else Integer
value
        payloadBE :: [Word8]
payloadBE
            | Integer
magnitude Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = [Word8
0]
            | Bool
otherwise = Integer -> [Word8] -> [Word8]
forall {a} {a}. (Integral a, Num a) => a -> [a] -> [a]
go Integer
magnitude []
          where
            go :: a -> [a] -> [a]
go a
0 [a]
acc = [a]
acc
            go a
n [a]
acc =
                let (a
q, a
r) = a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
quotRem a
n a
256
                 in a -> [a] -> [a]
go a
q (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
r a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc)

        headerBase :: Word32
        headerBase :: Word32
headerBase = (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Word8] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
payloadBE) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
0x00800000)
        headerVal :: Word32
        headerVal :: Word32
headerVal = if Bool
isNeg then Word32 -> Word32
forall a. Bits a => a -> a
complement Word32
headerBase else Word32
headerBase
        headerMasked :: Word32
headerMasked = Word32
headerVal Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0x00FFFFFF
        headerBytes :: [Word8]
headerBytes =
            [ Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32
headerMasked Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
16) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xFF)
            , Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32
headerMasked Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
8) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xFF)
            , Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
headerMasked Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xFF)
            ]
        payloadBytes :: [Word8]
payloadBytes = if Bool
isNeg then (Word8 -> Word8) -> [Word8] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Word8
forall a. Bits a => a -> a
complement [Word8]
payloadBE else [Word8]
payloadBE
     in [Word8]
headerBytes [Word8] -> [Word8] -> [Word8]
forall a. Semigroup a => a -> a -> a
<> [Word8]
payloadBytes

data BitString = BitString { BitString -> Word8
padding :: !Word8
                           , BitString -> ByteString
bits :: !BS.ByteString}
    deriving stock (BitString -> BitString -> Bool
(BitString -> BitString -> Bool)
-> (BitString -> BitString -> Bool) -> Eq BitString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BitString -> BitString -> Bool
== :: BitString -> BitString -> Bool
$c/= :: BitString -> BitString -> Bool
/= :: BitString -> BitString -> Bool
Eq)

instance Show BitString where
    show :: BitString -> String
show (BitString Word8
padding ByteString
bits) =
        Int -> ShowS
forall a. Int -> [a] -> [a]
drop (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
padding) ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (Word8 -> String) -> [Word8] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Word8 -> String
word8ToString ([Word8] -> String) -> [Word8] -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
BS.unpack ByteString
bits
      where
        word8ToString :: Word8 -> String
        word8ToString :: Word8 -> String
word8ToString Word8
w = (Int -> Char) -> [Int] -> String
forall a b. (a -> b) -> [a] -> [b]
map (\Int
n -> if Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
w Int
n then Char
'1' else Char
'0') [Int
7, Int
6 .. Int
0]

-- | Construct a 'BitString' from a list of 'Bool's, where the first element
bsFromBool :: [Bool] -> BitString
bsFromBool :: [Bool] -> BitString
bsFromBool [Bool]
bits =
    let totalBits :: Int
totalBits = [Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
bits
        padding :: Int
padding = (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
totalBits Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
8)) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
8
        paddedBits :: [Bool]
paddedBits = Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
padding Bool
False [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ [Bool]
bits
        byteChunks :: [[Bool]]
byteChunks = Int -> [Bool] -> [[Bool]]
forall {a}. Int -> [a] -> [[a]]
chunk Int
8 [Bool]
paddedBits
        byteValues :: [Word8]
byteValues = ([Bool] -> Word8) -> [[Bool]] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map [Bool] -> Word8
bitsToWord8 [[Bool]]
byteChunks
     in Word8 -> ByteString -> BitString
BitString (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
padding) ([Word8] -> ByteString
BS.pack [Word8]
byteValues)
  where
    chunk :: Int -> [a] -> [[a]]
chunk Int
_ [] = []
    chunk Int
n [a]
xs = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n [a]
xs [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: Int -> [a] -> [[a]]
chunk Int
n (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
n [a]
xs)

    bitsToWord8 :: [Bool] -> Word8
    bitsToWord8 :: [Bool] -> Word8
bitsToWord8 [Bool]
bs = (Word8 -> (Bool, Int) -> Word8) -> Word8 -> [(Bool, Int)] -> Word8
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Word8
acc (Bool
b, Int
i) -> if Bool
b then Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
setBit Word8
acc Int
i else Word8
acc) Word8
0 ([Bool] -> [Int] -> [(Bool, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Bool]
bs [Int
7, Int
6 .. Int
0])


data TimeWithZone = TimeWithZone
    { TimeWithZone -> TimeOfDay
timeWithZoneTime :: !TimeOfDay
    , TimeWithZone -> TimeZone
timeWithZoneZone :: !TimeZone
    }
    deriving (TimeWithZone -> TimeWithZone -> Bool
(TimeWithZone -> TimeWithZone -> Bool)
-> (TimeWithZone -> TimeWithZone -> Bool) -> Eq TimeWithZone
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimeWithZone -> TimeWithZone -> Bool
== :: TimeWithZone -> TimeWithZone -> Bool
$c/= :: TimeWithZone -> TimeWithZone -> Bool
/= :: TimeWithZone -> TimeWithZone -> Bool
Eq, Int -> TimeWithZone -> ShowS
[TimeWithZone] -> ShowS
TimeWithZone -> String
(Int -> TimeWithZone -> ShowS)
-> (TimeWithZone -> String)
-> ([TimeWithZone] -> ShowS)
-> Show TimeWithZone
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TimeWithZone -> ShowS
showsPrec :: Int -> TimeWithZone -> ShowS
$cshow :: TimeWithZone -> String
show :: TimeWithZone -> String
$cshowList :: [TimeWithZone] -> ShowS
showList :: [TimeWithZone] -> ShowS
Show)

-- | Pattern synonym to make it easier to match on any integral type.
pattern FieldInt :: Int -> FieldValue
pattern $mFieldInt :: forall {r}. FieldValue -> (Int -> r) -> ((# #) -> r) -> r
$bFieldInt :: Int -> FieldValue
FieldInt i <- (fieldValueToInt -> Just i)
    where
        FieldInt Int
i = Int64 -> FieldValue
FieldInt64 (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)

fieldValueToInt :: FieldValue -> Maybe Int
fieldValueToInt :: FieldValue -> Maybe Int
fieldValueToInt (FieldInt8 Int8
i) = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
i)
fieldValueToInt (FieldInt16 Int16
i) = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
i)
fieldValueToInt (FieldInt32 Int32
i) = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i)
fieldValueToInt (FieldInt64 Int64
i) = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i)
fieldValueToInt FieldValue
_ = Maybe Int
forall a. Maybe a
Nothing

-- | Pattern synonym to make it easier to match on any word size
pattern FieldWord :: Word -> FieldValue
pattern $mFieldWord :: forall {r}. FieldValue -> (Word -> r) -> ((# #) -> r) -> r
$bFieldWord :: Word -> FieldValue
FieldWord i <- (fieldValueToWord -> Just i)
    where
        FieldWord Word
i = Word64 -> FieldValue
FieldWord64 (Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
i)

fieldValueToWord :: FieldValue -> Maybe Word
fieldValueToWord :: FieldValue -> Maybe Word
fieldValueToWord (FieldWord8 Word8
i) = Word -> Maybe Word
forall a. a -> Maybe a
Just (Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i)
fieldValueToWord (FieldWord16 Word16
i) = Word -> Maybe Word
forall a. a -> Maybe a
Just (Word16 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
i)
fieldValueToWord (FieldWord32 Word32
i) = Word -> Maybe Word
forall a. a -> Maybe a
Just (Word32 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i)
fieldValueToWord (FieldWord64 Word64
i) = Word -> Maybe Word
forall a. a -> Maybe a
Just (Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i)
fieldValueToWord FieldValue
_ = Maybe Word
forall a. Maybe a
Nothing

-- | Metadata for a single column in a row.
data Field = Field
    { Field -> Text
fieldName :: Text
    , Field -> Int
fieldIndex :: Int
    , Field -> FieldValue
fieldValue :: FieldValue
    }
    deriving (Field -> Field -> Bool
(Field -> Field -> Bool) -> (Field -> Field -> Bool) -> Eq Field
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Field -> Field -> Bool
== :: Field -> Field -> Bool
$c/= :: Field -> Field -> Bool
/= :: Field -> Field -> Bool
Eq, Int -> Field -> ShowS
[Field] -> ShowS
Field -> String
(Int -> Field -> ShowS)
-> (Field -> String) -> ([Field] -> ShowS) -> Show Field
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Field -> ShowS
showsPrec :: Int -> Field -> ShowS
$cshow :: Field -> String
show :: Field -> String
$cshowList :: [Field] -> ShowS
showList :: [Field] -> ShowS
Show)

{- | Exception thrown if conversion from a SQL value to a Haskell
value fails.
-}
data ResultError
    = -- | The SQL and Haskell types are not compatible.
      Incompatible
        { ResultError -> Text
errSQLType :: Text
        , ResultError -> Text
errSQLField :: Text
        , ResultError -> Text
errHaskellType :: Text
        , ResultError -> Text
errMessage :: Text
        }
    | -- | A SQL @NULL@ was encountered when the Haskell
      -- type did not permit it.
      UnexpectedNull
        { errSQLType :: Text
        , errSQLField :: Text
        , errHaskellType :: Text
        , errMessage :: Text
        }
    | -- | The SQL value could not be parsed, or could not
      -- be represented as a valid Haskell value, or an
      -- unexpected low-level error occurred (e.g. mismatch
      -- between metadata and actual data in a row).
      ConversionFailed
        { errSQLType :: Text
        , errSQLField :: Text
        , errHaskellType :: Text
        , errMessage :: Text
        }
    deriving (ResultError -> ResultError -> Bool
(ResultError -> ResultError -> Bool)
-> (ResultError -> ResultError -> Bool) -> Eq ResultError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResultError -> ResultError -> Bool
== :: ResultError -> ResultError -> Bool
$c/= :: ResultError -> ResultError -> Bool
/= :: ResultError -> ResultError -> Bool
Eq, Int -> ResultError -> ShowS
[ResultError] -> ShowS
ResultError -> String
(Int -> ResultError -> ShowS)
-> (ResultError -> String)
-> ([ResultError] -> ShowS)
-> Show ResultError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResultError -> ShowS
showsPrec :: Int -> ResultError -> ShowS
$cshow :: ResultError -> String
show :: ResultError -> String
$cshowList :: [ResultError] -> ShowS
showList :: [ResultError] -> ShowS
Show, Typeable)

instance Exception ResultError

{- | Parser used by 'FromField' instances and utilities such as
'Database.DuckDB.Simple.FromRow.fieldWith'. The supplied 'Field' contains
column metadata and an already-decoded 'FieldValue'; callers should return
'Ok' on success or 'Errors' (typically wrapping a 'ResultError') when the
conversion fails.
-}
type FieldParser a = Field -> Ok a

-- | Types that can be constructed from a DuckDB column.
class FromField a where
    fromField :: FieldParser a

instance FromField FieldValue where
    fromField :: FieldParser FieldValue
fromField Field{FieldValue
fieldValue :: Field -> FieldValue
fieldValue :: FieldValue
fieldValue} = FieldValue -> Ok FieldValue
forall a. a -> Ok a
Ok FieldValue
fieldValue

instance FromField Null where
    fromField :: FieldParser Null
fromField f :: Field
f@Field{FieldValue
fieldValue :: Field -> FieldValue
fieldValue :: FieldValue
fieldValue} =
        case FieldValue
fieldValue of
            FieldValue
FieldNull -> Null -> Ok Null
forall a. a -> Ok a
Ok Null
Null
            FieldValue
_ -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Null
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
Incompatible Field
f Text
"expected NULL"

instance FromField UUID.UUID where
    fromField :: FieldParser UUID
fromField f :: Field
f@Field{FieldValue
fieldValue :: Field -> FieldValue
fieldValue :: FieldValue
fieldValue} =
        case FieldValue
fieldValue of
            FieldText Text
t ->
                case Text -> Maybe UUID
UUID.fromText Text
t of
                    Just UUID
uuid -> UUID -> Ok UUID
forall a. a -> Ok a
Ok UUID
uuid
                    Maybe UUID
Nothing -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok UUID
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
ConversionFailed Field
f Text
"invalid UUID format"
            FieldUUID UUID
uuid -> UUID -> Ok UUID
forall a. a -> Ok a
Ok UUID
uuid
            FieldValue
FieldNull -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok UUID
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
UnexpectedNull Field
f Text
""
            FieldValue
_ -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok UUID
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
Incompatible Field
f Text
""

instance FromField Bool where
    fromField :: FieldParser Bool
fromField f :: Field
f@Field{FieldValue
fieldValue :: Field -> FieldValue
fieldValue :: FieldValue
fieldValue} =
        case FieldValue
fieldValue of
            FieldBool Bool
b -> Bool -> Ok Bool
forall a. a -> Ok a
Ok Bool
b
            FieldInt Int
i -> Bool -> Ok Bool
forall a. a -> Ok a
Ok (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0)
            FieldValue
FieldNull -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Bool
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
UnexpectedNull Field
f Text
""
            FieldValue
_ -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Bool
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
Incompatible Field
f Text
""

instance FromField Int8 where
    fromField :: FieldParser Int8
fromField f :: Field
f@Field{FieldValue
fieldValue :: Field -> FieldValue
fieldValue :: FieldValue
fieldValue} =
        case FieldValue
fieldValue of
            FieldInt Int
i -> Int8 -> Ok Int8
forall a. a -> Ok a
Ok (Int -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
            FieldHugeInt Integer
value -> Field -> Integer -> Ok Int8
forall a.
(Integral a, Bounded a, Typeable a) =>
Field -> Integer -> Ok a
boundedFromInteger Field
f Integer
value
            FieldUHugeInt Integer
value -> Field -> Integer -> Ok Int8
forall a.
(Integral a, Bounded a, Typeable a) =>
Field -> Integer -> Ok a
boundedFromInteger Field
f Integer
value
            FieldEnum Word32
value -> Field -> Integer -> Ok Int8
forall a.
(Integral a, Bounded a, Typeable a) =>
Field -> Integer -> Ok a
boundedFromInteger Field
f (Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
value)
            FieldValue
FieldNull -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Int8
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
UnexpectedNull Field
f Text
""
            FieldValue
_ -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Int8
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
Incompatible Field
f Text
""

instance FromField Int64 where
    fromField :: FieldParser Int64
fromField f :: Field
f@Field{FieldValue
fieldValue :: Field -> FieldValue
fieldValue :: FieldValue
fieldValue} =
        case FieldValue
fieldValue of
            FieldInt Int
i -> Int64 -> Ok Int64
forall a. a -> Ok a
Ok (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
            FieldHugeInt Integer
value -> Field -> Integer -> Ok Int64
forall a.
(Integral a, Bounded a, Typeable a) =>
Field -> Integer -> Ok a
boundedFromInteger Field
f Integer
value
            FieldUHugeInt Integer
value -> Field -> Integer -> Ok Int64
forall a.
(Integral a, Bounded a, Typeable a) =>
Field -> Integer -> Ok a
boundedFromInteger Field
f Integer
value
            FieldEnum Word32
value -> Int64 -> Ok Int64
forall a. a -> Ok a
Ok (Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
value)
            FieldValue
FieldNull -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Int64
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
UnexpectedNull Field
f Text
""
            FieldValue
_ -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Int64
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
Incompatible Field
f Text
""

instance FromField Int32 where
    fromField :: FieldParser Int32
fromField f :: Field
f@Field{FieldValue
fieldValue :: Field -> FieldValue
fieldValue :: FieldValue
fieldValue} =
        case FieldValue
fieldValue of
            FieldInt Int
i -> Field -> Int -> Ok Int32
forall a.
(Integral a, Bounded a, Typeable a) =>
Field -> Int -> Ok a
boundedIntegral Field
f Int
i
            FieldHugeInt Integer
value -> Field -> Integer -> Ok Int32
forall a.
(Integral a, Bounded a, Typeable a) =>
Field -> Integer -> Ok a
boundedFromInteger Field
f Integer
value
            FieldUHugeInt Integer
value -> Field -> Integer -> Ok Int32
forall a.
(Integral a, Bounded a, Typeable a) =>
Field -> Integer -> Ok a
boundedFromInteger Field
f Integer
value
            FieldEnum Word32
value -> Field -> Integer -> Ok Int32
forall a.
(Integral a, Bounded a, Typeable a) =>
Field -> Integer -> Ok a
boundedFromInteger Field
f (Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
value)
            FieldValue
FieldNull -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Int32
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
UnexpectedNull Field
f Text
""
            FieldValue
_ -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Int32
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
Incompatible Field
f Text
""

instance FromField Int16 where
    fromField :: FieldParser Int16
fromField f :: Field
f@Field{FieldValue
fieldValue :: Field -> FieldValue
fieldValue :: FieldValue
fieldValue} =
        case FieldValue
fieldValue of
            FieldInt Int
i -> Field -> Int -> Ok Int16
forall a.
(Integral a, Bounded a, Typeable a) =>
Field -> Int -> Ok a
boundedIntegral Field
f Int
i
            FieldHugeInt Integer
value -> Field -> Integer -> Ok Int16
forall a.
(Integral a, Bounded a, Typeable a) =>
Field -> Integer -> Ok a
boundedFromInteger Field
f Integer
value
            FieldUHugeInt Integer
value -> Field -> Integer -> Ok Int16
forall a.
(Integral a, Bounded a, Typeable a) =>
Field -> Integer -> Ok a
boundedFromInteger Field
f Integer
value
            FieldEnum Word32
value -> Field -> Integer -> Ok Int16
forall a.
(Integral a, Bounded a, Typeable a) =>
Field -> Integer -> Ok a
boundedFromInteger Field
f (Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
value)
            FieldValue
FieldNull -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Int16
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
UnexpectedNull Field
f Text
""
            FieldValue
_ -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Int16
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
Incompatible Field
f Text
""

instance FromField Int where
    fromField :: FieldParser Int
fromField f :: Field
f@Field{FieldValue
fieldValue :: Field -> FieldValue
fieldValue :: FieldValue
fieldValue} =
        case FieldValue
fieldValue of
            FieldInt Int
i -> Field -> Int -> Ok Int
forall a.
(Integral a, Bounded a, Typeable a) =>
Field -> Int -> Ok a
boundedIntegral Field
f Int
i
            FieldHugeInt Integer
value -> Field -> Integer -> Ok Int
forall a.
(Integral a, Bounded a, Typeable a) =>
Field -> Integer -> Ok a
boundedFromInteger Field
f Integer
value
            FieldUHugeInt Integer
value -> Field -> Integer -> Ok Int
forall a.
(Integral a, Bounded a, Typeable a) =>
Field -> Integer -> Ok a
boundedFromInteger Field
f Integer
value
            FieldEnum Word32
value -> Field -> Integer -> Ok Int
forall a.
(Integral a, Bounded a, Typeable a) =>
Field -> Integer -> Ok a
boundedFromInteger Field
f (Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
value)
            FieldValue
FieldNull -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Int
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
UnexpectedNull Field
f Text
""
            FieldValue
_ -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Int
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
Incompatible Field
f Text
""

instance FromField Integer where
    fromField :: FieldParser Integer
fromField f :: Field
f@Field{FieldValue
fieldValue :: Field -> FieldValue
fieldValue :: FieldValue
fieldValue} =
        case FieldValue
fieldValue of
            FieldInt Int
i -> Integer -> Ok Integer
forall a. a -> Ok a
Ok (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
            FieldWord Word
w -> Integer -> Ok Integer
forall a. a -> Ok a
Ok (Word -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
w)
            FieldBigNum (BigNum Integer
big) -> Integer -> Ok Integer
forall a. a -> Ok a
Ok Integer
big
            FieldHugeInt Integer
value -> Integer -> Ok Integer
forall a. a -> Ok a
Ok Integer
value
            FieldUHugeInt Integer
value -> Integer -> Ok Integer
forall a. a -> Ok a
Ok Integer
value
            FieldValue
FieldNull -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Integer
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
UnexpectedNull Field
f Text
""
            FieldValue
_ -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Integer
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
Incompatible Field
f Text
""

instance FromField Natural where
    fromField :: FieldParser Natural
fromField f :: Field
f@Field{FieldValue
fieldValue :: Field -> FieldValue
fieldValue :: FieldValue
fieldValue} =
        case FieldValue
fieldValue of
            FieldInt Int
i
                | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 -> Natural -> Ok Natural
forall a. a -> Ok a
Ok (Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
                | Bool
otherwise ->
                    (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Natural
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
ConversionFailed Field
f Text
"negative value cannot be converted to Natural"
            FieldWord Word
w -> Natural -> Ok Natural
forall a. a -> Ok a
Ok (Word -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
w)
            FieldHugeInt Integer
value
                | Integer
value Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 -> Natural -> Ok Natural
forall a. a -> Ok a
Ok (Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
value)
                | Bool
otherwise ->
                    (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Natural
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
ConversionFailed Field
f Text
"negative value cannot be converted to Natural"
            FieldUHugeInt Integer
value -> Natural -> Ok Natural
forall a. a -> Ok a
Ok (Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
value)
            FieldBigNum (BigNum Integer
big) ->
                if Integer
big Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0
                    then Natural -> Ok Natural
forall a. a -> Ok a
Ok (Natural -> Ok Natural) -> Natural -> Ok Natural
forall a b. (a -> b) -> a -> b
$ Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
big
                    else (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Natural
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
ConversionFailed Field
f Text
"negative value cannot be converted to Natural"
            FieldEnum Word32
value -> Natural -> Ok Natural
forall a. a -> Ok a
Ok (Word32 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
value)
            FieldValue
FieldNull -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Natural
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
UnexpectedNull Field
f Text
""
            FieldValue
_ -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Natural
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
Incompatible Field
f Text
""

instance FromField Word64 where
    fromField :: FieldParser Word64
fromField f :: Field
f@Field{FieldValue
fieldValue :: Field -> FieldValue
fieldValue :: FieldValue
fieldValue} =
        case FieldValue
fieldValue of
            FieldInt Int
i
                | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 -> Word64 -> Ok Word64
forall a. a -> Ok a
Ok (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
                | Bool
otherwise ->
                    (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Word64
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
ConversionFailed Field
f Text
"negative value cannot be converted to unsigned integer"
            FieldWord Word
w -> Word64 -> Ok Word64
forall a. a -> Ok a
Ok (Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
w)
            FieldHugeInt Integer
value
                | Integer
value Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 -> Field -> Integer -> Ok Word64
forall a.
(Integral a, Bounded a, Typeable a) =>
Field -> Integer -> Ok a
boundedFromInteger Field
f Integer
value
                | Bool
otherwise ->
                    (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Word64
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
ConversionFailed Field
f Text
"negative value cannot be converted to unsigned integer"
            FieldUHugeInt Integer
value -> Field -> Integer -> Ok Word64
forall a.
(Integral a, Bounded a, Typeable a) =>
Field -> Integer -> Ok a
boundedFromInteger Field
f Integer
value
            FieldEnum Word32
value -> Word64 -> Ok Word64
forall a. a -> Ok a
Ok (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
value)
            FieldValue
FieldNull -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Word64
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
UnexpectedNull Field
f Text
""
            FieldValue
_ -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Word64
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
Incompatible Field
f Text
""

instance FromField Word32 where
    fromField :: FieldParser Word32
fromField f :: Field
f@Field{FieldValue
fieldValue :: Field -> FieldValue
fieldValue :: FieldValue
fieldValue} =
        case FieldValue
fieldValue of
            FieldInt Int
i
                | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 -> Field -> Int -> Ok Word32
forall a.
(Integral a, Bounded a, Typeable a) =>
Field -> Int -> Ok a
boundedIntegral Field
f Int
i
                | Bool
otherwise ->
                    (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Word32
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
ConversionFailed Field
f Text
"negative value cannot be converted to unsigned integer"
            FieldWord Word
w -> Word32 -> Ok Word32
forall a. a -> Ok a
Ok (Word -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
w)
            FieldHugeInt Integer
value
                | Integer
value Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 -> Field -> Integer -> Ok Word32
forall a.
(Integral a, Bounded a, Typeable a) =>
Field -> Integer -> Ok a
boundedFromInteger Field
f Integer
value
                | Bool
otherwise ->
                    (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Word32
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
ConversionFailed Field
f Text
"negative value cannot be converted to unsigned integer"
            FieldUHugeInt Integer
value -> Field -> Integer -> Ok Word32
forall a.
(Integral a, Bounded a, Typeable a) =>
Field -> Integer -> Ok a
boundedFromInteger Field
f Integer
value
            FieldEnum Word32
value -> Word32 -> Ok Word32
forall a. a -> Ok a
Ok Word32
value
            FieldValue
FieldNull -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Word32
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
UnexpectedNull Field
f Text
""
            FieldValue
_ -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Word32
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
Incompatible Field
f Text
""

instance FromField Word16 where
    fromField :: FieldParser Word16
fromField f :: Field
f@Field{FieldValue
fieldValue :: Field -> FieldValue
fieldValue :: FieldValue
fieldValue} =
        case FieldValue
fieldValue of
            FieldInt Int
i
                | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 -> Field -> Int -> Ok Word16
forall a.
(Integral a, Bounded a, Typeable a) =>
Field -> Int -> Ok a
boundedIntegral Field
f Int
i
                | Bool
otherwise ->
                    (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Word16
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
ConversionFailed Field
f Text
"negative value cannot be converted to unsigned integer"
            FieldWord Word
w -> Word16 -> Ok Word16
forall a. a -> Ok a
Ok (Word -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
w)
            FieldHugeInt Integer
value
                | Integer
value Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 -> Field -> Integer -> Ok Word16
forall a.
(Integral a, Bounded a, Typeable a) =>
Field -> Integer -> Ok a
boundedFromInteger Field
f Integer
value
                | Bool
otherwise ->
                    (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Word16
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
ConversionFailed Field
f Text
"negative value cannot be converted to unsigned integer"
            FieldUHugeInt Integer
value -> Field -> Integer -> Ok Word16
forall a.
(Integral a, Bounded a, Typeable a) =>
Field -> Integer -> Ok a
boundedFromInteger Field
f Integer
value
            FieldEnum Word32
value -> Field -> Integer -> Ok Word16
forall a.
(Integral a, Bounded a, Typeable a) =>
Field -> Integer -> Ok a
boundedFromInteger Field
f (Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
value)
            FieldValue
FieldNull -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Word16
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
UnexpectedNull Field
f Text
""
            FieldValue
_ -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Word16
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
Incompatible Field
f Text
""

instance FromField Word8 where
    fromField :: FieldParser Word8
fromField f :: Field
f@Field{FieldValue
fieldValue :: Field -> FieldValue
fieldValue :: FieldValue
fieldValue} =
        case FieldValue
fieldValue of
            FieldInt Int
i
                | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 -> Field -> Int -> Ok Word8
forall a.
(Integral a, Bounded a, Typeable a) =>
Field -> Int -> Ok a
boundedIntegral Field
f Int
i
                | Bool
otherwise ->
                    (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Word8
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
ConversionFailed Field
f Text
"negative value cannot be converted to unsigned integer"
            FieldWord Word
w -> Word8 -> Ok Word8
forall a. a -> Ok a
Ok (Word -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
w)
            FieldHugeInt Integer
value
                | Integer
value Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 -> Field -> Integer -> Ok Word8
forall a.
(Integral a, Bounded a, Typeable a) =>
Field -> Integer -> Ok a
boundedFromInteger Field
f Integer
value
                | Bool
otherwise ->
                    (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Word8
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
ConversionFailed Field
f Text
"negative value cannot be converted to unsigned integer"
            FieldUHugeInt Integer
value -> Field -> Integer -> Ok Word8
forall a.
(Integral a, Bounded a, Typeable a) =>
Field -> Integer -> Ok a
boundedFromInteger Field
f Integer
value
            FieldEnum Word32
value -> Field -> Integer -> Ok Word8
forall a.
(Integral a, Bounded a, Typeable a) =>
Field -> Integer -> Ok a
boundedFromInteger Field
f (Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
value)
            FieldValue
FieldNull -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Word8
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
UnexpectedNull Field
f Text
""
            FieldValue
_ -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Word8
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
Incompatible Field
f Text
""

instance FromField Word where
    fromField :: FieldParser Word
fromField f :: Field
f@Field{FieldValue
fieldValue :: Field -> FieldValue
fieldValue :: FieldValue
fieldValue} =
        case FieldValue
fieldValue of
            FieldInt Int
i
                | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 -> Field -> Integer -> Ok Word
forall a.
(Integral a, Bounded a, Typeable a) =>
Field -> Integer -> Ok a
boundedFromInteger Field
f (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
                | Bool
otherwise ->
                    (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Word
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
ConversionFailed Field
f Text
"negative value cannot be converted to unsigned integer"
            FieldWord Word
w -> Word -> Ok Word
forall a. a -> Ok a
Ok Word
w
            FieldHugeInt Integer
value
                | Integer
value Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 -> Field -> Integer -> Ok Word
forall a.
(Integral a, Bounded a, Typeable a) =>
Field -> Integer -> Ok a
boundedFromInteger Field
f Integer
value
                | Bool
otherwise ->
                    (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Word
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
ConversionFailed Field
f Text
"negative value cannot be converted to unsigned integer"
            FieldUHugeInt Integer
value -> Field -> Integer -> Ok Word
forall a.
(Integral a, Bounded a, Typeable a) =>
Field -> Integer -> Ok a
boundedFromInteger Field
f Integer
value
            FieldEnum Word32
value -> Field -> Integer -> Ok Word
forall a.
(Integral a, Bounded a, Typeable a) =>
Field -> Integer -> Ok a
boundedFromInteger Field
f (Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
value)
            FieldValue
FieldNull -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Word
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
UnexpectedNull Field
f Text
""
            FieldValue
_ -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Word
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
Incompatible Field
f Text
""

instance FromField Double where
    fromField :: FieldParser Double
fromField f :: Field
f@Field{FieldValue
fieldValue :: Field -> FieldValue
fieldValue :: FieldValue
fieldValue} =
        case FieldValue
fieldValue of
            FieldDouble Double
d -> Double -> Ok Double
forall a. a -> Ok a
Ok Double
d
            FieldInt Int
i -> Double -> Ok Double
forall a. a -> Ok a
Ok (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
            FieldDecimal DecimalValue{Integer
decimalInteger :: DecimalValue -> Integer
decimalInteger :: Integer
decimalInteger, Word8
decimalScale :: DecimalValue -> Word8
decimalScale :: Word8
decimalScale} ->
                Double -> Ok Double
forall a. a -> Ok a
Ok (Integer -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Integer
decimalInteger Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
10 Double -> Word8 -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^ Word8
decimalScale)
            FieldValue
FieldNull -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Double
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
UnexpectedNull Field
f Text
""
            FieldValue
_ -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Double
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
Incompatible Field
f Text
""

instance FromField Float where
    fromField :: FieldParser Float
fromField Field
field =
        case (FieldParser Double
forall a. FromField a => FieldParser a
fromField Field
field :: Ok Double) of
            Errors [SomeException]
err -> [SomeException] -> Ok Float
forall a. [SomeException] -> Ok a
Errors [SomeException]
err
            Ok Double
d -> Float -> Ok Float
forall a. a -> Ok a
Ok (Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
d)

instance FromField Text where
    fromField :: FieldParser Text
fromField f :: Field
f@Field{FieldValue
fieldValue :: Field -> FieldValue
fieldValue :: FieldValue
fieldValue} =
        case FieldValue
fieldValue of
            FieldText Text
t -> Text -> Ok Text
forall a. a -> Ok a
Ok Text
t
            FieldInt Int
i -> Text -> Ok Text
forall a. a -> Ok a
Ok (String -> Text
Text.pack (Int -> String
forall a. Show a => a -> String
show Int
i))
            FieldDouble Double
d -> Text -> Ok Text
forall a. a -> Ok a
Ok (String -> Text
Text.pack (Double -> String
forall a. Show a => a -> String
show Double
d))
            FieldBool Bool
b -> Text -> Ok Text
forall a. a -> Ok a
Ok (if Bool
b then String -> Text
Text.pack String
"1" else String -> Text
Text.pack String
"0")
            FieldValue
FieldNull -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Text
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
UnexpectedNull Field
f Text
""
            FieldValue
_ -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Text
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
Incompatible Field
f Text
""

instance FromField String where
    fromField :: FieldParser String
fromField Field
field = Text -> String
Text.unpack (Text -> String) -> Ok Text -> Ok String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldParser Text
forall a. FromField a => FieldParser a
fromField Field
field

instance FromField BS.ByteString where
    fromField :: FieldParser ByteString
fromField f :: Field
f@Field{FieldValue
fieldValue :: Field -> FieldValue
fieldValue :: FieldValue
fieldValue} =
        case FieldValue
fieldValue of
            FieldBlob ByteString
bs -> ByteString -> Ok ByteString
forall a. a -> Ok a
Ok ByteString
bs
            FieldText Text
t -> ByteString -> Ok ByteString
forall a. a -> Ok a
Ok (Text -> ByteString
TextEncoding.encodeUtf8 Text
t)
            FieldBit (BitString Word8
_ ByteString
bits) -> ByteString -> Ok ByteString
forall a. a -> Ok a
Ok ByteString
bits
            FieldValue
FieldNull -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok ByteString
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
UnexpectedNull Field
f Text
""
            FieldValue
_ -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok ByteString
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
Incompatible Field
f Text
""

instance FromField BitString where
    fromField :: FieldParser BitString
fromField f :: Field
f@Field{FieldValue
fieldValue :: Field -> FieldValue
fieldValue :: FieldValue
fieldValue} =
        case FieldValue
fieldValue of
            FieldBit BitString
b -> BitString -> Ok BitString
forall a. a -> Ok a
Ok BitString
b
            FieldValue
FieldNull -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok BitString
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
UnexpectedNull Field
f Text
""
            FieldValue
_ -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok BitString
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
Incompatible Field
f Text
""

instance FromField BigNum where
    fromField :: FieldParser BigNum
fromField f :: Field
f@Field{FieldValue
fieldValue :: Field -> FieldValue
fieldValue :: FieldValue
fieldValue} =
        case FieldValue
fieldValue of
            FieldBigNum BigNum
big -> BigNum -> Ok BigNum
forall a. a -> Ok a
Ok BigNum
big
            FieldValue
FieldNull -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok BigNum
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
UnexpectedNull Field
f Text
""
            FieldValue
_ -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok BigNum
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
Incompatible Field
f Text
""

instance {-# OVERLAPPABLE #-} (Typeable a, FromField a) => FromField [a] where
    fromField :: FieldParser [a]
fromField f :: Field
f@Field{FieldValue
fieldValue :: Field -> FieldValue
fieldValue :: FieldValue
fieldValue} =
        case FieldValue
fieldValue of
            FieldList [FieldValue]
entries ->
                ((Int, FieldValue) -> Ok a) -> [(Int, FieldValue)] -> Ok [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Int -> FieldValue -> Ok a) -> (Int, FieldValue) -> Ok a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> FieldValue -> Ok a
forall {a} {p}. (FromField a, Show p) => p -> FieldValue -> Ok a
parseElement) ([Int] -> [FieldValue] -> [(Int, FieldValue)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] [FieldValue]
entries)
            FieldValue
FieldNull -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok [a]
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
UnexpectedNull Field
f Text
""
            FieldValue
_ -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok [a]
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
Incompatible Field
f Text
""
      where
        parseElement :: p -> FieldValue -> Ok a
parseElement p
idx FieldValue
value =
            FieldParser a
forall a. FromField a => FieldParser a
fromField
                Field
                    { fieldName :: Text
fieldName = p -> Text
forall {p}. Show p => p -> Text
fieldNameWithIndex p
idx
                    , fieldIndex :: Int
fieldIndex = Field -> Int
fieldIndex Field
f
                    , fieldValue :: FieldValue
fieldValue = FieldValue
value
                    }
        fieldNameWithIndex :: p -> Text
fieldNameWithIndex p
idx =
            let base :: Text
base = Field -> Text
fieldName Field
f
                idxText :: Text
idxText = String -> Text
Text.pack (p -> String
forall a. Show a => a -> String
show p
idx)
             in Text
base Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
idxText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
"]"

instance (Ord k, Typeable k, Typeable v, FromField k, FromField v) => FromField (Map k v) where
    fromField :: FieldParser (Map k v)
fromField f :: Field
f@Field{FieldValue
fieldValue :: Field -> FieldValue
fieldValue :: FieldValue
fieldValue} =
        case FieldValue
fieldValue of
            FieldMap [(FieldValue, FieldValue)]
pairs -> [(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(k, v)] -> Map k v) -> Ok [(k, v)] -> Ok (Map k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Int, (FieldValue, FieldValue)) -> Ok (k, v))
-> [(Int, (FieldValue, FieldValue))] -> Ok [(k, v)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Int -> (FieldValue, FieldValue) -> Ok (k, v))
-> (Int, (FieldValue, FieldValue)) -> Ok (k, v)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> (FieldValue, FieldValue) -> Ok (k, v)
forall {p} {a} {b}.
(Show p, FromField a, FromField b) =>
p -> (FieldValue, FieldValue) -> Ok (a, b)
parsePair) ([Int]
-> [(FieldValue, FieldValue)] -> [(Int, (FieldValue, FieldValue))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] [(FieldValue, FieldValue)]
pairs)
            FieldValue
FieldNull -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok (Map k v)
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
UnexpectedNull Field
f Text
""
            FieldValue
_ -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok (Map k v)
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
Incompatible Field
f Text
""
      where
        parsePair :: p -> (FieldValue, FieldValue) -> Ok (a, b)
parsePair p
idx (FieldValue
keyValue, FieldValue
valValue) = do
            a
key <-
                FieldParser a
forall a. FromField a => FieldParser a
fromField
                    Field
                        { fieldName :: Text
fieldName = Field -> Text
fieldName Field
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> p -> String -> Text
forall {p}. Show p => p -> String -> Text
suffix p
idx String
".key"
                        , fieldIndex :: Int
fieldIndex = Field -> Int
fieldIndex Field
f
                        , fieldValue :: FieldValue
fieldValue = FieldValue
keyValue
                        }
            b
value <-
                FieldParser b
forall a. FromField a => FieldParser a
fromField
                    Field
                        { fieldName :: Text
fieldName = Field -> Text
fieldName Field
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> p -> String -> Text
forall {p}. Show p => p -> String -> Text
suffix p
idx String
".value"
                        , fieldIndex :: Int
fieldIndex = Field -> Int
fieldIndex Field
f
                        , fieldValue :: FieldValue
fieldValue = FieldValue
valValue
                        }
            (a, b) -> Ok (a, b)
forall a. a -> Ok a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
key, b
value)
        suffix :: p -> String -> Text
suffix p
idx String
label =
            let idxText :: Text
idxText = String -> Text
Text.pack (p -> String
forall a. Show a => a -> String
show p
idx)
             in String -> Text
Text.pack String
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
idxText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
"]" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
label

instance FromField DecimalValue where
    fromField :: FieldParser DecimalValue
fromField f :: Field
f@Field{FieldValue
fieldValue :: Field -> FieldValue
fieldValue :: FieldValue
fieldValue} =
        case FieldValue
fieldValue of
            FieldDecimal DecimalValue
dec -> DecimalValue -> Ok DecimalValue
forall a. a -> Ok a
Ok DecimalValue
dec
            FieldValue
FieldNull -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok DecimalValue
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
UnexpectedNull Field
f Text
""
            FieldValue
_ -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok DecimalValue
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
Incompatible Field
f Text
""

instance FromField Day where
    fromField :: FieldParser Day
fromField f :: Field
f@Field{FieldValue
fieldValue :: Field -> FieldValue
fieldValue :: FieldValue
fieldValue} =
        case FieldValue
fieldValue of
            FieldDate Day
day -> Day -> Ok Day
forall a. a -> Ok a
Ok Day
day
            FieldTimestamp LocalTime{Day
localDay :: Day
localDay :: LocalTime -> Day
localDay} -> Day -> Ok Day
forall a. a -> Ok a
Ok Day
localDay
            FieldValue
FieldNull -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Day
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
UnexpectedNull Field
f Text
""
            FieldValue
_ -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok Day
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
Incompatible Field
f Text
""

instance FromField TimeOfDay where
    fromField :: FieldParser TimeOfDay
fromField f :: Field
f@Field{FieldValue
fieldValue :: Field -> FieldValue
fieldValue :: FieldValue
fieldValue} =
        case FieldValue
fieldValue of
            FieldTime TimeOfDay
tod -> TimeOfDay -> Ok TimeOfDay
forall a. a -> Ok a
Ok TimeOfDay
tod
            FieldTimestamp LocalTime{TimeOfDay
localTimeOfDay :: TimeOfDay
localTimeOfDay :: LocalTime -> TimeOfDay
localTimeOfDay} -> TimeOfDay -> Ok TimeOfDay
forall a. a -> Ok a
Ok TimeOfDay
localTimeOfDay
            FieldValue
FieldNull -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok TimeOfDay
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
UnexpectedNull Field
f Text
""
            FieldValue
_ -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok TimeOfDay
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
Incompatible Field
f Text
""

instance FromField TimeWithZone where
    fromField :: FieldParser TimeWithZone
fromField f :: Field
f@Field{FieldValue
fieldValue :: Field -> FieldValue
fieldValue :: FieldValue
fieldValue} =
        case FieldValue
fieldValue of
            FieldTimeTZ TimeWithZone
tz -> TimeWithZone -> Ok TimeWithZone
forall a. a -> Ok a
Ok TimeWithZone
tz
            FieldValue
FieldNull -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok TimeWithZone
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
UnexpectedNull Field
f Text
""
            FieldValue
_ -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok TimeWithZone
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
Incompatible Field
f Text
""

instance FromField LocalTime where
    fromField :: FieldParser LocalTime
fromField f :: Field
f@Field{FieldValue
fieldValue :: Field -> FieldValue
fieldValue :: FieldValue
fieldValue} =
        case FieldValue
fieldValue of
            FieldTimestamp LocalTime
ts -> LocalTime -> Ok LocalTime
forall a. a -> Ok a
Ok LocalTime
ts
            FieldDate Day
day -> LocalTime -> Ok LocalTime
forall a. a -> Ok a
Ok (Day -> TimeOfDay -> LocalTime
LocalTime Day
day TimeOfDay
midnight)
            FieldTimestampTZ UTCTime
utcTime -> LocalTime -> Ok LocalTime
forall a. a -> Ok a
Ok (TimeZone -> UTCTime -> LocalTime
utcToLocalTime TimeZone
utc UTCTime
utcTime)
            FieldValue
FieldNull -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok LocalTime
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
UnexpectedNull Field
f Text
""
            FieldValue
_ -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok LocalTime
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
Incompatible Field
f Text
""
      where
        midnight :: TimeOfDay
midnight = Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
0 Int
0 Pico
0

instance FromField IntervalValue where
    fromField :: FieldParser IntervalValue
fromField f :: Field
f@Field{FieldValue
fieldValue :: Field -> FieldValue
fieldValue :: FieldValue
fieldValue} =
        case FieldValue
fieldValue of
            FieldInterval IntervalValue
interval -> IntervalValue -> Ok IntervalValue
forall a. a -> Ok a
Ok IntervalValue
interval
            FieldValue
FieldNull -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok IntervalValue
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
UnexpectedNull Field
f Text
""
            FieldValue
_ -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok IntervalValue
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
Incompatible Field
f Text
""

instance FromField UTCTime where
    fromField :: FieldParser UTCTime
fromField f :: Field
f@Field{FieldValue
fieldValue :: Field -> FieldValue
fieldValue :: FieldValue
fieldValue} =
        case FieldValue
fieldValue of
            FieldTimestamp LocalTime
ts -> UTCTime -> Ok UTCTime
forall a. a -> Ok a
Ok (TimeZone -> LocalTime -> UTCTime
localTimeToUTC TimeZone
utc LocalTime
ts)
            FieldTimestampTZ UTCTime
utcTime -> UTCTime -> Ok UTCTime
forall a. a -> Ok a
Ok UTCTime
utcTime
            FieldDate Day
day -> UTCTime -> Ok UTCTime
forall a. a -> Ok a
Ok (TimeZone -> LocalTime -> UTCTime
localTimeToUTC TimeZone
utc (Day -> TimeOfDay -> LocalTime
LocalTime Day
day TimeOfDay
midnight))
            FieldValue
FieldNull -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok UTCTime
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
UnexpectedNull Field
f Text
""
            FieldValue
_ -> (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok UTCTime
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
Incompatible Field
f Text
""
      where
        midnight :: TimeOfDay
midnight = Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
0 Int
0 Pico
0

instance (FromField a) => FromField (Maybe a) where
    fromField :: FieldParser (Maybe a)
fromField Field{fieldValue :: Field -> FieldValue
fieldValue = FieldValue
FieldNull} = Maybe a -> Ok (Maybe a)
forall a. a -> Ok a
Ok Maybe a
forall a. Maybe a
Nothing
    fromField Field
field = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Ok a -> Ok (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldParser a
forall a. FromField a => FieldParser a
fromField Field
field

-- | Helper for bounded integral conversions.
boundedIntegral :: forall a. (Integral a, Bounded a, Typeable a) => Field -> Int -> Ok a
boundedIntegral :: forall a.
(Integral a, Bounded a, Typeable a) =>
Field -> Int -> Ok a
boundedIntegral f :: Field
f@Field{} Int
i
    | Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< a -> Integer
forall a. Integral a => a -> Integer
toInteger (a
forall a. Bounded a => a
minBound :: a) =
        (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok a
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
ConversionFailed Field
f Text
"integer value out of bounds"
    | Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> a -> Integer
forall a. Integral a => a -> Integer
toInteger (a
forall a. Bounded a => a
maxBound :: a) =
        (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok a
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
ConversionFailed Field
f Text
"integer value out of bounds"
    | Bool
otherwise = a -> Ok a
forall a. a -> Ok a
Ok (Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)

boundedFromInteger :: forall a. (Integral a, Bounded a, Typeable a) => Field -> Integer -> Ok a
boundedFromInteger :: forall a.
(Integral a, Bounded a, Typeable a) =>
Field -> Integer -> Ok a
boundedFromInteger f :: Field
f@Field{} Integer
value
    | Integer
value Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< a -> Integer
forall a. Integral a => a -> Integer
toInteger (a
forall a. Bounded a => a
minBound :: a) =
        (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok a
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
ConversionFailed Field
f Text
"integer value out of bounds"
    | Integer
value Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> a -> Integer
forall a. Integral a => a -> Integer
toInteger (a
forall a. Bounded a => a
maxBound :: a) =
        (Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok a
forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
ConversionFailed Field
f Text
"integer value out of bounds"
    | Bool
otherwise = a -> Ok a
forall a. a -> Ok a
Ok (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
value)

{- | Helper to construct a ResultError with field context.
based on postgresql-simple's implementation
-}
returnError :: forall b. (Typeable b) => (Text -> Text -> Text -> Text -> ResultError) -> Field -> Text -> Ok b
returnError :: forall b.
Typeable b =>
(Text -> Text -> Text -> Text -> ResultError)
-> Field -> Text -> Ok b
returnError Text -> Text -> Text -> Text -> ResultError
mkError Field{FieldValue
fieldValue :: Field -> FieldValue
fieldValue :: FieldValue
fieldValue, Text
fieldName :: Field -> Text
fieldName :: Text
fieldName} Text
msg =
    [SomeException] -> Ok b
forall a. [SomeException] -> Ok a
Errors
        [ ResultError -> SomeException
forall e. Exception e => e -> SomeException
SomeException (ResultError -> SomeException) -> ResultError -> SomeException
forall a b. (a -> b) -> a -> b
$
            Text -> Text -> Text -> Text -> ResultError
mkError
                (FieldValue -> Text
fieldValueTypeName FieldValue
fieldValue)
                Text
fieldName
                (String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ TypeRep -> String
forall a. Show a => a -> String
show (Proxy b -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy b
forall {k} (t :: k). Proxy t
Proxy :: Proxy b)))
                Text
msg
        ]

fieldValueTypeName :: FieldValue -> Text
fieldValueTypeName :: FieldValue -> Text
fieldValueTypeName = \case
    FieldValue
FieldNull -> Text
"NULL"
    FieldInt8{} -> Text
"INT1"
    FieldInt16{} -> Text
"INT2"
    FieldInt32{} -> Text
"INT4"
    FieldInt64{} -> Text
"INT8"
    FieldWord8{} -> Text
"UTINYINT"
    FieldWord16{} -> Text
"USMALLINT"
    FieldWord32{} -> Text
"UINTEGER"
    FieldWord64{} -> Text
"UBIGINT"
    FieldFloat{} -> Text
"FLOAT"
    FieldDouble{} -> Text
"DOUBLE"
    FieldText{} -> Text
"TEXT"
    FieldBool{} -> Text
"BOOLEAN"
    FieldBlob{} -> Text
"BLOB"
    FieldDate{} -> Text
"DATE"
    FieldTime{} -> Text
"TIME"
    FieldTimestamp{} -> Text
"TIMESTAMP"
    FieldInterval{} -> Text
"INTERVAL"
    FieldHugeInt{} -> Text
"HUGEINT"
    FieldUHugeInt{} -> Text
"UHUGEINT"
    FieldDecimal{} -> Text
"DECIMAL"
    FieldTimestampTZ{} -> Text
"TIMESTAMP_TZ"
    FieldTimeTZ{} -> Text
"TIME_TZ"
    FieldBit{} -> Text
"BIT"
    FieldBigNum{} -> Text
"BIGNUM"
    FieldEnum{} -> Text
"ENUM"
    FieldList{} -> Text
"LIST"
    FieldMap{} -> Text
"MAP"
    FieldUUID{} -> Text
"UUID"