{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ExtendedDefaultRules #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}

-- | Execute a Select query against the BigQuery REST API.
module Hasura.Backends.BigQuery.Execute
  ( executeSelect,
    runExecute,
    streamBigQuery,
    executeBigQuery,
    executeProblemMessage,
    insertDataset,
    deleteDataset,
    BigQuery (..),
    Execute,
    ExecuteProblem (..),
    FieldNameText (..),
    Job (..),
    OutputValue (..),
    RecordSet (..),
    ShowDetails (..),
    Value (..),
  )
where

import Control.Applicative
import Control.Concurrent.Extended (sleep)
import Control.Monad.Except
import Control.Monad.Reader
import Data.Aeson ((.!=), (.:), (.:?), (.=))
import Data.Aeson qualified as J
import Data.Aeson.Types qualified as J
import Data.ByteString.Lazy qualified as BL
import Data.Foldable
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
import Data.Maybe
import Data.Text qualified as T
import Data.Text.Lazy qualified as LT
import Data.Text.Lazy.Builder qualified as LT
import Data.Text.Lazy.Encoding qualified as LT
import Data.Text.Read qualified as TR
import Data.Time
import Data.Time.Format.ISO8601 (iso8601Show)
import Data.Vector (Vector)
import Data.Vector qualified as V
import GHC.Generics
import Hasura.Backends.BigQuery.Connection
import Hasura.Backends.BigQuery.Source
import Hasura.Backends.BigQuery.ToQuery qualified as ToQuery
import Hasura.Backends.BigQuery.Types as BigQuery
import Hasura.Prelude hiding (head, state, tail)
import Network.HTTP.Simple
import Network.HTTP.Types

--------------------------------------------------------------------------------
-- Types

-- | A set of records produced by the database. These are joined
-- together. There are all sorts of optimizations possible here, from
-- using a matrix/flat vector, unboxed sums for Value, etc. Presently
-- we choose a naive implementation in the interest of getting other
-- work done.
data RecordSet = RecordSet
  { RecordSet -> Vector (InsOrdHashMap FieldNameText OutputValue)
rows :: Vector (InsOrdHashMap FieldNameText OutputValue),
    RecordSet -> Maybe [Text]
wantedFields :: Maybe [Text]
  }
  deriving (Int -> RecordSet -> ShowS
[RecordSet] -> ShowS
RecordSet -> String
(Int -> RecordSet -> ShowS)
-> (RecordSet -> String)
-> ([RecordSet] -> ShowS)
-> Show RecordSet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RecordSet -> ShowS
showsPrec :: Int -> RecordSet -> ShowS
$cshow :: RecordSet -> String
show :: RecordSet -> String
$cshowList :: [RecordSet] -> ShowS
showList :: [RecordSet] -> ShowS
Show)

-- | As opposed to BigQuery.FieldName which is a qualified name, this
-- is just the unqualified text name itself.
newtype FieldNameText
  = FieldNameText Text
  deriving (Int -> FieldNameText -> ShowS
[FieldNameText] -> ShowS
FieldNameText -> String
(Int -> FieldNameText -> ShowS)
-> (FieldNameText -> String)
-> ([FieldNameText] -> ShowS)
-> Show FieldNameText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FieldNameText -> ShowS
showsPrec :: Int -> FieldNameText -> ShowS
$cshow :: FieldNameText -> String
show :: FieldNameText -> String
$cshowList :: [FieldNameText] -> ShowS
showList :: [FieldNameText] -> ShowS
Show, Eq FieldNameText
Eq FieldNameText
-> (FieldNameText -> FieldNameText -> Ordering)
-> (FieldNameText -> FieldNameText -> Bool)
-> (FieldNameText -> FieldNameText -> Bool)
-> (FieldNameText -> FieldNameText -> Bool)
-> (FieldNameText -> FieldNameText -> Bool)
-> (FieldNameText -> FieldNameText -> FieldNameText)
-> (FieldNameText -> FieldNameText -> FieldNameText)
-> Ord FieldNameText
FieldNameText -> FieldNameText -> Bool
FieldNameText -> FieldNameText -> Ordering
FieldNameText -> FieldNameText -> FieldNameText
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 :: FieldNameText -> FieldNameText -> Ordering
compare :: FieldNameText -> FieldNameText -> Ordering
$c< :: FieldNameText -> FieldNameText -> Bool
< :: FieldNameText -> FieldNameText -> Bool
$c<= :: FieldNameText -> FieldNameText -> Bool
<= :: FieldNameText -> FieldNameText -> Bool
$c> :: FieldNameText -> FieldNameText -> Bool
> :: FieldNameText -> FieldNameText -> Bool
$c>= :: FieldNameText -> FieldNameText -> Bool
>= :: FieldNameText -> FieldNameText -> Bool
$cmax :: FieldNameText -> FieldNameText -> FieldNameText
max :: FieldNameText -> FieldNameText -> FieldNameText
$cmin :: FieldNameText -> FieldNameText -> FieldNameText
min :: FieldNameText -> FieldNameText -> FieldNameText
Ord, FieldNameText -> FieldNameText -> Bool
(FieldNameText -> FieldNameText -> Bool)
-> (FieldNameText -> FieldNameText -> Bool) -> Eq FieldNameText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FieldNameText -> FieldNameText -> Bool
== :: FieldNameText -> FieldNameText -> Bool
$c/= :: FieldNameText -> FieldNameText -> Bool
/= :: FieldNameText -> FieldNameText -> Bool
Eq, Eq FieldNameText
Eq FieldNameText
-> (Int -> FieldNameText -> Int)
-> (FieldNameText -> Int)
-> Hashable FieldNameText
Int -> FieldNameText -> Int
FieldNameText -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> FieldNameText -> Int
hashWithSalt :: Int -> FieldNameText -> Int
$chash :: FieldNameText -> Int
hash :: FieldNameText -> Int
Hashable, Value -> Parser [FieldNameText]
Value -> Parser FieldNameText
(Value -> Parser FieldNameText)
-> (Value -> Parser [FieldNameText]) -> FromJSON FieldNameText
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser FieldNameText
parseJSON :: Value -> Parser FieldNameText
$cparseJSONList :: Value -> Parser [FieldNameText]
parseJSONList :: Value -> Parser [FieldNameText]
J.FromJSON, ToJSONKeyFunction [FieldNameText]
ToJSONKeyFunction FieldNameText
ToJSONKeyFunction FieldNameText
-> ToJSONKeyFunction [FieldNameText] -> ToJSONKey FieldNameText
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction FieldNameText
toJSONKey :: ToJSONKeyFunction FieldNameText
$ctoJSONKeyList :: ToJSONKeyFunction [FieldNameText]
toJSONKeyList :: ToJSONKeyFunction [FieldNameText]
J.ToJSONKey, String -> FieldNameText
(String -> FieldNameText) -> IsString FieldNameText
forall a. (String -> a) -> IsString a
$cfromString :: String -> FieldNameText
fromString :: String -> FieldNameText
IsString)

data OutputValue
  = DecimalOutputValue Decimal
  | BigDecimalOutputValue BigDecimal
  | IntegerOutputValue Int64
  | FloatOutputValue Float64
  | GeographyOutputValue Geography
  | TextOutputValue Text
  | TimestampOutputValue Timestamp
  | DateOutputValue Date
  | TimeOutputValue Time
  | DatetimeOutputValue Datetime
  | BytesOutputValue Base64
  | BoolOutputValue Bool
  | ArrayOutputValue (Vector OutputValue)
  | RecordOutputValue (InsOrdHashMap FieldNameText OutputValue)
  | JsonOutputValue J.Value
  | NullOutputValue -- TODO: Consider implications.
  deriving (Int -> OutputValue -> ShowS
[OutputValue] -> ShowS
OutputValue -> String
(Int -> OutputValue -> ShowS)
-> (OutputValue -> String)
-> ([OutputValue] -> ShowS)
-> Show OutputValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OutputValue -> ShowS
showsPrec :: Int -> OutputValue -> ShowS
$cshow :: OutputValue -> String
show :: OutputValue -> String
$cshowList :: [OutputValue] -> ShowS
showList :: [OutputValue] -> ShowS
Show, OutputValue -> OutputValue -> Bool
(OutputValue -> OutputValue -> Bool)
-> (OutputValue -> OutputValue -> Bool) -> Eq OutputValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OutputValue -> OutputValue -> Bool
== :: OutputValue -> OutputValue -> Bool
$c/= :: OutputValue -> OutputValue -> Bool
/= :: OutputValue -> OutputValue -> Bool
Eq, (forall x. OutputValue -> Rep OutputValue x)
-> (forall x. Rep OutputValue x -> OutputValue)
-> Generic OutputValue
forall x. Rep OutputValue x -> OutputValue
forall x. OutputValue -> Rep OutputValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OutputValue -> Rep OutputValue x
from :: forall x. OutputValue -> Rep OutputValue x
$cto :: forall x. Rep OutputValue x -> OutputValue
to :: forall x. Rep OutputValue x -> OutputValue
Generic)

instance Hashable OutputValue

instance J.ToJSON OutputValue where
  toJSON :: OutputValue -> Value
toJSON = \case
    OutputValue
NullOutputValue -> Value -> Value
forall a. ToJSON a => a -> Value
J.toJSON Value
J.Null
    DecimalOutputValue Decimal
i -> Decimal -> Value
forall a. ToJSON a => a -> Value
J.toJSON Decimal
i
    BigDecimalOutputValue BigDecimal
i -> BigDecimal -> Value
forall a. ToJSON a => a -> Value
J.toJSON BigDecimal
i
    FloatOutputValue Float64
i -> Float64 -> Value
forall a. ToJSON a => a -> Value
J.toJSON Float64
i
    TextOutputValue Text
i -> Text -> Value
forall a. ToJSON a => a -> Value
J.toJSON Text
i
    BytesOutputValue Base64
i -> Base64 -> Value
forall a. ToJSON a => a -> Value
J.toJSON Base64
i
    DateOutputValue Date
i -> Date -> Value
forall a. ToJSON a => a -> Value
J.toJSON Date
i
    TimestampOutputValue Timestamp
i -> Timestamp -> Value
forall a. ToJSON a => a -> Value
J.toJSON Timestamp
i
    TimeOutputValue Time
i -> Time -> Value
forall a. ToJSON a => a -> Value
J.toJSON Time
i
    DatetimeOutputValue Datetime
i -> Datetime -> Value
forall a. ToJSON a => a -> Value
J.toJSON Datetime
i
    GeographyOutputValue Geography
i -> Geography -> Value
forall a. ToJSON a => a -> Value
J.toJSON Geography
i
    BoolOutputValue Bool
i -> Bool -> Value
forall a. ToJSON a => a -> Value
J.toJSON Bool
i
    IntegerOutputValue Int64
i -> Int64 -> Value
forall a. ToJSON a => a -> Value
J.toJSON Int64
i
    ArrayOutputValue Vector OutputValue
vector -> Vector OutputValue -> Value
forall a. ToJSON a => a -> Value
J.toJSON Vector OutputValue
vector
    JsonOutputValue Value
value -> Value
value
    RecordOutputValue InsOrdHashMap FieldNameText OutputValue
record -> InsOrdHashMap FieldNameText OutputValue -> Value
forall a. ToJSON a => a -> Value
J.toJSON InsOrdHashMap FieldNameText OutputValue
record

data ExecuteReader = ExecuteReader
  { ExecuteReader -> BigQuerySourceConfig
sourceConfig :: BigQuerySourceConfig
  }

data ExecuteProblem
  = GetJobDecodeProblem String
  | CreateQueryJobDecodeProblem String
  | InsertDatasetDecodeProblem String
  | ExecuteRunBigQueryProblem BigQueryProblem
  | RESTRequestNonOK Status J.Value
  deriving ((forall x. ExecuteProblem -> Rep ExecuteProblem x)
-> (forall x. Rep ExecuteProblem x -> ExecuteProblem)
-> Generic ExecuteProblem
forall x. Rep ExecuteProblem x -> ExecuteProblem
forall x. ExecuteProblem -> Rep ExecuteProblem x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExecuteProblem -> Rep ExecuteProblem x
from :: forall x. ExecuteProblem -> Rep ExecuteProblem x
$cto :: forall x. Rep ExecuteProblem x -> ExecuteProblem
to :: forall x. Rep ExecuteProblem x -> ExecuteProblem
Generic)

-- | We use this to hide certain details from the front-end, while allowing
-- them in tests. We have not actually decided whether showing the details is
-- insecure, but until we decide otherwise, it's probably best to err on the side
-- of caution.
data ShowDetails = HideDetails | InsecurelyShowDetails

instance J.ToJSON ExecuteProblem where
  toJSON :: ExecuteProblem -> Value
toJSON =
    [Pair] -> Value
J.object ([Pair] -> Value)
-> (ExecuteProblem -> [Pair]) -> ExecuteProblem -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      GetJobDecodeProblem String
err -> [Key
"get_job_decode_problem" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= String
err]
      CreateQueryJobDecodeProblem String
err -> [Key
"create_query_job_decode_problem" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= String
err]
      ExecuteRunBigQueryProblem BigQueryProblem
problem -> [Key
"execute_run_bigquery_problem" Key -> BigQueryProblem -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= BigQueryProblem
problem]
      InsertDatasetDecodeProblem String
problem -> [Key
"insert_dataset__bigquery_problem" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= String
problem]
      RESTRequestNonOK Status
_ Value
resp -> [Key
"rest_request_non_ok" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= Value
resp]

executeProblemMessage :: ShowDetails -> ExecuteProblem -> Text
executeProblemMessage :: ShowDetails -> ExecuteProblem -> Text
executeProblemMessage ShowDetails
showDetails = \case
  GetJobDecodeProblem String
err -> Text
"Fetching BigQuery job status, cannot decode HTTP response; " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. Show a => a -> Text
tshow String
err
  CreateQueryJobDecodeProblem String
err -> Text
"Creating BigQuery job, cannot decode HTTP response: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. Show a => a -> Text
tshow String
err
  ExecuteRunBigQueryProblem BigQueryProblem
err ->
    Text
"Cannot execute BigQuery request" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BigQueryProblem -> Text
forall a. Show a => a -> Text
showErr BigQueryProblem
err
  InsertDatasetDecodeProblem String
err ->
    Text
"Cannot create BigQuery dataset" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. Show a => a -> Text
showErr String
err
  RESTRequestNonOK Status
status Value
body ->
    let summary :: Text
summary = Text
"BigQuery HTTP request failed with status " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow (Status -> Int
statusCode Status
status) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
forall a. Show a => a -> Text
tshow (Status -> ByteString
statusMessage Status
status)
     in case ShowDetails
showDetails of
          ShowDetails
HideDetails -> Text
summary
          ShowDetails
InsecurelyShowDetails -> Text
summary Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" and body:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
LT.toStrict (ByteString -> Text
LT.decodeUtf8 (Value -> ByteString
forall a. ToJSON a => a -> ByteString
J.encode Value
body))
  where
    showErr :: forall a. (Show a) => a -> Text
    showErr :: forall a. Show a => a -> Text
showErr a
err =
      case ShowDetails
showDetails of
        ShowDetails
HideDetails -> Text
""
        ShowDetails
InsecurelyShowDetails -> Text
":\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. Show a => a -> Text
tshow a
err

-- | Execute monad; as queries are performed, the record sets are
-- stored in the map.
newtype Execute a = Execute
  { forall a.
Execute a -> ReaderT ExecuteReader (ExceptT ExecuteProblem IO) a
unExecute :: ReaderT ExecuteReader (ExceptT ExecuteProblem IO) a
  }
  deriving
    ( (forall a b. (a -> b) -> Execute a -> Execute b)
-> (forall a b. a -> Execute b -> Execute a) -> Functor Execute
forall a b. a -> Execute b -> Execute a
forall a b. (a -> b) -> Execute a -> Execute b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Execute a -> Execute b
fmap :: forall a b. (a -> b) -> Execute a -> Execute b
$c<$ :: forall a b. a -> Execute b -> Execute a
<$ :: forall a b. a -> Execute b -> Execute a
Functor,
      Functor Execute
Functor Execute
-> (forall a. a -> Execute a)
-> (forall a b. Execute (a -> b) -> Execute a -> Execute b)
-> (forall a b c.
    (a -> b -> c) -> Execute a -> Execute b -> Execute c)
-> (forall a b. Execute a -> Execute b -> Execute b)
-> (forall a b. Execute a -> Execute b -> Execute a)
-> Applicative Execute
forall a. a -> Execute a
forall a b. Execute a -> Execute b -> Execute a
forall a b. Execute a -> Execute b -> Execute b
forall a b. Execute (a -> b) -> Execute a -> Execute b
forall a b c. (a -> b -> c) -> Execute a -> Execute b -> Execute c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> Execute a
pure :: forall a. a -> Execute a
$c<*> :: forall a b. Execute (a -> b) -> Execute a -> Execute b
<*> :: forall a b. Execute (a -> b) -> Execute a -> Execute b
$cliftA2 :: forall a b c. (a -> b -> c) -> Execute a -> Execute b -> Execute c
liftA2 :: forall a b c. (a -> b -> c) -> Execute a -> Execute b -> Execute c
$c*> :: forall a b. Execute a -> Execute b -> Execute b
*> :: forall a b. Execute a -> Execute b -> Execute b
$c<* :: forall a b. Execute a -> Execute b -> Execute a
<* :: forall a b. Execute a -> Execute b -> Execute a
Applicative,
      Applicative Execute
Applicative Execute
-> (forall a b. Execute a -> (a -> Execute b) -> Execute b)
-> (forall a b. Execute a -> Execute b -> Execute b)
-> (forall a. a -> Execute a)
-> Monad Execute
forall a. a -> Execute a
forall a b. Execute a -> Execute b -> Execute b
forall a b. Execute a -> (a -> Execute b) -> Execute b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. Execute a -> (a -> Execute b) -> Execute b
>>= :: forall a b. Execute a -> (a -> Execute b) -> Execute b
$c>> :: forall a b. Execute a -> Execute b -> Execute b
>> :: forall a b. Execute a -> Execute b -> Execute b
$creturn :: forall a. a -> Execute a
return :: forall a. a -> Execute a
Monad,
      MonadReader ExecuteReader,
      Monad Execute
Monad Execute -> (forall a. IO a -> Execute a) -> MonadIO Execute
forall a. IO a -> Execute a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> Execute a
liftIO :: forall a. IO a -> Execute a
MonadIO,
      MonadError ExecuteProblem
    )

data BigQuery = BigQuery
  { BigQuery -> Text
query :: LT.Text,
    BigQuery -> InsOrdHashMap ParameterName Parameter
parameters :: InsOrdHashMap ParameterName Parameter
  }
  deriving (Int -> BigQuery -> ShowS
[BigQuery] -> ShowS
BigQuery -> String
(Int -> BigQuery -> ShowS)
-> (BigQuery -> String) -> ([BigQuery] -> ShowS) -> Show BigQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BigQuery -> ShowS
showsPrec :: Int -> BigQuery -> ShowS
$cshow :: BigQuery -> String
show :: BigQuery -> String
$cshowList :: [BigQuery] -> ShowS
showList :: [BigQuery] -> ShowS
Show)

data Parameter = Parameter
  { Parameter -> ScalarType
typ :: ScalarType,
    Parameter -> Value
value :: Value
  }
  deriving (Int -> Parameter -> ShowS
[Parameter] -> ShowS
Parameter -> String
(Int -> Parameter -> ShowS)
-> (Parameter -> String)
-> ([Parameter] -> ShowS)
-> Show Parameter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Parameter -> ShowS
showsPrec :: Int -> Parameter -> ShowS
$cshow :: Parameter -> String
show :: Parameter -> String
$cshowList :: [Parameter] -> ShowS
showList :: [Parameter] -> ShowS
Show)

newtype ParameterName
  = ParameterName LT.Text
  deriving (Int -> ParameterName -> ShowS
[ParameterName] -> ShowS
ParameterName -> String
(Int -> ParameterName -> ShowS)
-> (ParameterName -> String)
-> ([ParameterName] -> ShowS)
-> Show ParameterName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParameterName -> ShowS
showsPrec :: Int -> ParameterName -> ShowS
$cshow :: ParameterName -> String
show :: ParameterName -> String
$cshowList :: [ParameterName] -> ShowS
showList :: [ParameterName] -> ShowS
Show, [ParameterName] -> Value
[ParameterName] -> Encoding
ParameterName -> Value
ParameterName -> Encoding
(ParameterName -> Value)
-> (ParameterName -> Encoding)
-> ([ParameterName] -> Value)
-> ([ParameterName] -> Encoding)
-> ToJSON ParameterName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ParameterName -> Value
toJSON :: ParameterName -> Value
$ctoEncoding :: ParameterName -> Encoding
toEncoding :: ParameterName -> Encoding
$ctoJSONList :: [ParameterName] -> Value
toJSONList :: [ParameterName] -> Value
$ctoEncodingList :: [ParameterName] -> Encoding
toEncodingList :: [ParameterName] -> Encoding
J.ToJSON, Eq ParameterName
Eq ParameterName
-> (ParameterName -> ParameterName -> Ordering)
-> (ParameterName -> ParameterName -> Bool)
-> (ParameterName -> ParameterName -> Bool)
-> (ParameterName -> ParameterName -> Bool)
-> (ParameterName -> ParameterName -> Bool)
-> (ParameterName -> ParameterName -> ParameterName)
-> (ParameterName -> ParameterName -> ParameterName)
-> Ord ParameterName
ParameterName -> ParameterName -> Bool
ParameterName -> ParameterName -> Ordering
ParameterName -> ParameterName -> ParameterName
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 :: ParameterName -> ParameterName -> Ordering
compare :: ParameterName -> ParameterName -> Ordering
$c< :: ParameterName -> ParameterName -> Bool
< :: ParameterName -> ParameterName -> Bool
$c<= :: ParameterName -> ParameterName -> Bool
<= :: ParameterName -> ParameterName -> Bool
$c> :: ParameterName -> ParameterName -> Bool
> :: ParameterName -> ParameterName -> Bool
$c>= :: ParameterName -> ParameterName -> Bool
>= :: ParameterName -> ParameterName -> Bool
$cmax :: ParameterName -> ParameterName -> ParameterName
max :: ParameterName -> ParameterName -> ParameterName
$cmin :: ParameterName -> ParameterName -> ParameterName
min :: ParameterName -> ParameterName -> ParameterName
Ord, ParameterName -> ParameterName -> Bool
(ParameterName -> ParameterName -> Bool)
-> (ParameterName -> ParameterName -> Bool) -> Eq ParameterName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParameterName -> ParameterName -> Bool
== :: ParameterName -> ParameterName -> Bool
$c/= :: ParameterName -> ParameterName -> Bool
/= :: ParameterName -> ParameterName -> Bool
Eq, Eq ParameterName
Eq ParameterName
-> (Int -> ParameterName -> Int)
-> (ParameterName -> Int)
-> Hashable ParameterName
Int -> ParameterName -> Int
ParameterName -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> ParameterName -> Int
hashWithSalt :: Int -> ParameterName -> Int
$chash :: ParameterName -> Int
hash :: ParameterName -> Int
Hashable)

data BigQueryField = BigQueryField
  { BigQueryField -> FieldNameText
name :: FieldNameText,
    BigQueryField -> BigQueryFieldType
typ :: BigQueryFieldType,
    BigQueryField -> Mode
mode :: Mode
  }
  deriving (Int -> BigQueryField -> ShowS
[BigQueryField] -> ShowS
BigQueryField -> String
(Int -> BigQueryField -> ShowS)
-> (BigQueryField -> String)
-> ([BigQueryField] -> ShowS)
-> Show BigQueryField
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BigQueryField -> ShowS
showsPrec :: Int -> BigQueryField -> ShowS
$cshow :: BigQueryField -> String
show :: BigQueryField -> String
$cshowList :: [BigQueryField] -> ShowS
showList :: [BigQueryField] -> ShowS
Show)

data BigQueryFieldType
  = FieldSTRING
  | FieldBYTES
  | FieldINTEGER
  | FieldFLOAT
  | FieldBOOL
  | FieldTIMESTAMP
  | FieldDATE
  | FieldTIME
  | FieldDATETIME
  | FieldGEOGRAPHY
  | FieldDECIMAL
  | FieldBIGDECIMAL
  | FieldJSON
  | FieldSTRUCT (Vector BigQueryField)
  deriving (Int -> BigQueryFieldType -> ShowS
[BigQueryFieldType] -> ShowS
BigQueryFieldType -> String
(Int -> BigQueryFieldType -> ShowS)
-> (BigQueryFieldType -> String)
-> ([BigQueryFieldType] -> ShowS)
-> Show BigQueryFieldType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BigQueryFieldType -> ShowS
showsPrec :: Int -> BigQueryFieldType -> ShowS
$cshow :: BigQueryFieldType -> String
show :: BigQueryFieldType -> String
$cshowList :: [BigQueryFieldType] -> ShowS
showList :: [BigQueryFieldType] -> ShowS
Show)

data Mode
  = Nullable
  | NotNullable
  | Repeated
  deriving (Int -> Mode -> ShowS
[Mode] -> ShowS
Mode -> String
(Int -> Mode -> ShowS)
-> (Mode -> String) -> ([Mode] -> ShowS) -> Show Mode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Mode -> ShowS
showsPrec :: Int -> Mode -> ShowS
$cshow :: Mode -> String
show :: Mode -> String
$cshowList :: [Mode] -> ShowS
showList :: [Mode] -> ShowS
Show)

data IsNullable
  = IsNullable
  | IsRequired

--------------------------------------------------------------------------------
-- Constants

-- | Delay between attempts to get job results if the job is incomplete.
streamDelaySeconds :: DiffTime
streamDelaySeconds :: DiffTime
streamDelaySeconds = DiffTime
1

bigQueryProjectUrl :: Text -> String
bigQueryProjectUrl :: Text -> String
bigQueryProjectUrl Text
projectId =
  String
"https://bigquery.googleapis.com/bigquery/v2/projects/" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
projectId

--------------------------------------------------------------------------------
-- Executing the planned actions forest

runExecute ::
  (MonadIO m) =>
  BigQuerySourceConfig ->
  Execute (BigQuery.Job, RecordSet) ->
  m (Either ExecuteProblem (BigQuery.Job, RecordSet))
runExecute :: forall (m :: * -> *).
MonadIO m =>
BigQuerySourceConfig
-> Execute (Job, RecordSet)
-> m (Either ExecuteProblem (Job, RecordSet))
runExecute BigQuerySourceConfig
sourceConfig Execute (Job, RecordSet)
m =
  IO (Either ExecuteProblem (Job, RecordSet))
-> m (Either ExecuteProblem (Job, RecordSet))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
    ( ExceptT ExecuteProblem IO (Job, RecordSet)
-> IO (Either ExecuteProblem (Job, RecordSet))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
        ( ReaderT ExecuteReader (ExceptT ExecuteProblem IO) (Job, RecordSet)
-> ExecuteReader -> ExceptT ExecuteProblem IO (Job, RecordSet)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT
            (Execute (Job, RecordSet)
-> ReaderT
     ExecuteReader (ExceptT ExecuteProblem IO) (Job, RecordSet)
forall a.
Execute a -> ReaderT ExecuteReader (ExceptT ExecuteProblem IO) a
unExecute (Execute (Job, RecordSet)
m Execute (Job, RecordSet)
-> ((Job, RecordSet) -> Execute (Job, RecordSet))
-> Execute (Job, RecordSet)
forall a b. Execute a -> (a -> Execute b) -> Execute b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (RecordSet -> Execute RecordSet)
-> (Job, RecordSet) -> Execute (Job, RecordSet)
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) -> (Job, a) -> f (Job, b)
traverse RecordSet -> Execute RecordSet
getFinalRecordSet))
            (ExecuteReader {BigQuerySourceConfig
$sel:sourceConfig:ExecuteReader :: BigQuerySourceConfig
sourceConfig :: BigQuerySourceConfig
sourceConfig})
        )
    )

