{-# LANGUAGE GeneralizedNewtypeDeriving #-}

{- |
Copyright : Flipstone Technology Partners 2023
License   : MIT
Stability : Stable

@since 1.0.0.0
-}
module Orville.PostgreSQL.Execution.ExecutionResult
  ( ExecutionResult (..)
  , Column (..)
  , Row (..)
  , readRows
  , FakeLibPQResult
  , mkFakeLibPQResult
  )
where

import qualified Data.ByteString as BS
import qualified Data.Map.Strict as Map
import qualified Data.Maybe as Maybe
import qualified Database.PostgreSQL.LibPQ as LibPQ

import Orville.PostgreSQL.Raw.SqlValue (SqlValue)
import qualified Orville.PostgreSQL.Raw.SqlValue as SqlValue

{- |
  A trivial wrapper for `Int` to help keep track of column vs row number.

@since 1.0.0.0
-}
newtype Column
  = Column Int
  deriving
    ( -- | @since 1.0.0.0
      Column -> Column -> Bool
(Column -> Column -> Bool)
-> (Column -> Column -> Bool) -> Eq Column
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Column -> Column -> Bool
== :: Column -> Column -> Bool
$c/= :: Column -> Column -> Bool
/= :: Column -> Column -> Bool
Eq
    , -- | @since 1.0.0.0
      Eq Column
Eq Column
-> (Column -> Column -> Ordering)
-> (Column -> Column -> Bool)
-> (Column -> Column -> Bool)
-> (Column -> Column -> Bool)
-> (Column -> Column -> Bool)
-> (Column -> Column -> Column)
-> (Column -> Column -> Column)
-> Ord Column
Column -> Column -> Bool
Column -> Column -> Ordering
Column -> Column -> Column
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Column -> Column -> Ordering
compare :: Column -> Column -> Ordering
$c< :: Column -> Column -> Bool
< :: Column -> Column -> Bool
$c<= :: Column -> Column -> Bool
<= :: Column -> Column -> Bool
$c> :: Column -> Column -> Bool
> :: Column -> Column -> Bool
$c>= :: Column -> Column -> Bool
>= :: Column -> Column -> Bool
$cmax :: Column -> Column -> Column
max :: Column -> Column -> Column
$cmin :: Column -> Column -> Column
min :: Column -> Column -> Column
Ord
    , -- | @since 1.0.0.0
      Int -> Column
Column -> Int
Column -> [Column]
Column -> Column
Column -> Column -> [Column]
Column -> Column -> Column -> [Column]
(Column -> Column)
-> (Column -> Column)
-> (Int -> Column)
-> (Column -> Int)
-> (Column -> [Column])
-> (Column -> Column -> [Column])
-> (Column -> Column -> [Column])
-> (Column -> Column -> Column -> [Column])
-> Enum Column
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Column -> Column
succ :: Column -> Column
$cpred :: Column -> Column
pred :: Column -> Column
$ctoEnum :: Int -> Column
toEnum :: Int -> Column
$cfromEnum :: Column -> Int
fromEnum :: Column -> Int
$cenumFrom :: Column -> [Column]
enumFrom :: Column -> [Column]
$cenumFromThen :: Column -> Column -> [Column]
enumFromThen :: Column -> Column -> [Column]
$cenumFromTo :: Column -> Column -> [Column]
enumFromTo :: Column -> Column -> [Column]
$cenumFromThenTo :: Column -> Column -> Column -> [Column]
enumFromThenTo :: Column -> Column -> Column -> [Column]
Enum
    , -- | @since 1.0.0.0
      Integer -> Column
Column -> Column
Column -> Column -> Column
(Column -> Column -> Column)
-> (Column -> Column -> Column)
-> (Column -> Column -> Column)
-> (Column -> Column)
-> (Column -> Column)
-> (Column -> Column)
-> (Integer -> Column)
-> Num Column
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Column -> Column -> Column
+ :: Column -> Column -> Column
$c- :: Column -> Column -> Column
- :: Column -> Column -> Column
$c* :: Column -> Column -> Column
* :: Column -> Column -> Column
$cnegate :: Column -> Column
negate :: Column -> Column
$cabs :: Column -> Column
abs :: Column -> Column
$csignum :: Column -> Column
signum :: Column -> Column
$cfromInteger :: Integer -> Column
fromInteger :: Integer -> Column
Num
    )

{- |
  A trivial wrapper for `Int` to help keep track of column vs row number.

@since 1.0.0.0
-}
newtype Row
  = Row Int
  deriving
    ( -- | @since 1.0.0.0
      Row -> Row -> Bool
(Row -> Row -> Bool) -> (Row -> Row -> Bool) -> Eq Row
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Row -> Row -> Bool
== :: Row -> Row -> Bool
$c/= :: Row -> Row -> Bool
/= :: Row -> Row -> Bool
Eq
    , -- | @since 1.0.0.0
      Eq Row
Eq Row
-> (Row -> Row -> Ordering)
-> (Row -> Row -> Bool)
-> (Row -> Row -> Bool)
-> (Row -> Row -> Bool)
-> (Row -> Row -> Bool)
-> (Row -> Row -> Row)
-> (Row -> Row -> Row)
-> Ord Row
Row -> Row -> Bool
Row -> Row -> Ordering
Row -> Row -> Row
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Row -> Row -> Ordering
compare :: Row -> Row -> Ordering
$c< :: Row -> Row -> Bool
< :: Row -> Row -> Bool
$c<= :: Row -> Row -> Bool
<= :: Row -> Row -> Bool
$c> :: Row -> Row -> Bool
> :: Row -> Row -> Bool
$c>= :: Row -> Row -> Bool
>= :: Row -> Row -> Bool
$cmax :: Row -> Row -> Row
max :: Row -> Row -> Row
$cmin :: Row -> Row -> Row
min :: Row -> Row -> Row
Ord
    , -- | @since 1.0.0.0
      Int -> Row
Row -> Int
Row -> [Row]
Row -> Row
Row -> Row -> [Row]
Row -> Row -> Row -> [Row]
(Row -> Row)
-> (Row -> Row)
-> (Int -> Row)
-> (Row -> Int)
-> (Row -> [Row])
-> (Row -> Row -> [Row])
-> (Row -> Row -> [Row])
-> (Row -> Row -> Row -> [Row])
-> Enum Row
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Row -> Row
succ :: Row -> Row
$cpred :: Row -> Row
pred :: Row -> Row
$ctoEnum :: Int -> Row
toEnum :: Int -> Row
$cfromEnum :: Row -> Int
fromEnum :: Row -> Int
$cenumFrom :: Row -> [Row]
enumFrom :: Row -> [Row]
$cenumFromThen :: Row -> Row -> [Row]
enumFromThen :: Row -> Row -> [Row]
$cenumFromTo :: Row -> Row -> [Row]
enumFromTo :: Row -> Row -> [Row]
$cenumFromThenTo :: Row -> Row -> Row -> [Row]
enumFromThenTo :: Row -> Row -> Row -> [Row]
Enum
    , -- | @since 1.0.0.0
      Integer -> Row
Row -> Row
Row -> Row -> Row
(Row -> Row -> Row)
-> (Row -> Row -> Row)
-> (Row -> Row -> Row)
-> (Row -> Row)
-> (Row -> Row)
-> (Row -> Row)
-> (Integer -> Row)
-> Num Row
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Row -> Row -> Row
+ :: Row -> Row -> Row
$c- :: Row -> Row -> Row
- :: Row -> Row -> Row
$c* :: Row -> Row -> Row
* :: Row -> Row -> Row
$cnegate :: Row -> Row
negate :: Row -> Row
$cabs :: Row -> Row
abs :: Row -> Row
$csignum :: Row -> Row
signum :: Row -> Row
$cfromInteger :: Integer -> Row
fromInteger :: Integer -> Row
Num
    )

{- |
  'ExecutionResult' is a common interface for types that represent a result set
  returned from the database. For real, live database interactions, the
  concrete type will be a 'LibPQ.Result', but the 'FakeLibPQResult' may be
  useful as well if you are writing custom code for decoding result sets and
  want to test aspects of the decoding that don't require a real database.

@since 1.0.0.0
-}
class ExecutionResult result where
  maxRowNumber :: result -> IO (Maybe Row)
  maxColumnNumber :: result -> IO (Maybe Column)
  columnName :: result -> Column -> IO (Maybe BS.ByteString)
  getValue :: result -> Row -> Column -> IO SqlValue

{- |
  Reads the rows of an 'ExecutionResult' as a list of column name, 'SqlValue'
  pairs. You're almost always better off using a
  'Orville.PostgreSQL.SqlMarshaller' instead, but this function is provided for
  cases where you really want to decode the rows yourself but don't want to use
  the 'ExecutionResult' API to read each row of each column directly.

@since 1.0.0.0
-}
readRows ::
  ExecutionResult result =>
  result ->
  IO [[(Maybe BS.ByteString, SqlValue)]]
readRows :: forall result.
ExecutionResult result =>
result -> IO [[(Maybe ByteString, SqlValue)]]
readRows result
res = do
  Maybe Row
mbMaxRow <- result -> IO (Maybe Row)
forall result. ExecutionResult result => result -> IO (Maybe Row)
maxRowNumber result
res
  Maybe Column
mbMaxColumn <- result -> IO (Maybe Column)
forall result.
ExecutionResult result =>
result -> IO (Maybe Column)
maxColumnNumber result
res

  let
    rowIndices :: [Row]
rowIndices =
      case Maybe Row
mbMaxRow of
        Maybe Row
Nothing -> []
        Just Row
maxRow -> [Row
0 .. Row
maxRow]

    columnIndices :: [Column]
columnIndices =
      case Maybe Column
mbMaxColumn of
        Maybe Column
Nothing -> []
        Just Column
maxColumn -> [Column
0 .. Column
maxColumn]

    readValue :: Row -> Column -> IO (Maybe ByteString, SqlValue)
readValue Row
rowIndex Column
columnIndex = do
      Maybe ByteString
name <- result -> Column -> IO (Maybe ByteString)
forall result.
ExecutionResult result =>
result -> Column -> IO (Maybe ByteString)
columnName result
res Column
columnIndex
      SqlValue
value <- result -> Row -> Column -> IO SqlValue
forall result.
ExecutionResult result =>
result -> Row -> Column -> IO SqlValue
getValue result
res Row
rowIndex Column
columnIndex
      (Maybe ByteString, SqlValue) -> IO (Maybe ByteString, SqlValue)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Maybe ByteString, SqlValue) -> IO (Maybe ByteString, SqlValue))
