module AirGQL.Types.SqlQueryPostResult (
  SqlQueryPostResult (..),
  resultWithErrors,
)
where

import Protolude (
  Generic,
  Show,
  Text,
  foldMap,
  fromMaybe,
  ($),
  (&),
  (<>),
 )

import Control.Arrow ((>>>))
import Data.Aeson (
  FromJSON,
  Object,
  ToJSON,
  Value (Null, Number),
 )
import Data.Aeson.Encoding (list, pair, pairs)
import Data.Aeson.Key qualified as Key
import Data.Aeson.KeyMap qualified as KeyMap
import Data.Aeson.Types (toEncoding, (.=))
import Data.Fixed (Pico)
import Servant.Docs (ToSample (toSamples), singleSample)


data SqlQueryPostResult = SqlQueryPostResult
  { SqlQueryPostResult -> [Text]
affectedTables :: [Text]
  , SqlQueryPostResult -> [Object]
rows :: [Object]
  , SqlQueryPostResult -> [Text]
columns :: [Text] -- Only necessary for order of columns in the result
  , SqlQueryPostResult -> Pico
runtimeSeconds :: Pico -- Precision contained by `NominalDiffTime`
  , SqlQueryPostResult -> [Text]
errors :: [Text]
  }
  deriving (Int -> SqlQueryPostResult -> ShowS
[SqlQueryPostResult] -> ShowS
SqlQueryPostResult -> String
(Int -> SqlQueryPostResult -> ShowS)
-> (SqlQueryPostResult -> String)
-> ([SqlQueryPostResult] -> ShowS)
-> Show SqlQueryPostResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SqlQueryPostResult -> ShowS
showsPrec :: Int -> SqlQueryPostResult -> ShowS
$cshow :: SqlQueryPostResult -> String
show :: SqlQueryPostResult -> String
$cshowList :: [SqlQueryPostResult] -> ShowS
showList :: [SqlQueryPostResult] -> ShowS
Show, (forall x. SqlQueryPostResult -> Rep SqlQueryPostResult x)
-> (forall x. Rep SqlQueryPostResult x -> SqlQueryPostResult)
-> Generic SqlQueryPostResult
forall x. Rep SqlQueryPostResult x -> SqlQueryPostResult
forall x. SqlQueryPostResult -> Rep SqlQueryPostResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SqlQueryPostResult -> Rep SqlQueryPostResult x
from :: forall x. SqlQueryPostResult -> Rep SqlQueryPostResult x
$cto :: forall x. Rep SqlQueryPostResult x -> SqlQueryPostResult
to :: forall x. Rep SqlQueryPostResult x -> SqlQueryPostResult
Generic)


instance FromJSON SqlQueryPostResult


{-| Even though JSON objects are unordered by definition,
the fields (columns) must be returned in the requested order
as Elm relies on it for decoding.
-}
instance ToJSON SqlQueryPostResult where
  toEncoding :: SqlQueryPostResult -> Encoding
toEncoding SqlQueryPostResult
sqlQueryPostResult =
    Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      Key
"affectedTables" Key -> [Text] -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Series
.= SqlQueryPostResult
sqlQueryPostResult.affectedTables
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"rows"
          Key -> Encoding -> Series
`pair` ( SqlQueryPostResult
sqlQueryPostResult.rows
                    [Object] -> ([Object] -> Encoding) -> Encoding
forall a b. a -> (a -> b) -> b
& (Object -> Encoding) -> [Object] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list
                      ( \(Object
row :: Object) ->
                          -- Apply order of columns
                          SqlQueryPostResult
sqlQueryPostResult.columns
                            [Text] -> ([Text] -> Series) -> Series
forall a b. a -> (a -> b) -> b
& (Text -> Series) -> [Text] -> Series
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
                              ( Text -> Key
Key.fromText
                                  (Text -> Key) -> (Key -> Series) -> Text -> Series
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ( \Key
col ->
                                          Key
col
                                            Key -> Value -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Series
.= ( Object
row
                                                  Object -> (Object -> Maybe Value) -> Maybe Value
forall a b. a -> (a -> b) -> b
& Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup Key
col
                                                  Maybe Value -> (Maybe Value -> Value) -> Value
forall a b. a -> (a -> b) -> b
& Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
Null
                                               )
                                      )
                              )
                            Series -> (Series -> Encoding) -> Encoding
forall a b. a -> (a -> b) -> b
& Series -> Encoding
pairs
                      )
                 )
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"runtimeSeconds" Key -> Pico -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Series
.= SqlQueryPostResult
sqlQueryPostResult.runtimeSeconds
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"errors" Key -> [Text] -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Series
.= SqlQueryPostResult
sqlQueryPostResult.errors


instance ToSample SqlQueryPostResult where
  toSamples :: Proxy SqlQueryPostResult -> [(Text, SqlQueryPostResult)]
toSamples Proxy SqlQueryPostResult
_ =
    SqlQueryPostResult -> [(Text, SqlQueryPostResult)]
forall a. a -> [(Text, a)]
singleSample (SqlQueryPostResult -> [(Text, SqlQueryPostResult)])
-> SqlQueryPostResult -> [(Text, SqlQueryPostResult)]
forall a b. (a -> b) -> a -> b
$
      SqlQueryPostResult
        { $sel:affectedTables:SqlQueryPostResult :: [Text]
affectedTables = [Text
"users"]
        , $sel:rows:SqlQueryPostResult :: [Object]
rows =
            [ [Pair] -> Object
forall v. [(Key, v)] -> KeyMap v
KeyMap.fromList
                [ (Text -> Key
Key.fromText Text
"id", Scientific -> Value
Number Scientific
1)
                , (Text -> Key
Key.fromText Text
"name", Value
"John")
                ]
            , [Pair] -> Object
forall v. [(Key, v)] -> KeyMap v
KeyMap.fromList
                [ (Text -> Key
Key.fromText Text
"id", Scientific -> Value
Number Scientific
2)
                , (Text -> Key
Key.fromText Text
"name", Value
"Jane")
                ]
            ]
        , $sel:columns:SqlQueryPostResult :: [Text]
columns = [Text
"id", Text
"name"]
        , $sel:runtimeSeconds:SqlQueryPostResult :: Pico
runtimeSeconds = Pico
0.05
        , $sel:errors:SqlQueryPostResult :: [Text]
errors = []
        }


-- | Construct a result for a failed sql query execution.
resultWithErrors :: Pico -> [Text] -> SqlQueryPostResult
resultWithErrors :: Pico -> [Text] -> SqlQueryPostResult
resultWithErrors Pico
runtimeSeconds [Text]
errors =
  SqlQueryPostResult
    { $sel:affectedTables:SqlQueryPostResult :: [Text]
affectedTables = []
    , $sel:rows:SqlQueryPostResult :: [Object]
rows = []
    , $sel:columns:SqlQueryPostResult :: [Text]
columns = []
    , $sel:runtimeSeconds:SqlQueryPostResult :: Pico
runtimeSeconds = Pico
runtimeSeconds
    , $sel:errors:SqlQueryPostResult :: [Text]
errors = [Text]
errors
    }