executeSelect :: Select -> Execute (BigQuery.Job, RecordSet)
executeSelect :: Select -> Execute (Job, RecordSet)
executeSelect Select
select = do
  BigQueryConnection
conn <- (ExecuteReader -> BigQueryConnection) -> Execute BigQueryConnection
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (BigQuerySourceConfig -> BigQueryConnection
_scConnection (BigQuerySourceConfig -> BigQueryConnection)
-> (ExecuteReader -> BigQuerySourceConfig)
-> ExecuteReader
-> BigQueryConnection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExecuteReader -> BigQuerySourceConfig
sourceConfig)
  (Job
job, RecordSet
recordSet) <-
    BigQueryConnection
-> BigQuery -> Execute (Either ExecuteProblem (Job, RecordSet))
forall (m :: * -> *).
MonadIO m =>
BigQueryConnection
-> BigQuery -> m (Either ExecuteProblem (Job, RecordSet))
streamBigQuery BigQueryConnection
conn (Select -> BigQuery
selectToBigQuery Select
select) Execute (Either ExecuteProblem (Job, RecordSet))
-> (Either ExecuteProblem (Job, RecordSet)
    -> Execute (Job, RecordSet))
-> Execute (Job, RecordSet)
forall a b. Execute a -> (a -> Execute b) -> Execute b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either ExecuteProblem (Job, RecordSet) -> Execute (Job, RecordSet)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither
  (Job, RecordSet) -> Execute (Job, RecordSet)