-> (Maybe ByteString, SqlValue) -> IO (Maybe ByteString, SqlValue)
forall a b. (a -> b) -> a -> b
$ (Maybe ByteString
name, SqlValue
value)

    readRow :: Row -> IO [(Maybe ByteString, SqlValue)]
readRow Row
rowIndex =
      (Column -> IO (Maybe ByteString, SqlValue))
-> [Column] -> IO [(Maybe ByteString, SqlValue)]
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 (Row -> Column -> IO (Maybe ByteString, SqlValue)
readValue Row
rowIndex) [Column]
columnIndices

  (Row -> IO [(Maybe ByteString, SqlValue)])
-> [Row] -> IO [[(Maybe ByteString, SqlValue)]]
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 Row -> IO [(Maybe ByteString, SqlValue)]
readRow [Row]
rowIndices

-- | @since 1.0.0.0
instance ExecutionResult LibPQ.Result where
  maxRowNumber :: Result -> IO (Maybe Row)
maxRowNumber Result
result = do
    Int
rowCount <- (Row -> Int) -> IO Row -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Row -> Int
forall a. Enum a => a -> Int
fromEnum (Result -> IO Row
LibPQ.ntuples Result
result)
    Maybe Row -> IO (Maybe Row)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Row -> IO (Maybe Row)) -> Maybe Row -> IO (Maybe Row)