forall a. a -> Execute a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Job
job, RecordSet
recordSet {$sel:wantedFields:RecordSet :: Maybe [Text]
wantedFields = Select -> Maybe [Text]
selectFinalWantedFields Select
select})

-- | This is needed to strip out unneeded fields (join keys) in the
-- final query.  This is a relic of the data loader approach. A later
-- improvement would be to update the FromIr code to explicitly
-- reselect the query. But the purpose of this commit is to drop the
-- dataloader code and not modify the from IR code which is more
-- delicate.
getFinalRecordSet :: RecordSet -> Execute RecordSet
getFinalRecordSet :: RecordSet -> Execute RecordSet
getFinalRecordSet RecordSet
recordSet =
  RecordSet -> Execute RecordSet
forall a. a -> Execute a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    RecordSet
recordSet
      { $sel:rows:RecordSet :: Vector (InsOrdHashMap FieldNameText OutputValue)
rows =
          (InsOrdHashMap FieldNameText OutputValue
 -> InsOrdHashMap FieldNameText OutputValue)
-> Vector (InsOrdHashMap FieldNameText OutputValue)
-> Vector (InsOrdHashMap FieldNameText OutputValue)
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
            ( (FieldNameText -> OutputValue -> Bool)
-> InsOrdHashMap FieldNameText OutputValue
-> InsOrdHashMap FieldNameText OutputValue
forall k v.
(k -> v -> Bool) -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.filterWithKey
                ( \(FieldNameText Text
k) OutputValue
_ ->
                    ([Text] -> Bool) -> Maybe [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Text
k) (RecordSet -> Maybe [Text]
wantedFields RecordSet
recordSet)
                )
            )
            (RecordSet -> Vector (InsOrdHashMap FieldNameText OutputValue)
rows RecordSet
recordSet)
      }

--------------------------------------------------------------------------------
-- Make a big query from a select

selectToBigQuery :: Select -> BigQuery
selectToBigQuery :: Select -> BigQuery
selectToBigQuery Select
select =
  BigQuery
    { $sel:query:BigQuery :: Text
query = Builder -> Text
LT.toLazyText Builder
query,
      $sel:parameters:BigQuery :: InsOrdHashMap ParameterName Parameter
parameters =
        [(ParameterName, Parameter)]
-> InsOrdHashMap ParameterName Parameter
forall k v. (Eq k, Hashable k) => [(k, v)] -> InsOrdHashMap k v
InsOrdHashMap.fromList
          ( ((Int, TypedValue) -> (ParameterName, Parameter))
-> [(Int, TypedValue)] -> [(ParameterName, Parameter)]
forall a b. (a -> b) -> [a] -> [b]
map
              ( \(Int
int, (TypedValue ScalarType
typ Value
value)) ->
                  ( Text -> ParameterName
ParameterName (Builder -> Text
LT.toLazyText (Int -> Builder
ToQuery.paramName Int
int)),
                    Parameter {ScalarType
$sel:typ:Parameter :: ScalarType
typ :: ScalarType
typ, Value
$sel:value:Parameter :: Value
value :: Value
value}
                  )
              )
              (InsOrdHashMap Int TypedValue -> [(Int, TypedValue)]
forall k v. InsOrdHashMap k v -> [(k, v)]
InsOrdHashMap.toList InsOrdHashMap Int TypedValue
params)
          )
    }
  where
    (Builder
query, InsOrdHashMap Int TypedValue
params) =
      Printer -> (Builder, InsOrdHashMap Int TypedValue)
ToQuery.renderBuilderPretty (Select -> Printer
ToQuery.fromSelect Select
select)

--------------------------------------------------------------------------------
-- JSON serialization

typeToBigQueryJson :: ScalarType -> J.Value
typeToBigQueryJson :: ScalarType -> Value
typeToBigQueryJson =
  \case
    ScalarType
DecimalScalarType -> Text -> Value
atomic Text
"NUMERIC"
    ScalarType
BigDecimalScalarType -> Text -> Value
atomic Text
"BIGNUMERIC"
    ScalarType
IntegerScalarType -> Text -> Value
atomic Text
"INTEGER"
    ScalarType
DateScalarType -> Text -> Value
atomic Text
"DATE"
    ScalarType
TimeScalarType -> Text -> Value
atomic Text
"TIME"
    ScalarType
DatetimeScalarType -> Text -> Value
atomic Text
"DATETIME"
    ScalarType
JsonScalarType -> Text -> Value
atomic Text
"JSON"
    ScalarType
TimestampScalarType -> Text -> Value
atomic Text
"TIMESTAMP"
    ScalarType
FloatScalarType -> Text -> Value
atomic Text
"FLOAT"
    ScalarType
GeographyScalarType -> Text -> Value
atomic Text
"GEOGRAPHY"
    ScalarType
StringScalarType -> Text -> Value
atomic Text
"STRING"
    ScalarType
BytesScalarType -> Text -> Value
atomic Text
"BYTES"
    ScalarType
BoolScalarType -> Text -> Value
atomic Text
"BOOL"
    ScalarType
StructScalarType -> Text -> Value
atomic Text
"STRUCT"
  where
    atomic :: Text -> Value
atomic Text
ty = [Pair] -> Value
J.object [Key
"type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= (Text
ty :: Text)]

-- | Make a JSON representation of the type of the given value.
valueToBigQueryJson :: Value -> J.Value
valueToBigQueryJson :: Value -> Value
valueToBigQueryJson = Value -> Value
go
  where
    go :: Value -> Value
go =
      \case
        Value
NullValue -> [Pair] -> Value
J.object [(Key
"value", Value
J.Null)]
        DecimalValue Decimal
i -> [Pair] -> Value
J.object [Key
"value" Key -> Decimal -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Decimal
i]
        BigDecimalValue BigDecimal
i -> [Pair] -> Value
J.object [Key
"value" Key -> BigDecimal -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BigDecimal
i]
        IntegerValue Int64
i -> [Pair] -> Value
J.object [Key
"value" Key -> Int64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Int64
i]
        FloatValue Float64
i -> [Pair] -> Value
J.object [Key
"value" Key -> Float64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Float64
i]
        TimestampValue Timestamp
i -> [Pair] -> Value
J.object [Key
"value" Key -> Timestamp -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Timestamp
i]
        DateValue (Date Text
i) -> [Pair] -> Value
J.object [Key
"value" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
i]
        TimeValue (Time Text
i) -> [Pair] -> Value
J.object [Key
"value" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
i]
        DatetimeValue (Datetime Text
i) -> [Pair] -> Value
J.object [Key
"value" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
i]
        GeographyValue (Geography Text
i) -> [Pair] -> Value
J.object [Key
"value" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
i]
        StringValue Text
i -> [Pair] -> Value
J.object [Key
"value" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Value
J.String Text
i]
        BytesValue Base64
i -> [Pair] -> Value
J.object [Key
"value" Key -> Base64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Base64
i]
        JsonValue Value
i -> [Pair] -> Value
J.object [Key
"value" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Value
i]
        BoolValue Bool
i ->
          [Pair] -> Value
J.object
            [ Key
"value"
                Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Value
J.String
                  ( if Bool
i
                      then Text
"true"
                      else Text
"false"
                  )
            ]
        ArrayValue Vector Value
vs ->
          [Pair] -> Value
J.object [Key
"array_values" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Vector Value -> Value
J.Array ((Value -> Value) -> Vector Value -> Vector Value
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Value
go Vector Value
vs)]

--------------------------------------------------------------------------------
-- Execute a query as a job and stream the results into a record set

-- | TODO: WARNING: This function hasn't been tested on Big Data(tm),
-- and therefore I was unable to get BigQuery to produce paginated
-- results that would contain the 'pageToken' field in the JSON
-- response. Until that test has been done, we should consider this a
-- preliminary implementation.
streamBigQuery ::
  (MonadIO m) => BigQueryConnection -> BigQuery -> m (Either ExecuteProblem (BigQuery.Job, RecordSet))
streamBigQuery :: forall (m :: * -> *).
MonadIO m =>
BigQueryConnection
-> BigQuery -> m (Either ExecuteProblem (Job, RecordSet))
streamBigQuery BigQueryConnection
conn BigQuery
bigquery = do
  Either ExecuteProblem Job
jobResult <- ExceptT ExecuteProblem m Job -> m (Either ExecuteProblem Job)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT ExecuteProblem m Job -> m (Either ExecuteProblem Job))
-> ExceptT ExecuteProblem m Job -> m (Either ExecuteProblem Job)
forall a b. (a -> b) -> a -> b
$ BigQueryConnection -> BigQuery -> ExceptT ExecuteProblem m Job
forall (m :: * -> *).
(MonadError ExecuteProblem m, MonadIO m) =>
BigQueryConnection -> BigQuery -> m Job
createQueryJob BigQueryConnection
conn BigQuery
bigquery
  case Either ExecuteProblem Job
jobResult of
    Right Job
job -> Maybe Text
-> Maybe RecordSet -> m (Either ExecuteProblem (Job, RecordSet))
loop Maybe Text
forall a. Maybe a
Nothing Maybe RecordSet
forall a. Maybe a
Nothing
      where
        loop :: Maybe Text
-> Maybe RecordSet -> m (Either ExecuteProblem (Job, RecordSet))
loop Maybe Text
pageToken Maybe RecordSet
mrecordSet = do
          Either ExecuteProblem JobResultsResponse
results <- BigQueryConnection
-> Job -> Fetch -> m (Either ExecuteProblem JobResultsResponse)
forall (m :: * -> *).
MonadIO m =>
BigQueryConnection
-> Job -> Fetch -> m (Either ExecuteProblem JobResultsResponse)
getJobResults BigQueryConnection
conn Job
job Fetch {Maybe Text
pageToken :: Maybe Text
pageToken :: Maybe Text
pageToken}
          case Either ExecuteProblem JobResultsResponse
results of
            Left ExecuteProblem
problem -> Either ExecuteProblem (Job, RecordSet)
-> m (Either ExecuteProblem (Job, RecordSet))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExecuteProblem -> Either ExecuteProblem (Job, RecordSet)
forall a b. a -> Either a b
Left ExecuteProblem
problem)
            Right
              ( JobComplete
                  JobResults
                    { pageToken :: JobResults -> Maybe Text
pageToken = Maybe Text
mpageToken',
                      $sel:recordSet:JobResults :: JobResults -> RecordSet
recordSet = recordSet' :: RecordSet
recordSet'@RecordSet {$sel:rows:RecordSet :: RecordSet -> Vector (InsOrdHashMap FieldNameText OutputValue)
rows = Vector (InsOrdHashMap FieldNameText OutputValue)
rows'}
                    }
                ) -> do
                let extendedRecordSet :: RecordSet
extendedRecordSet =
                      case Maybe RecordSet
mrecordSet of
                        Maybe RecordSet
Nothing -> RecordSet
recordSet'
                        Just recordSet :: RecordSet
recordSet@RecordSet {Vector (InsOrdHashMap FieldNameText OutputValue)
$sel:rows:RecordSet :: RecordSet -> Vector (InsOrdHashMap FieldNameText OutputValue)
rows :: Vector (InsOrdHashMap FieldNameText OutputValue)
rows} ->
                          (RecordSet
recordSet {$sel:rows:RecordSet :: Vector (InsOrdHashMap FieldNameText OutputValue)
rows = Vector (InsOrdHashMap FieldNameText OutputValue)
rows Vector (InsOrdHashMap FieldNameText OutputValue)
-> Vector (InsOrdHashMap FieldNameText OutputValue)
-> Vector (InsOrdHashMap FieldNameText OutputValue)
forall a. Semigroup a => a -> a -> a
<> Vector (InsOrdHashMap FieldNameText OutputValue)
rows'})
                case Maybe Text
mpageToken' of
                  Maybe Text
Nothing -> Either ExecuteProblem (Job, RecordSet)
-> m (Either ExecuteProblem (Job, RecordSet))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Job, RecordSet) -> Either ExecuteProblem (Job, RecordSet)
forall a b. b -> Either a b
Right (Job
job, RecordSet
extendedRecordSet))
                  Just Text
pageToken' ->
                    Maybe Text
-> Maybe RecordSet -> m (Either ExecuteProblem (Job, RecordSet))
loop (Text -> Maybe Text
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
pageToken') (RecordSet -> Maybe RecordSet
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RecordSet
extendedRecordSet)
            Right JobIncomplete {} -> do
              IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (DiffTime -> IO ()
sleep DiffTime
streamDelaySeconds)
              Maybe Text
-> Maybe RecordSet -> m (Either ExecuteProblem (Job, RecordSet))
loop Maybe Text
pageToken Maybe RecordSet
mrecordSet
    Left ExecuteProblem
e -> Either ExecuteProblem (Job, RecordSet)
-> m (Either ExecuteProblem (Job, RecordSet))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExecuteProblem -> Either ExecuteProblem (Job, RecordSet)
forall a b. a -> Either a b
Left ExecuteProblem
e)

-- | Execute a query without expecting any output (e.g. CREATE TABLE or INSERT)
executeBigQuery :: (MonadIO m) => BigQueryConnection -> BigQuery -> m (Either ExecuteProblem ())
executeBigQuery :: forall (m :: * -> *).
MonadIO m =>
BigQueryConnection -> BigQuery -> m (Either ExecuteProblem ())
executeBigQuery BigQueryConnection
conn BigQuery
bigquery = do
  Either ExecuteProblem Job
jobResult <- ExceptT ExecuteProblem m Job -> m (Either ExecuteProblem Job)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT ExecuteProblem m Job -> m (Either ExecuteProblem Job))
-> ExceptT ExecuteProblem m Job -> m (Either ExecuteProblem Job)
forall a b. (a -> b) -> a -> b
$ BigQueryConnection -> BigQuery -> ExceptT ExecuteProblem m Job
forall (m :: * -> *).
(MonadError ExecuteProblem m, MonadIO m) =>
BigQueryConnection -> BigQuery -> m Job
createQueryJob BigQueryConnection
conn BigQuery
bigquery
  case Either ExecuteProblem Job
jobResult of
    Right Job
job -> Maybe Any -> m (Either ExecuteProblem ())
loop Maybe Any
forall a. Maybe a
Nothing
      where
        loop :: Maybe Any -> m (Either ExecuteProblem ())
loop Maybe Any
mrecordSet = do
          Either ExecuteProblem JobResultsResponse
results <- BigQueryConnection
-> Job -> Fetch -> m (Either ExecuteProblem JobResultsResponse)
forall (m :: * -> *).
MonadIO m =>
BigQueryConnection
-> Job -> Fetch -> m (Either ExecuteProblem JobResultsResponse)
getJobResults BigQueryConnection
conn Job
job Fetch {pageToken :: Maybe Text
pageToken = Maybe Text
forall a. Maybe a
Nothing}
          case Either ExecuteProblem JobResultsResponse
results of
            Left ExecuteProblem
problem -> Either ExecuteProblem () -> m (Either ExecuteProblem ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExecuteProblem -> Either ExecuteProblem ()
forall a b. a -> Either a b
Left ExecuteProblem
problem)
            Right (JobComplete JobResults
_) -> Either ExecuteProblem () -> m (Either ExecuteProblem ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either ExecuteProblem ()
forall a b. b -> Either a b
Right ())
            Right JobIncomplete {} -> do
              IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (DiffTime -> IO ()
sleep DiffTime
streamDelaySeconds)
              Maybe Any -> m (Either ExecuteProblem ())
loop Maybe Any
mrecordSet
    Left ExecuteProblem
e -> Either ExecuteProblem () -> m (Either ExecuteProblem ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExecuteProblem -> Either ExecuteProblem ()
forall a b. a -> Either a b
Left ExecuteProblem
e)

--------------------------------------------------------------------------------
-- Querying results from a job

data JobResults = JobResults
  { JobResults -> Maybe Text
pageToken :: Maybe Text,
    JobResults -> RecordSet
recordSet :: RecordSet
  }
  deriving (Int -> JobResults -> ShowS
[JobResults] -> ShowS
JobResults -> String
(Int -> JobResults -> ShowS)
-> (JobResults -> String)
-> ([JobResults] -> ShowS)
-> Show JobResults
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JobResults -> ShowS
showsPrec :: Int -> JobResults -> ShowS
$cshow :: JobResults -> String
show :: JobResults -> String
$cshowList :: [JobResults] -> ShowS
showList :: [JobResults] -> ShowS
Show)

instance J.FromJSON JobResults where
  parseJSON :: Value -> Parser JobResults
parseJSON =
    String
-> (Object -> Parser JobResults) -> Value -> Parser JobResults
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject
      String
"JobResults"
      ( \Object
o -> do
          RecordSet
recordSet <- Object -> Parser RecordSet
parseRecordSetPayload Object
o
          Maybe Text
pageToken <-
            (Maybe Text -> Maybe Text)
-> Parser (Maybe Text) -> Parser (Maybe Text)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
              ( \Maybe Text
mtoken -> do
                  Text
token <- Maybe Text
mtoken
                  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Text -> Bool
T.null Text
token))
                  Text -> Maybe Text
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
token
              )
              (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"pageToken")
          JobResults -> Parser JobResults
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure JobResults {Maybe Text
RecordSet
pageToken :: Maybe Text
$sel:recordSet:JobResults :: RecordSet
recordSet :: RecordSet
pageToken :: Maybe Text
..}
      )

data JobResultsResponse
  = JobIncomplete
  | JobComplete JobResults
  deriving (Int -> JobResultsResponse -> ShowS
[JobResultsResponse] -> ShowS
JobResultsResponse -> String
(Int -> JobResultsResponse -> ShowS)
-> (JobResultsResponse -> String)
-> ([JobResultsResponse] -> ShowS)
-> Show JobResultsResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JobResultsResponse -> ShowS
showsPrec :: Int -> JobResultsResponse -> ShowS
$cshow :: JobResultsResponse -> String
show :: JobResultsResponse -> String
$cshowList :: [JobResultsResponse] -> ShowS
showList :: [JobResultsResponse] -> ShowS
Show)

instance J.FromJSON JobResultsResponse where
  parseJSON :: Value -> Parser JobResultsResponse
parseJSON Value
j =
    String
-> (Object -> Parser JobResultsResponse)
-> Value
-> Parser JobResultsResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject
      String
"JobResultsResponse"
      ( \Object
o -> do
          Text
kind <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"kind"
          if Text
kind Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"bigquery#getQueryResultsResponse" :: Text)
            then do
              Bool