forall a b. (a -> b) -> a -> b
$
      if Int
rowCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
        then Row -> Maybe Row
forall a. a -> Maybe a
Just (Row -> Maybe Row) -> Row -> Maybe Row
forall a b. (a -> b) -> a -> b
$ Int -> Row
Row (Int
rowCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        else Maybe Row
forall a. Maybe a
Nothing

  maxColumnNumber :: Result -> IO (Maybe Column)
maxColumnNumber Result
result = do
    Int
columnCount <- (Column -> Int) -> IO Column -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Column -> Int
forall a. Enum a => a -> Int
fromEnum (Result -> IO Column
LibPQ.nfields Result
result)
    Maybe Column -> IO (Maybe Column)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Column -> IO (Maybe Column))
-> Maybe Column -> IO (Maybe Column)
forall a b. (a -> b) -> a -> b
$
      if Int
columnCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
        then Column -> Maybe Column
forall a. a -> Maybe a
Just (Column -> Maybe Column) -> Column -> Maybe Column
forall a b. (a -> b) -> a -> b
$ Int -> Column
Column (Int
columnCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        else Maybe Column
forall a. Maybe a
Nothing

  columnName :: Result -> Column -> IO (Maybe ByteString)
columnName Result
result =
    Result -> Column -> IO (Maybe ByteString)
LibPQ.fname Result
result (Column -> IO (Maybe ByteString))
-> (Column -> Column) -> Column -> IO (Maybe ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Column
forall a. Integral a => a -> Column
LibPQ.toColumn (Int -> Column) -> (Column -> Int) -> Column -> Column
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Column -> Int
forall a. Enum a => a -> Int
fromEnum

  getValue :: Result -> Row -> Column -> IO SqlValue
getValue Result
result (Row Int
row) (Column Int
column) =
    -- N.B. the usage of `getvalue'` here is important as this version returns a
    -- _copy_ of the data in the 'Result' rather than a _reference_.
    -- This allows the 'Result' to be garbage collected instead of being held onto indefinitely.
    Maybe ByteString -> SqlValue
SqlValue.fromRawBytesNullable
      (Maybe ByteString -> SqlValue)
-> IO (Maybe ByteString) -> IO SqlValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Result -> Row -> Column -> IO (Maybe ByteString)
LibPQ.getvalue' Result
result (Int -> Row
forall a. Integral a => a -> Row
LibPQ.toRow Int
row) (Int -> Column
forall a. Integral a => a -> Column
LibPQ.toColumn Int
column)

{- |
  `FakeLibPQResult` provides a fake, in-memory implementation of
  `ExecutionResult`.  This is mostly useful for writing automated tests that
  can assume a result set has been loaded and you just need to test decoding
  the results.

@since 1.0.0.0
-}
data FakeLibPQResult = FakeLibPQResult
  { FakeLibPQResult -> Map Column ByteString
fakeLibPQColumns :: Map.Map Column BS.ByteString
  , FakeLibPQResult -> Map Row (Map Column SqlValue)
fakeLibPQRows :: Map.Map Row (Map.Map Column SqlValue)
  }

-- | @since 1.0.0.0
instance ExecutionResult FakeLibPQResult where
  maxRowNumber :: FakeLibPQResult -> IO (Maybe Row)
maxRowNumber = Maybe Row -> IO (Maybe Row)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Row -> IO (Maybe Row))
-> (FakeLibPQResult -> Maybe Row)
-> FakeLibPQResult
-> IO (Maybe Row)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FakeLibPQResult -> Maybe Row
fakeLibPQMaxRow
  maxColumnNumber :: FakeLibPQResult -> IO (Maybe Column)
maxColumnNumber = Maybe Column -> IO (Maybe Column)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Column -> IO (Maybe Column))
-> (FakeLibPQResult -> Maybe Column)
-> FakeLibPQResult
-> IO (Maybe Column)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FakeLibPQResult -> Maybe Column
fakeLibPQMaxColumn
  columnName :: FakeLibPQResult -> Column -> IO (Maybe ByteString)