complete <- Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"jobComplete"
              if Bool
complete
                then (JobResults -> JobResultsResponse)
-> Parser JobResults -> Parser JobResultsResponse
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap JobResults -> JobResultsResponse
JobComplete (Value -> Parser JobResults
forall a. FromJSON a => Value -> Parser a
J.parseJSON Value
j)
                else JobResultsResponse -> Parser JobResultsResponse
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure JobResultsResponse
JobIncomplete
            else String -> Parser JobResultsResponse
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Invalid kind: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
kind)
      )
      Value
j

data Fetch = Fetch
  { Fetch -> Maybe Text
pageToken :: Maybe Text
  }
  deriving (Int -> Fetch -> ShowS
[Fetch] -> ShowS
Fetch -> String
(Int -> Fetch -> ShowS)
-> (Fetch -> String) -> ([Fetch] -> ShowS) -> Show Fetch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Fetch -> ShowS
showsPrec :: Int -> Fetch -> ShowS
$cshow :: Fetch -> String
show :: Fetch -> String
$cshowList :: [Fetch] -> ShowS
showList :: [Fetch] -> ShowS
Show)

-- | Get results of a job.
getJobResults ::
  (MonadIO m) =>
  BigQueryConnection ->
  BigQuery.Job ->
  Fetch ->
  m (Either ExecuteProblem JobResultsResponse)
getJobResults :: forall (m :: * -> *).
MonadIO m =>
BigQueryConnection
-> Job -> Fetch -> m (Either ExecuteProblem JobResultsResponse)
getJobResults BigQueryConnection
conn Job {Text
jobId :: Text
$sel:jobId:Job :: Job -> Text
jobId, Text
location :: Text
$sel:location:Job :: Job -> Text
location} Fetch {Maybe Text
pageToken :: Fetch -> Maybe Text
pageToken :: Maybe Text
pageToken} = ExceptT ExecuteProblem m JobResultsResponse
-> m (Either ExecuteProblem JobResultsResponse)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT ExecuteProblem m JobResultsResponse
 -> m (Either ExecuteProblem JobResultsResponse))
-> ExceptT ExecuteProblem m JobResultsResponse
-> m (Either ExecuteProblem JobResultsResponse)
forall a b. (a -> b) -> a -> b
$ do
  -- https://cloud.google.com/bigquery/docs/reference/rest/v2/jobs/get#query-parameters
  let url :: String
url =
        String
"GET "
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
bigQueryProjectUrl (BigQueryProjectId -> Text
getBigQueryProjectId (BigQueryProjectId -> Text) -> BigQueryProjectId -> Text
forall a b. (a -> b) -> a -> b
$ BigQueryConnection -> BigQueryProjectId
_bqProjectId BigQueryConnection
conn)
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"/queries/"
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
jobId
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"?alt=json&prettyPrint=false"
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"&location="
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
location
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"&"
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack ([(Text, Text)] -> Text
encodeParams [(Text, Text)]
extraParameters)

      req :: Request
req =
        Request -> Request
jsonRequestHeader (String -> Request
parseRequest_ String
url)

      extraParameters :: [(Text, Text)]
extraParameters = [(Text, Text)]
pageTokenParam
        where
          pageTokenParam :: [(Text, Text)]
pageTokenParam =
            case Maybe Text
pageToken of
              Maybe Text
Nothing -> []
              Just Text
token -> [(Text
"pageToken", Text
token)]

      encodeParams :: [(Text, Text)] -> Text
encodeParams = Text -> [Text] -> Text
T.intercalate Text
"&" ([Text] -> Text)
-> ([(Text, Text)] -> [Text]) -> [(Text, Text)] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
k, Text
v) -> Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v)

  Response ByteString
resp <- BigQueryConnection
-> Request -> ExceptT ExecuteProblem m (Response ByteString)
forall (m :: * -> *).
(MonadError ExecuteProblem m, MonadIO m) =>
BigQueryConnection -> Request -> m (Response ByteString)
runBigQueryExcept BigQueryConnection
conn Request
req
  case Response ByteString -> Int
forall a. Response a -> Int
getResponseStatusCode Response ByteString
resp of
    Int
200 ->
      ByteString -> Either String JobResultsResponse
forall a. FromJSON a => ByteString -> Either String a
J.eitherDecode (Response ByteString -> ByteString
forall a. Response a -> a
getResponseBody Response ByteString
resp)
        Either String JobResultsResponse
-> (String -> ExceptT ExecuteProblem m JobResultsResponse)
-> ExceptT ExecuteProblem m JobResultsResponse
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
`onLeft` (ExecuteProblem -> ExceptT ExecuteProblem m JobResultsResponse
forall a. ExecuteProblem -> ExceptT ExecuteProblem m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ExecuteProblem -> ExceptT ExecuteProblem m JobResultsResponse)
-> (String -> ExecuteProblem)
-> String
-> ExceptT ExecuteProblem m JobResultsResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ExecuteProblem
GetJobDecodeProblem)
    Int
_ ->
      ExecuteProblem -> ExceptT ExecuteProblem m JobResultsResponse
forall a. ExecuteProblem -> ExceptT ExecuteProblem m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
        (ExecuteProblem -> ExceptT ExecuteProblem m JobResultsResponse)
-> ExecuteProblem -> ExceptT ExecuteProblem m JobResultsResponse
forall a b. (a -> b) -> a -> b
$ Status -> Value -> ExecuteProblem
RESTRequestNonOK
          (Response ByteString -> Status
forall a. Response a -> Status
getResponseStatus Response ByteString
resp)
        (Value -> ExecuteProblem) -> Value -> ExecuteProblem
forall a b. (a -> b) -> a -> b
$ ByteString -> Value
parseAsJsonOrText
        (ByteString -> Value) -> ByteString -> Value
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall a. Response a -> a
getResponseBody Response ByteString
resp

--------------------------------------------------------------------------------
-- Creating jobs

-- | Make a Request return `JSON`
jsonRequestHeader :: Request -> Request
jsonRequestHeader :: Request -> Request
jsonRequestHeader =
  HeaderName -> [ByteString] -> Request -> Request
setRequestHeader HeaderName
"Content-Type" [ByteString
"application/json"]

-- | Create a job asynchronously.
createQueryJob :: (MonadError ExecuteProblem m, MonadIO m) => BigQueryConnection -> BigQuery -> m Job
createQueryJob :: forall (m :: * -> *).
(MonadError ExecuteProblem m, MonadIO m) =>
BigQueryConnection -> BigQuery -> m Job
createQueryJob BigQueryConnection
conn BigQuery {Text
InsOrdHashMap ParameterName Parameter
$sel:query:BigQuery :: BigQuery -> Text
$sel:parameters:BigQuery :: BigQuery -> InsOrdHashMap ParameterName Parameter
query :: Text
parameters :: InsOrdHashMap ParameterName Parameter
..} = do
  let url :: String
url =
        String
"POST "
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
bigQueryProjectUrl (BigQueryProjectId -> Text
getBigQueryProjectId (BigQueryProjectId -> Text) -> BigQueryProjectId -> Text
forall a b. (a -> b) -> a -> b
$ BigQueryConnection -> BigQueryProjectId
_bqProjectId BigQueryConnection
conn)
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"/jobs?alt=json&prettyPrint=false"

      req :: Request
req =
        Request -> Request
jsonRequestHeader
          (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ ByteString -> Request -> Request
setRequestBodyLBS ByteString
body
          (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ String -> Request
parseRequest_ String
url

      body :: ByteString
body =
        Value -> ByteString
forall a. ToJSON a => a -> ByteString
J.encode
          ( [Pair] -> Value
J.object
              [ Key
"configuration"
                  Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [Pair] -> Value
J.object
                    [ Key
"jobType" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= String
"QUERY",
                      Key
"query"
                        Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [Pair] -> Value
J.object
                          [ Key
"query" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
query,
                            Key
"useLegacySql" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Bool
False, -- Important, it makes `quotes` work properly.
                            Key
"parameterMode" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= String
"NAMED",
                            Key
"queryParameters"
                              Key -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ((ParameterName, Parameter) -> Value)
-> [(ParameterName, Parameter)] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map
                                ( \(ParameterName
name, Parameter {ScalarType
Value
$sel:typ:Parameter :: Parameter -> ScalarType
$sel:value:Parameter :: Parameter -> Value
typ :: ScalarType
value :: Value
..}) ->
                                    [Pair] -> Value
J.object
                                      [ Key
"name" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ParameterName -> Value
forall a. ToJSON a => a -> Value
J.toJSON ParameterName
name,
                                        Key
"parameterType" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ScalarType -> Value
typeToBigQueryJson ScalarType
typ,
                                        Key
"parameterValue" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Value -> Value
valueToBigQueryJson Value
value
                                      ]
                                )
                                (InsOrdHashMap ParameterName Parameter
-> [(ParameterName, Parameter)]
forall k v. InsOrdHashMap k v -> [(k, v)]
InsOrdHashMap.toList InsOrdHashMap ParameterName Parameter
parameters)
                          ]
                    ]
              ]
          )

  Response ByteString
resp <- BigQueryConnection -> Request -> m (Response ByteString)
forall (m :: * -> *).
(MonadError ExecuteProblem m, MonadIO m) =>
BigQueryConnection -> Request -> m (Response ByteString)
runBigQueryExcept BigQueryConnection
conn Request
req
  case Response ByteString -> Int
forall a. Response a -> Int
getResponseStatusCode Response ByteString
resp of
    Int
200 ->
      ByteString -> Either String Job
forall a. FromJSON a => ByteString -> Either String a
J.eitherDecode (Response ByteString -> ByteString
forall a. Response a -> a
getResponseBody Response ByteString
resp)
        Either String Job -> (String -> m Job) -> m Job
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
`onLeft` (ExecuteProblem -> m Job
forall a. ExecuteProblem -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ExecuteProblem -> m Job)
-> (String -> ExecuteProblem) -> String -> m Job
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ExecuteProblem
CreateQueryJobDecodeProblem)
    Int
_ ->
      ExecuteProblem -> m Job
forall a. ExecuteProblem -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
        (ExecuteProblem -> m Job) -> ExecuteProblem -> m Job
forall a b. (a -> b) -> a -> b
$ Status -> Value -> ExecuteProblem
RESTRequestNonOK
          (Response ByteString -> Status
forall a. Response a -> Status
getResponseStatus Response ByteString
resp)
        (Value -> ExecuteProblem) -> Value -> ExecuteProblem
forall a b. (a -> b) -> a -> b
$ ByteString -> Value
parseAsJsonOrText
        (ByteString -> Value) -> ByteString -> Value
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall a. Response a -> a
getResponseBody Response ByteString
resp

data Dataset = Dataset
  { Dataset -> Text
datasetId :: Text
  }
  deriving (Int -> Dataset -> ShowS
[Dataset] -> ShowS
Dataset -> String
(Int -> Dataset -> ShowS)
-> (Dataset -> String) -> ([Dataset] -> ShowS) -> Show Dataset
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Dataset -> ShowS
showsPrec :: Int -> Dataset -> ShowS
$cshow :: Dataset -> String
show :: Dataset -> String
$cshowList :: [Dataset] -> ShowS
showList :: [Dataset] -> ShowS
Show)

instance J.FromJSON Dataset where
  parseJSON :: Value -> Parser Dataset
parseJSON =
    String -> (Object -> Parser Dataset) -> Value -> Parser Dataset
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject
      String
"Dataset"
      ( \Object
o -> do
          Text
datasetId <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
          Dataset -> Parser Dataset
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Dataset
Dataset Text
datasetId)
      )

-- | Delete a dataset
deleteDataset :: (MonadError ExecuteProblem m, MonadIO m) => BigQueryConnection -> Text -> m ()
deleteDataset :: forall (m :: * -> *).
(MonadError ExecuteProblem m, MonadIO m) =>
BigQueryConnection -> Text -> m ()
deleteDataset BigQueryConnection
conn Text
datasetId = do
  let url :: String
url =
        String
"DELETE "
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
bigQueryProjectUrl (BigQueryProjectId -> Text
getBigQueryProjectId (BigQueryProjectId -> Text) -> BigQueryProjectId -> Text
forall a b. (a -> b) -> a -> b
$ BigQueryConnection -> BigQueryProjectId
_bqProjectId BigQueryConnection
conn)
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"/datasets/"
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
datasetId
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"/?force=true&deleteContents=true"

  let req :: Request
req = Request -> Request
jsonRequestHeader (String -> Request
parseRequest_ String
url)

  Response ByteString
resp <- BigQueryConnection -> Request -> m (Response ByteString)
forall (m :: * -> *).
(MonadError ExecuteProblem m, MonadIO m) =>
BigQueryConnection -> Request -> m (Response ByteString)
runBigQueryExcept BigQueryConnection
conn Request
req
  case Response ByteString -> Int
forall a. Response a -> Int
getResponseStatusCode Response ByteString
resp of
    Int
204 -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Int
_ ->
      ExecuteProblem -> m ()
forall a. ExecuteProblem -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
        (ExecuteProblem -> m ()) -> ExecuteProblem -> m ()
forall a b. (a -> b) -> a -> b
$ Status -> Value -> ExecuteProblem
RESTRequestNonOK
          (Response ByteString -> Status
forall a. Response a -> Status
getResponseStatus Response ByteString
resp)
        (Value -> ExecuteProblem) -> Value -> ExecuteProblem
forall a b. (a -> b) -> a -> b
$ ByteString -> Value
parseAsJsonOrText
        (ByteString -> Value) -> ByteString -> Value
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall a. Response a -> a
getResponseBody Response ByteString
resp

-- | Run request and map errors into ExecuteProblem
runBigQueryExcept ::
  (MonadError ExecuteProblem m, MonadIO m) =>
  BigQueryConnection ->
  Request ->
  m (Response BL.ByteString)
runBigQueryExcept :: forall (m :: * -> *).
(MonadError ExecuteProblem m, MonadIO m) =>
BigQueryConnection -> Request -> m (Response ByteString)
runBigQueryExcept BigQueryConnection
conn Request
req = do
  BigQueryConnection
-> Request -> m (Either BigQueryProblem (Response ByteString))
forall (m :: * -> *).
MonadIO m =>
BigQueryConnection
-> Request -> m (Either BigQueryProblem (Response ByteString))
runBigQuery BigQueryConnection
conn Request
req m (Either BigQueryProblem (Response ByteString))
-> (Either BigQueryProblem (Response ByteString)
    -> m (Response ByteString))
-> m (Response ByteString)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Right Response ByteString
a -> Response ByteString -> m (Response ByteString)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Response ByteString
a
    Left BigQueryProblem
e -> ExecuteProblem -> m (Response ByteString)
forall a. ExecuteProblem -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (BigQueryProblem -> ExecuteProblem
ExecuteRunBigQueryProblem BigQueryProblem
e)

-- | Insert a new dataset
insertDataset :: (MonadError ExecuteProblem m, MonadIO m) => BigQueryConnection -> Text -> m Dataset
insertDataset :: forall (m :: * -> *).
(MonadError ExecuteProblem m, MonadIO m) =>
BigQueryConnection -> Text -> m Dataset
insertDataset BigQueryConnection
conn Text
datasetId =
  do
    let url :: String
url =
          String
"POST "
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
bigQueryProjectUrl (BigQueryProjectId -> Text
getBigQueryProjectId (BigQueryProjectId -> Text) -> BigQueryProjectId -> Text
forall a b. (a -> b) -> a -> b
$ BigQueryConnection -> BigQueryProjectId
_bqProjectId BigQueryConnection
conn)
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"/datasets?alt=json&prettyPrint=false"

        req :: Request
req =
          Request -> Request
jsonRequestHeader
            (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ ByteString -> Request -> Request
setRequestBodyLBS ByteString
body
            (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ String -> Request
parseRequest_ String
url

        body :: ByteString
body =
          Value -> ByteString
forall a. ToJSON a => a -> ByteString
J.encode
            ( [Pair] -> Value
J.object
                [ Key
"id" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
datasetId,
                  Key
"datasetReference"
                    Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [Pair] -> Value
J.object
                      [ Key
"datasetId" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
datasetId,
                        Key
"projectId" Key -> BigQueryProjectId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BigQueryConnection -> BigQueryProjectId
_bqProjectId BigQueryConnection
conn
                      ]
                ]
            )

    Response ByteString
resp <- BigQueryConnection -> Request -> m (Response ByteString)
forall (m :: * -> *).
(MonadError ExecuteProblem m, MonadIO m) =>
BigQueryConnection -> Request -> m (Response ByteString)
runBigQueryExcept BigQueryConnection
conn Request
req
    case Response ByteString -> Int
forall a. Response a -> Int
getResponseStatusCode Response ByteString
resp of
      Int
200 ->
        ByteString -> Either String Dataset
forall a. FromJSON a => ByteString -> Either String a
J.eitherDecode (Response ByteString -> ByteString
forall a. Response a -> a
getResponseBody Response ByteString
resp)
          Either String Dataset -> (String -> m Dataset) -> m Dataset
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
`onLeft` (ExecuteProblem -> m Dataset
forall a. ExecuteProblem -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ExecuteProblem -> m Dataset)
-> (String -> ExecuteProblem) -> String -> m Dataset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ExecuteProblem
InsertDatasetDecodeProblem)
      Int
_ ->
        ExecuteProblem -> m Dataset
forall a. ExecuteProblem -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
          (ExecuteProblem -> m Dataset) -> ExecuteProblem -> m Dataset
forall a b. (a -> b) -> a -> b
$ Status -> Value -> ExecuteProblem
RESTRequestNonOK
            (Response ByteString -> Status
forall a. Response a -> Status
getResponseStatus Response ByteString
resp)
          (Value -> ExecuteProblem) -> Value -> ExecuteProblem
forall a b. (a -> b) -> a -> b
$ ByteString -> Value
parseAsJsonOrText
          (ByteString -> Value) -> ByteString -> Value
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall a. Response a -> a
getResponseBody Response ByteString
resp

-- | Parse given @'ByteString' as JSON value. If not a valid JSON, encode to plain text.
parseAsJsonOrText :: BL.ByteString -> J.Value
parseAsJsonOrText :: ByteString -> Value
parseAsJsonOrText ByteString
bytestring =
  Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe (Text -> Value
J.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
lbsToTxt ByteString
bytestring) (Maybe Value -> Value) -> Maybe Value -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
J.decode ByteString
bytestring

--------------------------------------------------------------------------------
-- Consuming recordset from big query

parseRecordSetPayload :: J.Object -> J.Parser RecordSet
parseRecordSetPayload :: Object -> Parser RecordSet
parseRecordSetPayload Object
resp = do
  Maybe Object
mSchema <- Object
resp Object -> Key -> Parser (Maybe Object)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"schema"
  Vector BigQueryField
columns <- Parser (Vector BigQueryField)
-> (Object -> Parser (Vector BigQueryField))
-> Maybe Object
-> Parser (Vector BigQueryField)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Vector BigQueryField -> Parser (Vector BigQueryField)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Vector BigQueryField
forall a. Vector a
V.empty) (Object -> Key -> Parser (Vector BigQueryField)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"fields") Maybe Object
mSchema :: J.Parser (Vector BigQueryField)
  Vector Value
rowsJSON <- (Maybe (Vector Value) -> Vector Value)
-> Parser (Maybe (Vector Value)) -> Parser (Vector Value)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Vector Value -> Maybe (Vector Value) -> Vector Value
forall a. a -> Maybe a -> a
fromMaybe Vector Value
forall a. Vector a
V.empty) (Object
resp Object -> Key -> Parser (Maybe (Vector Value))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"rows" :: J.Parser (Maybe (Vector J.Value)))
  Vector (InsOrdHashMap FieldNameText OutputValue)
rows <-
    (Int -> Value -> Parser (InsOrdHashMap FieldNameText OutputValue))
-> Vector Value
-> Parser (Vector (InsOrdHashMap FieldNameText OutputValue))
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m (Vector b)
V.imapM
      (\Int
i Value
row -> Vector BigQueryField
-> Value -> Parser (InsOrdHashMap FieldNameText OutputValue)
parseRow Vector BigQueryField
columns Value
row Parser (InsOrdHashMap FieldNameText OutputValue)
-> JSONPathElement
-> Parser (InsOrdHashMap FieldNameText OutputValue)
forall a. Parser a -> JSONPathElement -> Parser a
J.<?> Int -> JSONPathElement
J.Index Int
i)
      Vector Value
rowsJSON
      Parser (Vector (InsOrdHashMap FieldNameText OutputValue))
-> JSONPathElement
-> Parser (Vector (InsOrdHashMap FieldNameText OutputValue))
forall a. Parser a -> JSONPathElement -> Parser a
J.<?> Key -> JSONPathElement
J.Key Key
"rows"
  RecordSet -> Parser RecordSet
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RecordSet {$sel:wantedFields:RecordSet :: Maybe [Text]
wantedFields = Maybe [Text]
forall a. Maybe a
Nothing, Vector (InsOrdHashMap FieldNameText OutputValue)
$sel:rows:RecordSet :: Vector (InsOrdHashMap FieldNameText OutputValue)
rows :: Vector (InsOrdHashMap FieldNameText OutputValue)
rows}

--------------------------------------------------------------------------------
-- Schema-driven JSON deserialization

parseRow :: Vector BigQueryField -> J.Value -> J.Parser (InsOrdHashMap FieldNameText OutputValue)
parseRow :: Vector BigQueryField
-> Value -> Parser (InsOrdHashMap FieldNameText OutputValue)
parseRow Vector BigQueryField
columnTypes Value
value = do
  OutputValue
result <- Vector BigQueryField -> Value -> Parser OutputValue
parseBigQueryRow Vector BigQueryField
columnTypes Value
value
  case OutputValue
result of
    RecordOutputValue InsOrdHashMap FieldNameText OutputValue
row -> InsOrdHashMap FieldNameText OutputValue
-> Parser (InsOrdHashMap FieldNameText OutputValue)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure InsOrdHashMap FieldNameText OutputValue
row
    OutputValue
_ -> String -> Parser (InsOrdHashMap FieldNameText OutputValue)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Expected a record when parsing a top-level row: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
value)

-- | Parse a row, which at the top-level of the "rows" output has no
-- {"v":..} wrapper. But when appearing nestedly, does have the
-- wrapper. See 'parseBigQueryValue'.
parseBigQueryRow :: Vector BigQueryField -> J.Value -> J.Parser OutputValue
parseBigQueryRow :: Vector BigQueryField -> Value -> Parser OutputValue
parseBigQueryRow Vector BigQueryField
columnTypes =
  String
-> (Object -> Parser OutputValue) -> Value -> Parser OutputValue
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject
    String
"RECORD"
    ( \Object
o -> do
        Vector Value
fields <- Object
o Object -> Key -> Parser (Vector Value)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"f" Parser (Vector Value) -> JSONPathElement -> Parser (Vector Value)
forall a. Parser a -> JSONPathElement -> Parser a
J.<?> Key -> JSONPathElement
J.Key Key
"RECORD"
        Vector (FieldNameText, OutputValue)
values <-
          Vector (Parser (FieldNameText, OutputValue))
-> Parser (Vector (FieldNameText, OutputValue))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => Vector (m a) -> m (Vector a)
sequence
            ( (Int
 -> BigQueryField -> Value -> Parser (FieldNameText, OutputValue))
-> Vector BigQueryField
-> Vector Value
-> Vector (Parser (FieldNameText, OutputValue))
forall a b c.
(Int -> a -> b -> c) -> Vector a -> Vector b -> Vector c
V.izipWith
                ( \Int
i BigQueryField
typ Value
field ->
                    BigQueryField -> Value -> Parser (FieldNameText, OutputValue)
parseBigQueryField BigQueryField
typ Value
field Parser (FieldNameText, OutputValue)
-> JSONPathElement -> Parser (FieldNameText, OutputValue)
forall a. Parser a -> JSONPathElement -> Parser a
J.<?> Int -> JSONPathElement
J.Index Int
i
                )
                Vector BigQueryField
columnTypes
                Vector Value
fields
            )
            Parser (Vector (FieldNameText, OutputValue))
-> JSONPathElement -> Parser (Vector (FieldNameText, OutputValue))
forall a. Parser a -> JSONPathElement -> Parser a
J.<?> Key -> JSONPathElement
J.Key Key
"f"
        OutputValue -> Parser OutputValue
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InsOrdHashMap FieldNameText OutputValue -> OutputValue
RecordOutputValue ([(FieldNameText, OutputValue)]
-> InsOrdHashMap FieldNameText OutputValue
forall k v. (Eq k, Hashable k) => [(k, v)] -> InsOrdHashMap k v
InsOrdHashMap.fromList (Vector (FieldNameText, OutputValue)
-> [(FieldNameText, OutputValue)]
forall a. Vector a -> [a]
V.toList Vector (FieldNameText, OutputValue)
values)))
    )