columnName FakeLibPQResult
result = Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ByteString -> IO (Maybe ByteString))
-> (Column -> Maybe ByteString) -> Column -> IO (Maybe ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FakeLibPQResult -> Column -> Maybe ByteString
fakeLibPQColumnName FakeLibPQResult
result
  getValue :: FakeLibPQResult -> Row -> Column -> IO SqlValue
getValue FakeLibPQResult
result Row
column = SqlValue -> IO SqlValue
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SqlValue -> IO SqlValue)
-> (Column -> SqlValue) -> Column -> IO SqlValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FakeLibPQResult -> Row -> Column -> SqlValue
fakeLibPQGetValue FakeLibPQResult
result Row
column

{- |
  Constructs a `FakeLibPQResult`. The column names given are associated with
  the values for each row by their position in-list. Any missing values (e.g.
  because a row is shorter than the header list) are treated as a SQL Null
  value.

@since 1.0.0.0
-}
mkFakeLibPQResult ::
  -- | The column names for the result set
  [BS.ByteString] ->
  -- | The row data for the result set
  [[SqlValue]] ->
  FakeLibPQResult
mkFakeLibPQResult :: [ByteString] -> [[SqlValue]] -> FakeLibPQResult
mkFakeLibPQResult [ByteString]
columnList [[SqlValue]]
valuesList =
  let
    indexedRows :: [(Row, Map Column SqlValue)]
indexedRows = do
      (Row
rowNumber, [SqlValue]
row) <- [Row] -> [[SqlValue]] -> [(Row, [SqlValue])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int -> Row
Row Int
0 ..] [[SqlValue]]
valuesList

      let
        indexedColumns :: [(Column, SqlValue)]
indexedColumns = [Column] -> [SqlValue] -> [(Column, SqlValue)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int -> Column
Column Int
0 ..] [SqlValue]
row

      (Row, Map Column SqlValue) -> [(Row, Map Column SqlValue)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Row
rowNumber, [(Column, SqlValue)] -> Map Column SqlValue
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Column, SqlValue)]
indexedColumns)
  in
    FakeLibPQResult
      { fakeLibPQColumns :: Map Column ByteString
fakeLibPQColumns = [(Column, ByteString)] -> Map Column ByteString
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([Column] -> [ByteString] -> [(Column, ByteString)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int -> Column
Column Int
0 ..] [ByteString]
columnList)
      , fakeLibPQRows :: Map Row (Map Column SqlValue)
fakeLibPQRows = [(Row, Map Column SqlValue)] -> Map Row (Map Column SqlValue)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Row, Map Column SqlValue)]
indexedRows
      }

fakeLibPQMaxRow :: FakeLibPQResult -> Maybe Row
fakeLibPQMaxRow :: FakeLibPQResult -> Maybe Row
fakeLibPQMaxRow =
  ((Row, Map Column SqlValue) -> Row)