parseBigQueryValue :: IsNullable -> BigQueryFieldType -> J.Value -> J.Parser OutputValue
parseBigQueryValue :: IsNullable -> BigQueryFieldType -> Value -> Parser OutputValue
parseBigQueryValue IsNullable
isNullable BigQueryFieldType
fieldType Value
object =
  case BigQueryFieldType
fieldType of
    FieldSTRUCT Vector BigQueryField
types ->
      IsNullable
-> (Value -> Parser OutputValue) -> Value -> Parser OutputValue
has_v IsNullable
isNullable (Vector BigQueryField -> Value -> Parser OutputValue
parseBigQueryRow Vector BigQueryField
types) Value
object Parser OutputValue -> JSONPathElement -> Parser OutputValue
forall a. Parser a -> JSONPathElement -> Parser a
J.<?> Key -> JSONPathElement
J.Key Key
"RECORD"
    BigQueryFieldType
FieldDECIMAL ->
      IsNullable
-> (Value -> Parser OutputValue) -> Value -> Parser OutputValue
has_v IsNullable
isNullable ((Decimal -> OutputValue) -> Parser Decimal -> Parser OutputValue
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Decimal -> OutputValue
DecimalOutputValue (Parser Decimal -> Parser OutputValue)
-> (Value -> Parser Decimal) -> Value -> Parser OutputValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Decimal
forall a. FromJSON a => Value -> Parser a
J.parseJSON) Value
object
        Parser OutputValue -> JSONPathElement -> Parser OutputValue
forall a. Parser a -> JSONPathElement -> Parser a
J.<?> Key -> JSONPathElement
J.Key Key
"DECIMAL"
    BigQueryFieldType
FieldBIGDECIMAL ->
      IsNullable
-> (Value -> Parser OutputValue) -> Value -> Parser OutputValue
has_v IsNullable
isNullable ((BigDecimal -> OutputValue)
-> Parser BigDecimal -> Parser OutputValue
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BigDecimal -> OutputValue
BigDecimalOutputValue (Parser BigDecimal -> Parser OutputValue)
-> (Value -> Parser BigDecimal) -> Value -> Parser OutputValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser BigDecimal
forall a. FromJSON a => Value -> Parser a
J.parseJSON) Value
object
        Parser OutputValue -> JSONPathElement -> Parser OutputValue
forall a. Parser a -> JSONPathElement -> Parser a
J.<?> Key -> JSONPathElement
J.Key Key
"BIGDECIMAL"
    BigQueryFieldType
FieldINTEGER ->
      IsNullable
-> (Value -> Parser OutputValue) -> Value -> Parser OutputValue
has_v IsNullable
isNullable ((Int64 -> OutputValue) -> Parser Int64 -> Parser OutputValue
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> OutputValue
IntegerOutputValue (Parser Int64 -> Parser OutputValue)
-> (Value -> Parser Int64) -> Value -> Parser OutputValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Int64
forall a. FromJSON a => Value -> Parser a
J.parseJSON) Value
object
        Parser OutputValue -> JSONPathElement -> Parser OutputValue
forall a. Parser a -> JSONPathElement -> Parser a
J.<?> Key -> JSONPathElement
J.Key Key
"INTEGER"
    BigQueryFieldType
FieldDATE ->
      IsNullable
-> (Value -> Parser OutputValue) -> Value -> Parser OutputValue
has_v IsNullable
isNullable ((Date -> OutputValue) -> Parser Date -> Parser OutputValue
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Date -> OutputValue
DateOutputValue (Parser Date -> Parser OutputValue)
-> (Value -> Parser Date) -> Value -> Parser OutputValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Date
forall a. FromJSON a => Value -> Parser a
J.parseJSON) Value
object
        Parser OutputValue -> JSONPathElement -> Parser OutputValue
forall a. Parser a -> JSONPathElement -> Parser a
J.<?> Key -> JSONPathElement
J.Key Key
"DATE"
    BigQueryFieldType
FieldTIME ->
      IsNullable
-> (Value -> Parser OutputValue) -> Value -> Parser OutputValue
has_v IsNullable
isNullable ((Time -> OutputValue) -> Parser Time -> Parser OutputValue
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Time -> OutputValue
TimeOutputValue (Parser Time -> Parser OutputValue)
-> (Value -> Parser Time) -> Value -> Parser OutputValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Time
forall a. FromJSON a => Value -> Parser a
J.parseJSON) Value
object
        Parser OutputValue -> JSONPathElement -> Parser OutputValue
forall a. Parser a -> JSONPathElement -> Parser a
J.<?> Key -> JSONPathElement
J.Key Key
"TIME"
    BigQueryFieldType
FieldDATETIME ->
      IsNullable
-> (Value -> Parser OutputValue) -> Value -> Parser OutputValue
has_v IsNullable
isNullable ((Datetime -> OutputValue) -> Parser Datetime -> Parser OutputValue
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Datetime -> OutputValue
DatetimeOutputValue (Parser Datetime -> Parser OutputValue)
-> (Value -> Parser Datetime) -> Value -> Parser OutputValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Datetime
forall a. FromJSON a => Value -> Parser a
J.parseJSON) Value
object
        Parser OutputValue -> JSONPathElement -> Parser OutputValue
forall a. Parser a -> JSONPathElement -> Parser a
J.<?> Key -> JSONPathElement
J.Key Key
"DATETIME"
    BigQueryFieldType
FieldTIMESTAMP ->
      IsNullable
-> (Value -> Parser OutputValue) -> Value -> Parser OutputValue
has_v IsNullable
isNullable ((Timestamp -> OutputValue)
-> Parser Timestamp -> Parser OutputValue
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Timestamp -> OutputValue
TimestampOutputValue (Parser Timestamp -> Parser OutputValue)
-> (Value -> Parser Timestamp) -> Value -> Parser OutputValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Timestamp
parseTimestamp) Value
object
        Parser OutputValue -> JSONPathElement -> Parser OutputValue
forall a. Parser a -> JSONPathElement -> Parser a
J.<?> Key -> JSONPathElement
J.Key Key
"TIMESTAMP"
    BigQueryFieldType
FieldGEOGRAPHY ->
      IsNullable
-> (Value -> Parser OutputValue) -> Value -> Parser OutputValue
has_v IsNullable
isNullable ((Geography -> OutputValue)
-> Parser Geography -> Parser OutputValue
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Geography -> OutputValue
GeographyOutputValue (Parser Geography -> Parser OutputValue)
-> (Value -> Parser Geography) -> Value -> Parser OutputValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Geography
forall a. FromJSON a => Value -> Parser a
J.parseJSON) Value
object
        Parser OutputValue -> JSONPathElement -> Parser OutputValue
forall a. Parser a -> JSONPathElement -> Parser a
J.<?> Key -> JSONPathElement
J.Key Key
"GEOGRAPHY"
    BigQueryFieldType
FieldFLOAT ->
      IsNullable
-> (Value -> Parser OutputValue) -> Value -> Parser OutputValue
has_v IsNullable
isNullable ((Float64 -> OutputValue) -> Parser Float64 -> Parser OutputValue
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Float64 -> OutputValue
FloatOutputValue (Parser Float64 -> Parser OutputValue)
-> (Value -> Parser Float64) -> Value -> Parser OutputValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Float64
forall a. FromJSON a => Value -> Parser a
J.parseJSON) Value
object
        Parser OutputValue -> JSONPathElement -> Parser OutputValue
forall a. Parser a -> JSONPathElement -> Parser a
J.<?> Key -> JSONPathElement
J.Key Key
"FLOAT"
    BigQueryFieldType
FieldBOOL ->
      IsNullable
-> (Value -> Parser OutputValue) -> Value -> Parser OutputValue
has_v IsNullable
isNullable ((String -> OutputValue) -> Parser String -> Parser OutputValue
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> OutputValue
BoolOutputValue (Bool -> OutputValue) -> (String -> Bool) -> String -> OutputValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"true")) (Parser String -> Parser OutputValue)
-> (Value -> Parser String) -> Value -> Parser OutputValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser String
forall a. FromJSON a => Value -> Parser a
J.parseJSON) Value
object
        Parser OutputValue -> JSONPathElement -> Parser OutputValue
forall a. Parser a -> JSONPathElement -> Parser a
J.<?> Key -> JSONPathElement
J.Key Key
"BOOL"
    BigQueryFieldType
FieldSTRING ->
      IsNullable
-> (Value -> Parser OutputValue) -> Value -> Parser OutputValue
has_v IsNullable
isNullable ((Text -> OutputValue) -> Parser Text -> Parser OutputValue
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> OutputValue
TextOutputValue (Parser Text -> Parser OutputValue)
-> (Value -> Parser Text) -> Value -> Parser OutputValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
J.parseJSON) Value
object
        Parser OutputValue -> JSONPathElement -> Parser OutputValue
forall a. Parser a -> JSONPathElement -> Parser a
J.<?> Key -> JSONPathElement
J.Key Key
"STRING"
    BigQueryFieldType
FieldBYTES ->
      IsNullable
-> (Value -> Parser OutputValue) -> Value -> Parser OutputValue
has_v IsNullable
isNullable ((Base64 -> OutputValue) -> Parser Base64 -> Parser OutputValue
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Base64 -> OutputValue
BytesOutputValue (Parser Base64 -> Parser OutputValue)
-> (Value -> Parser Base64) -> Value -> Parser OutputValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Base64
forall a. FromJSON a => Value -> Parser a
J.parseJSON) Value
object
        Parser OutputValue -> JSONPathElement -> Parser OutputValue
forall a. Parser a -> JSONPathElement -> Parser a
J.<?> Key -> JSONPathElement
J.Key Key
"BYTES"
    BigQueryFieldType
FieldJSON ->
      IsNullable
-> (Value -> Parser OutputValue) -> Value -> Parser OutputValue
has_v IsNullable
isNullable ((Value -> OutputValue) -> Parser Value -> Parser OutputValue
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> OutputValue
JsonOutputValue (Parser Value -> Parser OutputValue)
-> (Value -> Parser Value) -> Value -> Parser OutputValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Value
parseJson) Value
object
        Parser OutputValue -> JSONPathElement -> Parser OutputValue
forall a. Parser a -> JSONPathElement -> Parser a
J.<?> Key -> JSONPathElement
J.Key Key
"JSON"

-- | This is a little unfortunate: in its JSON responses, BigQuery gives JSON
-- fields as strings. So, to parse a JSON response, we need to parse it out of
-- a JSON string type, hence the unintuitive type signature here.
parseJson :: J.Value -> J.Parser J.Value
parseJson :: Value -> Parser Value
parseJson = String -> (Text -> Parser Value) -> Value -> Parser Value
forall a. String -> (Text -> Parser a) -> Value -> Parser a
J.withText String
"JSON" \Text
str ->
  ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
J.eitherDecode (Text -> ByteString
txtToLbs Text
str) Either String Value -> (String -> Parser Value) -> Parser Value
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
`onLeft` String -> Parser Value
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail

-- | Parse upstream timestamp value in epoch milliseconds and convert it to calendar date time format
-- https://cloud.google.com/bigquery/docs/reference/standard-sql/data-types#timestamp_type
parseTimestamp :: J.Value -> J.Parser Timestamp
parseTimestamp :: Value -> Parser Timestamp
parseTimestamp =
  (UTCTime -> Timestamp) -> Parser UTCTime -> Parser Timestamp
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Timestamp
Timestamp (Text -> Timestamp) -> (UTCTime -> Text) -> UTCTime -> Timestamp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Text
utctimeToISO8601Text) (Parser UTCTime -> Parser Timestamp)
-> (Value -> Parser UTCTime) -> Value -> Parser Timestamp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Text -> Parser UTCTime) -> Value -> Parser UTCTime
forall a. String -> (Text -> Parser a) -> Value -> Parser a
J.withText String
"FieldTIMESTAMP" Text -> Parser UTCTime
textToUTCTime
  where
    textToUTCTime :: Text -> J.Parser UTCTime
    textToUTCTime :: Text -> Parser UTCTime
textToUTCTime =
      (String -> Parser UTCTime)
-> ((NominalDiffTime, Text) -> Parser UTCTime)
-> Either String (NominalDiffTime, Text)
-> Parser UTCTime
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser UTCTime
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (UTCTime -> Parser UTCTime
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UTCTime -> Parser UTCTime)
-> ((NominalDiffTime, Text) -> UTCTime)
-> (NominalDiffTime, Text)
-> Parser UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NominalDiffTime -> UTCTime -> UTCTime)
-> UTCTime -> NominalDiffTime -> UTCTime
forall a b c. (a -> b -> c) -> b -> a -> c
flip NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (Day -> DiffTime -> UTCTime
UTCTime (Year -> Int -> Int -> Day
fromGregorian Year
1970 Int
0 Int
0) DiffTime
0) (NominalDiffTime -> UTCTime)
-> ((NominalDiffTime, Text) -> NominalDiffTime)
-> (NominalDiffTime, Text)
-> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NominalDiffTime, Text) -> NominalDiffTime
forall a b. (a, b) -> a
fst)
        (Either String (NominalDiffTime, Text) -> Parser UTCTime)
-> (Text -> Either String (NominalDiffTime, Text))
-> Text
-> Parser UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Either String (NominalDiffTime, Text)
forall a. Fractional a => Reader a
TR.rational :: TR.Reader NominalDiffTime)

    utctimeToISO8601Text :: UTCTime -> Text
    utctimeToISO8601Text :: UTCTime -> Text
utctimeToISO8601Text = String -> Text
T.pack (String -> Text) -> (UTCTime -> String) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> String
forall t. ISO8601 t => t -> String
iso8601Show

parseBigQueryField :: BigQueryField -> J.Value -> J.Parser (FieldNameText, OutputValue)
parseBigQueryField :: BigQueryField -> Value -> Parser (FieldNameText, OutputValue)
parseBigQueryField BigQueryField {FieldNameText
$sel:name:BigQueryField :: BigQueryField -> FieldNameText
name :: FieldNameText
name, BigQueryFieldType
$sel:typ:BigQueryField :: BigQueryField -> BigQueryFieldType
typ :: BigQueryFieldType
typ, Mode
$sel:mode:BigQueryField :: BigQueryField -> Mode
mode :: Mode
mode} Value
value1 =
  case Mode
mode of
    Mode
Repeated ->
      ( do
          Vector Value
values <- (Value -> Parser (Vector Value)) -> Value -> Parser (Vector Value)
forall a. (Value -> Parser a) -> Value -> Parser a
has_v_generic Value -> Parser (Vector Value)
forall a. FromJSON a => Value -> Parser a
J.parseJSON Value
value1
          Vector OutputValue
outputs <-
            (Int -> Value -> Parser OutputValue)
-> Vector Value -> Parser (Vector OutputValue)
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m (Vector b)
V.imapM
              ( \Int
i Value
value2 ->
                  IsNullable -> BigQueryFieldType -> Value -> Parser OutputValue
parseBigQueryValue IsNullable
IsRequired BigQueryFieldType
typ Value
value2
                    Parser OutputValue -> JSONPathElement -> Parser OutputValue
forall a. Parser a -> JSONPathElement -> Parser a
J.<?> Int -> JSONPathElement
J.Index Int
i
              )
              Vector Value
values
          (FieldNameText, OutputValue) -> Parser (FieldNameText, OutputValue)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldNameText
name, Vector OutputValue -> OutputValue
ArrayOutputValue Vector OutputValue
outputs)
      )
        Parser (FieldNameText, OutputValue)
-> JSONPathElement -> Parser (FieldNameText, OutputValue)
forall a. Parser a -> JSONPathElement -> Parser a
J.<?> Key -> JSONPathElement
J.Key Key
"REPEATED"
    Mode
Nullable -> do
      OutputValue
output <-
        IsNullable -> BigQueryFieldType -> Value -> Parser OutputValue
parseBigQueryValue IsNullable
IsNullable BigQueryFieldType
typ Value
value1 Parser OutputValue -> JSONPathElement -> Parser OutputValue
forall a. Parser a -> JSONPathElement -> Parser a
J.<?> Key -> JSONPathElement
J.Key Key
"NULLABLE"
      (FieldNameText, OutputValue) -> Parser (FieldNameText, OutputValue)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldNameText
name, OutputValue
output)
    Mode
NotNullable -> do
      OutputValue
output <-
        IsNullable -> BigQueryFieldType -> Value -> Parser OutputValue
parseBigQueryValue IsNullable
IsRequired BigQueryFieldType
typ Value
value1 Parser OutputValue -> JSONPathElement -> Parser OutputValue
forall a. Parser a -> JSONPathElement -> Parser a
J.<?> Key -> JSONPathElement
J.Key Key
"REQUIRED"
      (FieldNameText, OutputValue) -> Parser (FieldNameText, OutputValue)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldNameText
name, OutputValue
output)

-- Every value, after the top-level row, is wrapped in this.
has_v ::
  IsNullable ->
  (J.Value -> J.Parser OutputValue) ->
  J.Value ->
  J.Parser OutputValue
has_v :: IsNullable
-> (Value -> Parser OutputValue) -> Value -> Parser OutputValue
has_v IsNullable
isNullable Value -> Parser OutputValue
f =
  String
-> (Object -> Parser OutputValue) -> Value -> Parser OutputValue
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject
    String
"HAS_V"
    ( \Object
o ->
        Object
o Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"v" Parser Value -> (Value -> Parser OutputValue) -> Parser OutputValue
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Value
v ->
          case Value
v of
            Value
J.Null
              | IsNullable
IsNullable <- IsNullable
isNullable -> OutputValue -> Parser OutputValue
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OutputValue
NullOutputValue
            Value
_ -> Value -> Parser OutputValue
f Value
v Parser OutputValue -> JSONPathElement -> Parser OutputValue
forall a. Parser a -> JSONPathElement -> Parser a
J.<?> Key -> JSONPathElement
J.Key Key
"v"
    )

-- Every value, after the top-level row, is wrapped in this.
has_v_generic ::
  (J.Value -> J.Parser a) ->
  J.Value ->
  J.Parser a
has_v_generic :: forall a. (Value -> Parser a) -> Value -> Parser a
has_v_generic Value -> Parser a
f =
  String -> (Object -> Parser a) -> Value -> Parser a
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject
    String
"HAS_V"
    (\Object
o -> Object
o Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"v" Parser Value -> (Value -> Parser a) -> Parser a
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Value
v -> (Value -> Parser a
f Value
v Parser a -> JSONPathElement -> Parser a
forall a. Parser a -> JSONPathElement -> Parser a
J.<?> Key -> JSONPathElement
J.Key Key
"v"))

--------------------------------------------------------------------------------
-- Generic JSON deserialization

instance J.FromJSON BigQueryField where
  parseJSON :: Value -> Parser BigQueryField
parseJSON =
    String
-> (Object -> Parser BigQueryField)
-> Value
-> Parser BigQueryField
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject
      String
"BigQueryField"
      ( \Object
o -> do
          FieldNameText
name <- Object
o Object -> Key -> Parser FieldNameText
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
          BigQueryFieldType
typ <-
            do
              Text
flag :: Text <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
              if
                | Text
flag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"NUMERIC" Bool -> Bool -> Bool
|| Text
flag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"DECIMAL" -> BigQueryFieldType -> Parser BigQueryFieldType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BigQueryFieldType
FieldDECIMAL
                | Text
flag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"BIGNUMERIC" Bool -> Bool -> Bool
|| Text
flag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"BIGDECIMAL" ->
                    BigQueryFieldType -> Parser BigQueryFieldType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BigQueryFieldType
FieldBIGDECIMAL
                | Text
flag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"INT64" Bool -> Bool -> Bool
|| Text
flag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"INTEGER" -> BigQueryFieldType -> Parser BigQueryFieldType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BigQueryFieldType
FieldINTEGER
                | Text
flag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"FLOAT64" Bool -> Bool -> Bool
|| Text
flag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"FLOAT" -> BigQueryFieldType -> Parser BigQueryFieldType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BigQueryFieldType
FieldFLOAT
                | Text
flag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"BOOLEAN" Bool -> Bool -> Bool
|| Text
flag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"BOOL" -> BigQueryFieldType -> Parser BigQueryFieldType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BigQueryFieldType
FieldBOOL
                | Text
flag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"STRING" -> BigQueryFieldType -> Parser BigQueryFieldType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BigQueryFieldType
FieldSTRING
                | Text
flag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"JSON" -> BigQueryFieldType -> Parser BigQueryFieldType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BigQueryFieldType
FieldJSON
                | Text
flag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"DATE" -> BigQueryFieldType -> Parser BigQueryFieldType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BigQueryFieldType
FieldDATE
                | Text
flag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"TIME" -> BigQueryFieldType -> Parser BigQueryFieldType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BigQueryFieldType
FieldTIME
                | Text
flag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"DATETIME" -> BigQueryFieldType -> Parser BigQueryFieldType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BigQueryFieldType
FieldDATETIME
                | Text
flag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"TIMESTAMP" -> BigQueryFieldType -> Parser BigQueryFieldType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BigQueryFieldType
FieldTIMESTAMP
                | Text
flag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"GEOGRAPHY" -> BigQueryFieldType -> Parser BigQueryFieldType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BigQueryFieldType
FieldGEOGRAPHY
                | Text
flag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"BYTES" -> BigQueryFieldType -> Parser BigQueryFieldType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BigQueryFieldType
FieldBYTES
                | Text
flag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"RECORD" Bool -> Bool -> Bool
|| Text
flag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"STRUCT" ->
                    do
                      Vector BigQueryField
fields <- Object
o Object -> Key -> Parser (Vector BigQueryField)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"fields"
                      BigQueryFieldType -> Parser BigQueryFieldType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vector BigQueryField -> BigQueryFieldType
FieldSTRUCT Vector BigQueryField
fields)
                | Bool
otherwise -> String -> Parser BigQueryFieldType
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unsupported field type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
flag)
          Mode
mode <- Object
o Object -> Key -> Parser (Maybe Mode)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"mode" Parser (Maybe Mode) -> Mode -> Parser Mode
forall a. Parser (Maybe a) -> a -> Parser a
.!= Mode
Nullable
          BigQueryField -> Parser BigQueryField
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BigQueryField {Mode
BigQueryFieldType
FieldNameText
$sel:name:BigQueryField :: FieldNameText
$sel:typ:BigQueryField :: BigQueryFieldType
$sel:mode:BigQueryField :: Mode
name :: FieldNameText
typ :: BigQueryFieldType
mode :: Mode
..}
      )

instance J.FromJSON Mode where
  parseJSON :: Value -> Parser Mode
parseJSON Value
j = do
    Text
s <- Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
J.parseJSON Value
j
    case Text
s :: Text of
      Text
"NULLABLE" -> Mode -> Parser Mode
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Mode
Nullable
      Text
"REPEATED" -> Mode -> Parser Mode
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Mode
Repeated
      Text
_ -> Mode -> Parser Mode
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Mode
NotNullable