-> Maybe (Row, Map Column SqlValue) -> Maybe Row
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Row, Map Column SqlValue) -> Row
forall a b. (a, b) -> a
fst (Maybe (Row, Map Column SqlValue) -> Maybe Row)
-> (FakeLibPQResult -> Maybe (Row, Map Column SqlValue))
-> FakeLibPQResult
-> Maybe Row
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Row (Map Column SqlValue) -> Maybe (Row, Map Column SqlValue)
forall k a. Map k a -> Maybe (k, a)
Map.lookupMax (Map Row (Map Column SqlValue) -> Maybe (Row, Map Column SqlValue))
-> (FakeLibPQResult -> Map Row (Map Column SqlValue))
-> FakeLibPQResult
-> Maybe (Row, Map Column SqlValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FakeLibPQResult -> Map Row (Map Column SqlValue)
fakeLibPQRows

fakeLibPQMaxColumn :: FakeLibPQResult -> Maybe Column
fakeLibPQMaxColumn :: FakeLibPQResult -> Maybe Column
fakeLibPQMaxColumn FakeLibPQResult
result =
  let
    maxColumnsByRow :: [Column]
maxColumnsByRow =
      ((Column, SqlValue) -> Column) -> [(Column, SqlValue)] -> [Column]
forall a b. (a -> b) -> [a] -> [b]
map (Column, SqlValue) -> Column
forall a b. (a, b) -> a
fst
        ([(Column, SqlValue)] -> [Column])
-> (FakeLibPQResult -> [(Column, SqlValue)])
-> FakeLibPQResult
-> [Column]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Column SqlValue -> Maybe (Column, SqlValue))
-> [Map Column SqlValue] -> [(Column, SqlValue)]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe Map Column SqlValue -> Maybe (Column, SqlValue)
forall k a. Map k a -> Maybe (k, a)
Map.lookupMax
        ([Map Column SqlValue] -> [(Column, SqlValue)])
-> (FakeLibPQResult -> [Map Column SqlValue])
-> FakeLibPQResult
-> [(Column, SqlValue)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Row (Map Column SqlValue) -> [Map Column SqlValue]
forall k a. Map k a -> [a]
Map.elems
        (Map Row (Map Column SqlValue) -> [Map Column SqlValue])
-> (FakeLibPQResult -> Map Row (Map Column SqlValue))
-> FakeLibPQResult
-> [Map Column SqlValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FakeLibPQResult -> Map Row (Map Column SqlValue)
fakeLibPQRows
        (FakeLibPQResult -> [Column]) -> FakeLibPQResult -> [Column]
forall a b. (a -> b) -> a -> b
$ FakeLibPQResult
result
  in
    case [Column]
maxColumnsByRow of
      [] ->
        Maybe Column
forall a. Maybe a
Nothing
      [Column]
_ ->
        Column -> Maybe Column
forall a. a -> Maybe a
Just ([Column] -> Column
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Column]
maxColumnsByRow)

fakeLibPQColumnName :: FakeLibPQResult -> Column -> (Maybe BS.ByteString)
fakeLibPQColumnName :: FakeLibPQResult -> Column -> Maybe ByteString
fakeLibPQColumnName FakeLibPQResult
result Column
column =
  Column -> Map Column ByteString -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Column
column (FakeLibPQResult -> Map Column ByteString
fakeLibPQColumns FakeLibPQResult
result)

fakeLibPQGetValue :: FakeLibPQResult -> Row -> Column -> SqlValue
fakeLibPQGetValue :: FakeLibPQResult -> Row -> Column -> SqlValue
fakeLibPQGetValue FakeLibPQResult
result Row
rowNumber Column
columnNumber =
  SqlValue -> Maybe SqlValue -> SqlValue
forall a. a -> Maybe a -> a
Maybe.fromMaybe SqlValue
SqlValue.sqlNull (Maybe SqlValue -> SqlValue) -> Maybe SqlValue -> SqlValue
forall a b. (a -> b) -> a -> b
$ do
    Map Column SqlValue
row <- Row -> Map Row (Map Column SqlValue) -> Maybe (Map Column SqlValue)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Row
rowNumber (FakeLibPQResult -> Map Row (Map Column SqlValue)
fakeLibPQRows FakeLibPQResult
result)
    Column -> Map Column SqlValue -> Maybe SqlValue
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Column
columnNumber Map Column SqlValue
row