{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DuplicateRecordFields #-}

-- | Types for BigQuery
module Hasura.Backends.BigQuery.Types
  ( Aggregate (..),
    Aliased (..),
    ArrayAgg (..),
    Base64,
    BigDecimal (..),
    BooleanOperators (..),
    Cardinality (..),
    ColumnName (ColumnName),
    Countable (..),
    Date (..),
    Datetime (..),
    Decimal (..),
    EntityAlias (..),
    ExecutionStatistics (..),
    Expression (..),
    FieldName (..),
    FieldOrigin (..),
    Float64,
    From (..),
    SelectFromFunction (..),
    Geography (Geography),
    Int64 (Int64),
    Job (..),
    Join (..),
    JoinProvenance (ArrayAggregateJoinProvenance, ArrayJoinProvenance, ObjectJoinProvenance, OrderByJoinProvenance),
    JoinSource (..),
    JoinType (..),
    JsonPath (..),
    NullsOrder (..),
    Op (..),
    Order (..),
    OrderBy (..),
    Projection (..),
    Reselect (..),
    ScalarType (..),
    Select (..),
    AsStruct (..),
    PartitionableSelect (..),
    noExtraPartitionFields,
    withExtraPartitionFields,
    simpleSelect,
    SelectJson (..),
    TableName (..),
    Time (..),
    Timestamp (..),
    Top (..),
    TypedValue (..),
    Value (..),
    Where (..),
    With (..),
    WindowFunction (..),
    aggregateProjectionsFieldOrigin,
    doubleToBigDecimal,
    doubleToFloat64,
    getGQLTableName,
    intToInt64,
    int64Expr,
    isComparableType,
    isNumType,
    parseScalarValue,
    projectionAlias,
    scientificToText,
    columnToFieldName,
    FunctionName (..),
    ComputedFieldDefinition (..),
    ArgumentExp (..),
    ComputedFieldImplicitArguments,
    ComputedFieldReturn (..),
    FunctionArgument (..),
  )
where

import Autodocodec (HasCodec (codec), dimapCodec, object, optionalField', requiredField', (.=))
import Autodocodec qualified as AC
import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey)
import Data.Aeson qualified as J
import Data.Aeson.Casing qualified as J
import Data.Aeson.Extended qualified as J
import Data.Aeson.Types qualified as J
import Data.ByteString (ByteString)
import Data.ByteString.Base64 qualified as Base64
import Data.ByteString.Lazy qualified as L
import Data.Coerce
import Data.Int qualified as Int
import Data.Scientific
import Data.Text qualified as T
import Data.Text.Encoding qualified as T
import Data.Text.Extended
import Data.Text.Lazy (toStrict)
import Data.Text.Lazy.Builder (toLazyText)
import Data.Text.Lazy.Builder.Scientific (formatScientificBuilder)
import Data.Vector (Vector)
import Data.Vector.Instances ()
import Hasura.Base.Error
import Hasura.Base.ErrorValue qualified as ErrorValue
import Hasura.Base.ToErrorValue
import Hasura.Function.Cache (FunctionArgName)
import Hasura.Metadata.DTO.Placeholder (placeholderCodecViaJSON)
import Hasura.NativeQuery.Metadata (InterpolatedQuery, NativeQueryName)
import Hasura.Prelude hiding (state)
import Hasura.RQL.IR.BoolExp
import Language.GraphQL.Draft.Syntax qualified as G
import Language.Haskell.TH.Syntax hiding (location)
import Text.ParserCombinators.ReadP (eof, readP_to_S)

data Select = Select
  { Select -> Maybe With
selectWith :: Maybe With,
    Select -> Top
selectTop :: Top,
    Select -> AsStruct
selectAsStruct :: AsStruct,
    Select -> NonEmpty Projection
selectProjections :: NonEmpty Projection,
    Select -> From
selectFrom :: From,
    Select -> [Join]
selectJoins :: [Join],
    Select -> Where
selectWhere :: Where,
    Select -> Maybe (NonEmpty OrderBy)
selectOrderBy :: Maybe (NonEmpty OrderBy),
    Select -> Maybe Expression
selectOffset :: Maybe Expression,
    Select -> [FieldName]
selectGroupBy :: [FieldName],
    Select -> Maybe [Text]
selectFinalWantedFields :: Maybe [Text],
    Select -> Cardinality
selectCardinality :: Cardinality
  }
  deriving stock (Select -> Select -> Bool
(Select -> Select -> Bool)
-> (Select -> Select -> Bool) -> Eq Select
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Select -> Select -> Bool
== :: Select -> Select -> Bool
$c/= :: Select -> Select -> Bool
/= :: Select -> Select -> Bool
Eq, Eq Select
Eq Select
-> (Select -> Select -> Ordering)
-> (Select -> Select -> Bool)
-> (Select -> Select -> Bool)
-> (Select -> Select -> Bool)
-> (Select -> Select -> Bool)
-> (Select -> Select -> Select)
-> (Select -> Select -> Select)
-> Ord Select
Select -> Select -> Bool
Select -> Select -> Ordering
Select -> Select -> Select
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 :: Select -> Select -> Ordering
compare :: Select -> Select -> Ordering
$c< :: Select -> Select -> Bool
< :: Select -> Select -> Bool
$c<= :: Select -> Select -> Bool
<= :: Select -> Select -> Bool
$c> :: Select -> Select -> Bool
> :: Select -> Select -> Bool
$c>= :: Select -> Select -> Bool
>= :: Select -> Select -> Bool
$cmax :: Select -> Select -> Select
max :: Select -> Select -> Select
$cmin :: Select -> Select -> Select
min :: Select -> Select -> Select
Ord, Int -> Select -> ShowS
[Select] -> ShowS
Select -> String
(Int -> Select -> ShowS)
-> (Select -> String) -> ([Select] -> ShowS) -> Show Select
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Select -> ShowS
showsPrec :: Int -> Select -> ShowS
$cshow :: Select -> String
show :: Select -> String
$cshowList :: [Select] -> ShowS
showList :: [Select] -> ShowS
Show, (forall x. Select -> Rep Select x)
-> (forall x. Rep Select x -> Select) -> Generic Select
forall x. Rep Select x -> Select
forall x. Select -> Rep Select x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Select -> Rep Select x
from :: forall x. Select -> Rep Select x
$cto :: forall x. Rep Select x -> Select
to :: forall x. Rep Select x -> Select
Generic, Typeable Select
Typeable Select
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Select -> c Select)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Select)
-> (Select -> Constr)
-> (Select -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Select))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Select))
-> ((forall b. Data b => b -> b) -> Select -> Select)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Select -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Select -> r)
-> (forall u. (forall d. Data d => d -> u) -> Select -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Select -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Select -> m Select)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Select -> m Select)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Select -> m Select)
-> Data Select
Select -> Constr
Select -> DataType
(forall b. Data b => b -> b) -> Select -> Select
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Select -> u
forall u. (forall d. Data d => d -> u) -> Select -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Select -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Select -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Select -> m Select
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Select -> m Select
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Select
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Select -> c Select
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Select)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Select)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Select -> c Select
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Select -> c Select
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Select
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Select
$ctoConstr :: Select -> Constr
toConstr :: Select -> Constr
$cdataTypeOf :: Select -> DataType
dataTypeOf :: Select -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Select)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Select)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Select)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Select)
$cgmapT :: (forall b. Data b => b -> b) -> Select -> Select
gmapT :: (forall b. Data b => b -> b) -> Select -> Select
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Select -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Select -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Select -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Select -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Select -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Select -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Select -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Select -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Select -> m Select
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Select -> m Select
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Select -> m Select
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Select -> m Select
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Select -> m Select
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Select -> m Select
Data, (forall (m :: * -> *). Quote m => Select -> m Exp)
-> (forall (m :: * -> *). Quote m => Select -> Code m Select)
-> Lift Select
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Select -> m Exp
forall (m :: * -> *). Quote m => Select -> Code m Select
$clift :: forall (m :: * -> *). Quote m => Select -> m Exp
lift :: forall (m :: * -> *). Quote m => Select -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Select -> Code m Select
liftTyped :: forall (m :: * -> *). Quote m => Select -> Code m Select
Lift)
  deriving anyclass (Eq Select
Eq Select
-> (Int -> Select -> Int) -> (Select -> Int) -> Hashable Select
Int -> Select -> Int
Select -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Select -> Int
hashWithSalt :: Int -> Select -> Int
$chash :: Select -> Int
hash :: Select -> Int
Hashable, Select -> ()
(Select -> ()) -> NFData Select
forall a. (a -> ()) -> NFData a
$crnf :: Select -> ()
rnf :: Select -> ()
NFData)

-- | Helper type allowing addition of extra fields used
-- in PARTITION BY.
--
-- The main purpose of this type is sumulation of DISTINCT ON
-- implemented in Hasura.Backends.BigQuery.FromIr.simulateDistinctOn
data PartitionableSelect = PartitionableSelect
  { PartitionableSelect -> Maybe [FieldName] -> Select
pselectFinalize :: Maybe [FieldName] -> Select,
    PartitionableSelect -> From
pselectFrom :: From
  }

simpleSelect :: Select -> PartitionableSelect
simpleSelect :: Select -> PartitionableSelect
simpleSelect Select
select =
  PartitionableSelect
    { $sel:pselectFinalize:PartitionableSelect :: Maybe [FieldName] -> Select
pselectFinalize = Select -> Maybe [FieldName] -> Select
forall a b. a -> b -> a
const Select
select,
      $sel:pselectFrom:PartitionableSelect :: From
pselectFrom = Select -> From
selectFrom Select
select
    }

noExtraPartitionFields :: PartitionableSelect -> Select
noExtraPartitionFields :: PartitionableSelect -> Select
noExtraPartitionFields PartitionableSelect {From
Maybe [FieldName] -> Select
$sel:pselectFinalize:PartitionableSelect :: PartitionableSelect -> Maybe [FieldName] -> Select
$sel:pselectFrom:PartitionableSelect :: PartitionableSelect -> From
pselectFinalize :: Maybe [FieldName] -> Select
pselectFrom :: From
..} = Maybe [FieldName] -> Select
pselectFinalize Maybe [FieldName]
forall a. Maybe a
Nothing

withExtraPartitionFields :: PartitionableSelect -> [FieldName] -> Select
withExtraPartitionFields :: PartitionableSelect -> [FieldName] -> Select
withExtraPartitionFields PartitionableSelect {From
Maybe [FieldName] -> Select
$sel:pselectFinalize:PartitionableSelect :: PartitionableSelect -> Maybe [FieldName] -> Select
$sel:pselectFrom:PartitionableSelect :: PartitionableSelect -> From
pselectFinalize :: Maybe [FieldName] -> Select
pselectFrom :: From
..} = Maybe [FieldName] -> Select
pselectFinalize (Maybe [FieldName] -> Select)
-> ([FieldName] -> Maybe [FieldName]) -> [FieldName] -> Select
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FieldName] -> Maybe [FieldName]
forall a. a -> Maybe a
Just

data ArrayAgg = ArrayAgg
  { ArrayAgg -> NonEmpty Projection
arrayAggProjections :: NonEmpty Projection,
    ArrayAgg -> Maybe (NonEmpty OrderBy)
arrayAggOrderBy :: Maybe (NonEmpty OrderBy),
    ArrayAgg -> Top
arrayAggTop :: Top
  }
  deriving stock (ArrayAgg -> ArrayAgg -> Bool
(ArrayAgg -> ArrayAgg -> Bool)
-> (ArrayAgg -> ArrayAgg -> Bool) -> Eq ArrayAgg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ArrayAgg -> ArrayAgg -> Bool
== :: ArrayAgg -> ArrayAgg -> Bool
$c/= :: ArrayAgg -> ArrayAgg -> Bool
/= :: ArrayAgg -> ArrayAgg -> Bool
Eq, Eq ArrayAgg
Eq ArrayAgg
-> (ArrayAgg -> ArrayAgg -> Ordering)
-> (ArrayAgg -> ArrayAgg -> Bool)
-> (ArrayAgg -> ArrayAgg -> Bool)
-> (ArrayAgg -> ArrayAgg -> Bool)
-> (ArrayAgg -> ArrayAgg -> Bool)
-> (ArrayAgg -> ArrayAgg -> ArrayAgg)
-> (ArrayAgg -> ArrayAgg -> ArrayAgg)
-> Ord ArrayAgg
ArrayAgg -> ArrayAgg -> Bool
ArrayAgg -> ArrayAgg -> Ordering
ArrayAgg -> ArrayAgg -> ArrayAgg
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 :: ArrayAgg -> ArrayAgg -> Ordering
compare :: ArrayAgg -> ArrayAgg -> Ordering
$c< :: ArrayAgg -> ArrayAgg -> Bool
< :: ArrayAgg -> ArrayAgg -> Bool
$c<= :: ArrayAgg -> ArrayAgg -> Bool
<= :: ArrayAgg -> ArrayAgg -> Bool
$c> :: ArrayAgg -> ArrayAgg -> Bool
> :: ArrayAgg -> ArrayAgg -> Bool
$c>= :: ArrayAgg -> ArrayAgg -> Bool
>= :: ArrayAgg -> ArrayAgg -> Bool
$cmax :: ArrayAgg -> ArrayAgg -> ArrayAgg
max :: ArrayAgg -> ArrayAgg -> ArrayAgg
$cmin :: ArrayAgg -> ArrayAgg -> ArrayAgg
min :: ArrayAgg -> ArrayAgg -> ArrayAgg
Ord, Int -> ArrayAgg -> ShowS
[ArrayAgg] -> ShowS
ArrayAgg -> String
(Int -> ArrayAgg -> ShowS)
-> (ArrayAgg -> String) -> ([ArrayAgg] -> ShowS) -> Show ArrayAgg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ArrayAgg -> ShowS
showsPrec :: Int -> ArrayAgg -> ShowS
$cshow :: ArrayAgg -> String
show :: ArrayAgg -> String
$cshowList :: [ArrayAgg] -> ShowS
showList :: [ArrayAgg] -> ShowS
Show, (forall x. ArrayAgg -> Rep ArrayAgg x)
-> (forall x. Rep ArrayAgg x -> ArrayAgg) -> Generic ArrayAgg
forall x. Rep ArrayAgg x -> ArrayAgg
forall x. ArrayAgg -> Rep ArrayAgg x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ArrayAgg -> Rep ArrayAgg x
from :: forall x. ArrayAgg -> Rep ArrayAgg x
$cto :: forall x. Rep ArrayAgg x -> ArrayAgg
to :: forall x. Rep ArrayAgg x -> ArrayAgg
Generic, Typeable ArrayAgg
Typeable ArrayAgg
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ArrayAgg -> c ArrayAgg)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ArrayAgg)
-> (ArrayAgg -> Constr)
-> (ArrayAgg -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ArrayAgg))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ArrayAgg))
-> ((forall b. Data b => b -> b) -> ArrayAgg -> ArrayAgg)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ArrayAgg -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ArrayAgg -> r)
-> (forall u. (forall d. Data d => d -> u) -> ArrayAgg -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> ArrayAgg -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ArrayAgg -> m ArrayAgg)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ArrayAgg -> m ArrayAgg)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ArrayAgg -> m ArrayAgg)
-> Data ArrayAgg
ArrayAgg -> Constr
ArrayAgg -> DataType
(forall b. Data b => b -> b) -> ArrayAgg -> ArrayAgg
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ArrayAgg -> u
forall u. (forall d. Data d => d -> u) -> ArrayAgg -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ArrayAgg -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ArrayAgg -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ArrayAgg -> m ArrayAgg
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ArrayAgg -> m ArrayAgg
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArrayAgg
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ArrayAgg -> c ArrayAgg
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ArrayAgg)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ArrayAgg)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ArrayAgg -> c ArrayAgg
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ArrayAgg -> c ArrayAgg
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArrayAgg
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArrayAgg
$ctoConstr :: ArrayAgg -> Constr
toConstr :: ArrayAgg -> Constr
$cdataTypeOf :: ArrayAgg -> DataType
dataTypeOf :: ArrayAgg -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ArrayAgg)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ArrayAgg)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ArrayAgg)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ArrayAgg)
$cgmapT :: (forall b. Data b => b -> b) -> ArrayAgg -> ArrayAgg
gmapT :: (forall b. Data b => b -> b) -> ArrayAgg -> ArrayAgg
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ArrayAgg -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ArrayAgg -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ArrayAgg -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ArrayAgg -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ArrayAgg -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ArrayAgg -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ArrayAgg -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ArrayAgg -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ArrayAgg -> m ArrayAgg
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ArrayAgg -> m ArrayAgg
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ArrayAgg -> m ArrayAgg
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ArrayAgg -> m ArrayAgg
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ArrayAgg -> m ArrayAgg
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ArrayAgg -> m ArrayAgg
Data, (forall (m :: * -> *). Quote m => ArrayAgg -> m Exp)
-> (forall (m :: * -> *). Quote m => ArrayAgg -> Code m ArrayAgg)
-> Lift ArrayAgg
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => ArrayAgg -> m Exp
forall (m :: * -> *). Quote m => ArrayAgg -> Code m ArrayAgg
$clift :: forall (m :: * -> *). Quote m => ArrayAgg -> m Exp
lift :: forall (m :: * -> *). Quote m => ArrayAgg -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => ArrayAgg -> Code m ArrayAgg
liftTyped :: forall (m :: * -> *). Quote m => ArrayAgg -> Code m ArrayAgg
Lift)
  deriving anyclass (Eq ArrayAgg
Eq ArrayAgg
-> (Int -> ArrayAgg -> Int)
-> (ArrayAgg -> Int)
-> Hashable ArrayAgg
Int -> ArrayAgg -> Int
ArrayAgg -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> ArrayAgg -> Int
hashWithSalt :: Int -> ArrayAgg -> Int
$chash :: ArrayAgg -> Int
hash :: ArrayAgg -> Int
Hashable, ArrayAgg -> ()
(ArrayAgg -> ()) -> NFData ArrayAgg
forall a. (a -> ()) -> NFData a
$crnf :: ArrayAgg -> ()
rnf :: ArrayAgg -> ()
NFData)

data Reselect = Reselect
  { Reselect -> NonEmpty Projection
reselectProjections :: NonEmpty Projection,
    Reselect -> Where
reselectWhere :: Where
  }
  deriving stock (Reselect -> Reselect -> Bool
(Reselect -> Reselect -> Bool)
-> (Reselect -> Reselect -> Bool) -> Eq Reselect
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Reselect -> Reselect -> Bool
== :: Reselect -> Reselect -> Bool
$c/= :: Reselect -> Reselect -> Bool
/= :: Reselect -> Reselect -> Bool
Eq, Eq Reselect
Eq Reselect
-> (Reselect -> Reselect -> Ordering)
-> (Reselect -> Reselect -> Bool)
-> (Reselect -> Reselect -> Bool)
-> (Reselect -> Reselect -> Bool)
-> (Reselect -> Reselect -> Bool)
-> (Reselect -> Reselect -> Reselect)
-> (Reselect -> Reselect -> Reselect)
-> Ord Reselect
Reselect -> Reselect -> Bool
Reselect -> Reselect -> Ordering
Reselect -> Reselect -> Reselect
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 :: Reselect -> Reselect -> Ordering
compare :: Reselect -> Reselect -> Ordering
$c< :: Reselect -> Reselect -> Bool
< :: Reselect -> Reselect -> Bool
$c<= :: Reselect -> Reselect -> Bool
<= :: Reselect -> Reselect -> Bool
$c> :: Reselect -> Reselect -> Bool
> :: Reselect -> Reselect -> Bool
$c>= :: Reselect -> Reselect -> Bool
>= :: Reselect -> Reselect -> Bool
$cmax :: Reselect -> Reselect -> Reselect
max :: Reselect -> Reselect -> Reselect
$cmin :: Reselect -> Reselect -> Reselect
min :: Reselect -> Reselect -> Reselect
Ord, Int -> Reselect -> ShowS
[Reselect] -> ShowS
Reselect -> String
(Int -> Reselect -> ShowS)
-> (Reselect -> String) -> ([Reselect] -> ShowS) -> Show Reselect
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Reselect -> ShowS
showsPrec :: Int -> Reselect -> ShowS
$cshow :: Reselect -> String
show :: Reselect -> String
$cshowList :: [Reselect] -> ShowS
showList :: [Reselect] -> ShowS
Show, (forall x. Reselect -> Rep Reselect x)
-> (forall x. Rep Reselect x -> Reselect) -> Generic Reselect
forall x. Rep Reselect x -> Reselect
forall x. Reselect -> Rep Reselect x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Reselect -> Rep Reselect x
from :: forall x. Reselect -> Rep Reselect x
$cto :: forall x. Rep Reselect x -> Reselect
to :: forall x. Rep Reselect x -> Reselect
Generic, Typeable Reselect
Typeable Reselect
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Reselect -> c Reselect)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Reselect)
-> (Reselect -> Constr)
-> (Reselect -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Reselect))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Reselect))
-> ((forall b. Data b => b -> b) -> Reselect -> Reselect)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Reselect -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Reselect -> r)
-> (forall u. (forall d. Data d => d -> u) -> Reselect -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Reselect -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Reselect -> m Reselect)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Reselect -> m Reselect)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Reselect -> m Reselect)
-> Data Reselect
Reselect -> Constr
Reselect -> DataType
(forall b. Data b => b -> b) -> Reselect -> Reselect
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Reselect -> u
forall u. (forall d. Data d => d -> u) -> Reselect -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Reselect -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Reselect -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Reselect -> m Reselect
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Reselect -> m Reselect
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Reselect
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Reselect -> c Reselect
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Reselect)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Reselect)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Reselect -> c Reselect
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Reselect -> c Reselect
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Reselect
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Reselect
$ctoConstr :: Reselect -> Constr
toConstr :: Reselect -> Constr
$cdataTypeOf :: Reselect -> DataType
dataTypeOf :: Reselect -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Reselect)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Reselect)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Reselect)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Reselect)
$cgmapT :: (forall b. Data b => b -> b) -> Reselect -> Reselect
gmapT :: (forall b. Data b => b -> b) -> Reselect -> Reselect
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Reselect -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Reselect -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Reselect -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Reselect -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Reselect -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Reselect -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Reselect -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Reselect -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Reselect -> m Reselect
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Reselect -> m Reselect
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Reselect -> m Reselect
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Reselect -> m Reselect
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Reselect -> m Reselect
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Reselect -> m Reselect
Data, (forall (m :: * -> *). Quote m => Reselect -> m Exp)
-> (forall (m :: * -> *). Quote m => Reselect -> Code m Reselect)
-> Lift Reselect
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Reselect -> m Exp
forall (m :: * -> *). Quote m => Reselect -> Code m Reselect
$clift :: forall (m :: * -> *). Quote m => Reselect -> m Exp
lift :: forall (m :: * -> *). Quote m => Reselect -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Reselect -> Code m Reselect
liftTyped :: forall (m :: * -> *). Quote m => Reselect -> Code m Reselect
Lift)
  deriving anyclass (Eq Reselect
Eq Reselect
-> (Int -> Reselect -> Int)
-> (Reselect -> Int)
-> Hashable Reselect
Int -> Reselect -> Int
Reselect -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Reselect -> Int
hashWithSalt :: Int -> Reselect -> Int
$chash :: Reselect -> Int
hash :: Reselect -> Int
Hashable, Reselect -> ()
(Reselect -> ()) -> NFData Reselect
forall a. (a -> ()) -> NFData a
$crnf :: Reselect -> ()
rnf :: Reselect -> ()
NFData)

data OrderBy = OrderBy
  { OrderBy -> FieldName
orderByFieldName :: FieldName,
    OrderBy -> Order
orderByOrder :: Order,
    OrderBy -> NullsOrder
orderByNullsOrder :: NullsOrder
  }
  deriving stock (OrderBy -> OrderBy -> Bool
(OrderBy -> OrderBy -> Bool)
-> (OrderBy -> OrderBy -> Bool) -> Eq OrderBy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OrderBy -> OrderBy -> Bool
== :: OrderBy -> OrderBy -> Bool
$c/= :: OrderBy -> OrderBy -> Bool
/= :: OrderBy -> OrderBy -> Bool
Eq, Eq OrderBy
Eq OrderBy
-> (OrderBy -> OrderBy -> Ordering)
-> (OrderBy -> OrderBy -> Bool)
-> (OrderBy -> OrderBy -> Bool)
-> (OrderBy -> OrderBy -> Bool)
-> (OrderBy -> OrderBy -> Bool)
-> (OrderBy -> OrderBy -> OrderBy)
-> (OrderBy -> OrderBy -> OrderBy)
-> Ord OrderBy
OrderBy -> OrderBy -> Bool
OrderBy -> OrderBy -> Ordering
OrderBy -> OrderBy -> OrderBy
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 :: OrderBy -> OrderBy -> Ordering
compare :: OrderBy -> OrderBy -> Ordering
$c< :: OrderBy -> OrderBy -> Bool
< :: OrderBy -> OrderBy -> Bool
$c<= :: OrderBy -> OrderBy -> Bool
<= :: OrderBy -> OrderBy -> Bool
$c> :: OrderBy -> OrderBy -> Bool
> :: OrderBy -> OrderBy -> Bool
$c>= :: OrderBy -> OrderBy -> Bool
>= :: OrderBy -> OrderBy -> Bool
$cmax :: OrderBy -> OrderBy -> OrderBy
max :: OrderBy -> OrderBy -> OrderBy
$cmin :: OrderBy -> OrderBy -> OrderBy
min :: OrderBy -> OrderBy -> OrderBy
Ord, Int -> OrderBy -> ShowS
[OrderBy] -> ShowS
OrderBy -> String
(Int -> OrderBy -> ShowS)
-> (OrderBy -> String) -> ([OrderBy] -> ShowS) -> Show OrderBy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OrderBy -> ShowS
showsPrec :: Int -> OrderBy -> ShowS
$cshow :: OrderBy -> String
show :: OrderBy -> String
$cshowList :: [OrderBy] -> ShowS
showList :: [OrderBy] -> ShowS
Show, (forall x. OrderBy -> Rep OrderBy x)
-> (forall x. Rep OrderBy x -> OrderBy) -> Generic OrderBy
forall x. Rep OrderBy x -> OrderBy
forall x. OrderBy -> Rep OrderBy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OrderBy -> Rep OrderBy x
from :: forall x. OrderBy -> Rep OrderBy x
$cto :: forall x. Rep OrderBy x -> OrderBy
to :: forall x. Rep OrderBy x -> OrderBy
Generic, Typeable OrderBy
Typeable OrderBy
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> OrderBy -> c OrderBy)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c OrderBy)
-> (OrderBy -> Constr)
-> (OrderBy -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c OrderBy))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OrderBy))
-> ((forall b. Data b => b -> b) -> OrderBy -> OrderBy)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> OrderBy -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> OrderBy -> r)
-> (forall u. (forall d. Data d => d -> u) -> OrderBy -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> OrderBy -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> OrderBy -> m OrderBy)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> OrderBy -> m OrderBy)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> OrderBy -> m OrderBy)
-> Data OrderBy
OrderBy -> Constr
OrderBy -> DataType
(forall b. Data b => b -> b) -> OrderBy -> OrderBy
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> OrderBy -> u
forall u. (forall d. Data d => d -> u) -> OrderBy -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OrderBy -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OrderBy -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OrderBy -> m OrderBy
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OrderBy -> m OrderBy
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OrderBy
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OrderBy -> c OrderBy
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OrderBy)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OrderBy)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OrderBy -> c OrderBy
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OrderBy -> c OrderBy
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OrderBy
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OrderBy
$ctoConstr :: OrderBy -> Constr
toConstr :: OrderBy -> Constr
$cdataTypeOf :: OrderBy -> DataType
dataTypeOf :: OrderBy -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OrderBy)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OrderBy)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OrderBy)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OrderBy)
$cgmapT :: (forall b. Data b => b -> b) -> OrderBy -> OrderBy
gmapT :: (forall b. Data b => b -> b) -> OrderBy -> OrderBy
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OrderBy -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OrderBy -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OrderBy -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OrderBy -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OrderBy -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> OrderBy -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OrderBy -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OrderBy -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OrderBy -> m OrderBy
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OrderBy -> m OrderBy
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OrderBy -> m OrderBy
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OrderBy -> m OrderBy
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OrderBy -> m OrderBy
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OrderBy -> m OrderBy
Data, (forall (m :: * -> *). Quote m => OrderBy -> m Exp)
-> (forall (m :: * -> *). Quote m => OrderBy -> Code m OrderBy)
-> Lift OrderBy
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => OrderBy -> m Exp
forall (m :: * -> *). Quote m => OrderBy -> Code m OrderBy
$clift :: forall (m :: * -> *). Quote m => OrderBy -> m Exp
lift :: forall (m :: * -> *). Quote m => OrderBy -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => OrderBy -> Code m OrderBy
liftTyped :: forall (m :: * -> *). Quote m => OrderBy -> Code m OrderBy
Lift)
  deriving anyclass (Value -> Parser [OrderBy]
Value -> Parser OrderBy
(Value -> Parser OrderBy)
-> (Value -> Parser [OrderBy]) -> FromJSON OrderBy
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser OrderBy
parseJSON :: Value -> Parser OrderBy
$cparseJSONList :: Value -> Parser [OrderBy]
parseJSONList :: Value -> Parser [OrderBy]
FromJSON, Eq OrderBy
Eq OrderBy
-> (Int -> OrderBy -> Int) -> (OrderBy -> Int) -> Hashable OrderBy
Int -> OrderBy -> Int
OrderBy -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> OrderBy -> Int
hashWithSalt :: Int -> OrderBy -> Int
$chash :: OrderBy -> Int
hash :: OrderBy -> Int
Hashable, OrderBy -> ()
(OrderBy -> ()) -> NFData OrderBy
forall a. (a -> ()) -> NFData a
$crnf :: OrderBy -> ()
rnf :: OrderBy -> ()
NFData, [OrderBy] -> Value
[OrderBy] -> Encoding
OrderBy -> Value
OrderBy -> Encoding
(OrderBy -> Value)
-> (OrderBy -> Encoding)
-> ([OrderBy] -> Value)
-> ([OrderBy] -> Encoding)
-> ToJSON OrderBy
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: OrderBy -> Value
toJSON :: OrderBy -> Value
$ctoEncoding :: OrderBy -> Encoding
toEncoding :: OrderBy -> Encoding
$ctoJSONList :: [OrderBy] -> Value
toJSONList :: [OrderBy] -> Value
$ctoEncodingList :: [OrderBy] -> Encoding
toEncodingList :: [OrderBy] -> Encoding
ToJSON)

data Order
  = AscOrder
  | DescOrder
  deriving stock (Order -> Order -> Bool
(Order -> Order -> Bool) -> (Order -> Order -> Bool) -> Eq Order
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Order -> Order -> Bool
== :: Order -> Order -> Bool
$c/= :: Order -> Order -> Bool
/= :: Order -> Order -> Bool
Eq, Eq Order
Eq Order
-> (Order -> Order -> Ordering)
-> (Order -> Order -> Bool)
-> (Order -> Order -> Bool)
-> (Order -> Order -> Bool)
-> (Order -> Order -> Bool)
-> (Order -> Order -> Order)
-> (Order -> Order -> Order)
-> Ord Order
Order -> Order -> Bool
Order -> Order -> Ordering
Order -> Order -> Order
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 :: Order -> Order -> Ordering
compare :: Order -> Order -> Ordering
$c< :: Order -> Order -> Bool
< :: Order -> Order -> Bool
$c<= :: Order -> Order -> Bool
<= :: Order -> Order -> Bool
$c> :: Order -> Order -> Bool
> :: Order -> Order -> Bool
$c>= :: Order -> Order -> Bool
>= :: Order -> Order -> Bool
$cmax :: Order -> Order -> Order
max :: Order -> Order -> Order
$cmin :: Order -> Order -> Order
min :: Order -> Order -> Order
Ord, Int -> Order -> ShowS
[Order] -> ShowS
Order -> String
(Int -> Order -> ShowS)
-> (Order -> String) -> ([Order] -> ShowS) -> Show Order
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Order -> ShowS
showsPrec :: Int -> Order -> ShowS
$cshow :: Order -> String
show :: Order -> String
$cshowList :: [Order] -> ShowS
showList :: [Order] -> ShowS
Show, (forall x. Order -> Rep Order x)
-> (forall x. Rep Order x -> Order) -> Generic Order
forall x. Rep Order x -> Order
forall x. Order -> Rep Order x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Order -> Rep Order x
from :: forall x. Order -> Rep Order x
$cto :: forall x. Rep Order x -> Order
to :: forall x. Rep Order x -> Order
Generic, Typeable Order
Typeable Order
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Order -> c Order)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Order)
-> (Order -> Constr)
-> (Order -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Order))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Order))
-> ((forall b. Data b => b -> b) -> Order -> Order)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Order -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Order -> r)
-> (forall u. (forall d. Data d => d -> u) -> Order -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Order -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Order -> m Order)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Order -> m Order)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Order -> m Order)
-> Data Order
Order -> Constr
Order -> DataType
(forall b. Data b => b -> b) -> Order -> Order
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Order -> u
forall u. (forall d. Data d => d -> u) -> Order -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Order -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Order -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Order -> m Order
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Order -> m Order
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Order
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Order -> c Order
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Order)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Order)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Order -> c Order
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Order -> c Order
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Order
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Order
$ctoConstr :: Order -> Constr
toConstr :: Order -> Constr
$cdataTypeOf :: Order -> DataType
dataTypeOf :: Order -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Order)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Order)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Order)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Order)
$cgmapT :: (forall b. Data b => b -> b) -> Order -> Order
gmapT :: (forall b. Data b => b -> b) -> Order -> Order
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Order -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Order -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Order -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Order -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Order -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Order -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Order -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Order -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Order -> m Order
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Order -> m Order
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Order -> m Order
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Order -> m Order
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Order -> m Order
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Order -> m Order
Data, (forall (m :: * -> *). Quote m => Order -> m Exp)
-> (forall (m :: * -> *). Quote m => Order -> Code m Order)
-> Lift Order
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Order -> m Exp
forall (m :: * -> *). Quote m => Order -> Code m Order
$clift :: forall (m :: * -> *). Quote m => Order -> m Exp
lift :: forall (m :: * -> *). Quote m => Order -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Order -> Code m Order
liftTyped :: forall (m :: * -> *). Quote m => Order -> Code m Order
Lift)
  deriving anyclass (Value -> Parser [Order]
Value -> Parser Order
(Value -> Parser Order)
-> (Value -> Parser [Order]) -> FromJSON Order
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Order
parseJSON :: Value -> Parser Order
$cparseJSONList :: Value -> Parser [Order]
parseJSONList :: Value -> Parser [Order]
FromJSON, Eq Order
Eq Order
-> (Int -> Order -> Int) -> (Order -> Int) -> Hashable Order
Int -> Order -> Int
Order -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Order -> Int
hashWithSalt :: Int -> Order -> Int
$chash :: Order -> Int
hash :: Order -> Int
Hashable, Order -> ()
(Order -> ()) -> NFData Order
forall a. (a -> ()) -> NFData a
$crnf :: Order -> ()
rnf :: Order -> ()
NFData, [Order] -> Value
[Order] -> Encoding
Order -> Value
Order -> Encoding
(Order -> Value)
-> (Order -> Encoding)
-> ([Order] -> Value)
-> ([Order] -> Encoding)
-> ToJSON Order
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Order -> Value
toJSON :: Order -> Value
$ctoEncoding :: Order -> Encoding
toEncoding :: Order -> Encoding
$ctoJSONList :: [Order] -> Value
toJSONList :: [Order] -> Value
$ctoEncodingList :: [Order] -> Encoding
toEncodingList :: [Order] -> Encoding
ToJSON)

data NullsOrder
  = NullsFirst
  | NullsLast
  | NullsAnyOrder
  deriving stock (NullsOrder -> NullsOrder -> Bool
(NullsOrder -> NullsOrder -> Bool)
-> (NullsOrder -> NullsOrder -> Bool) -> Eq NullsOrder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NullsOrder -> NullsOrder -> Bool
== :: NullsOrder -> NullsOrder -> Bool
$c/= :: NullsOrder -> NullsOrder -> Bool
/= :: NullsOrder -> NullsOrder -> Bool
Eq, Eq NullsOrder
Eq NullsOrder
-> (NullsOrder -> NullsOrder -> Ordering)
-> (NullsOrder -> NullsOrder -> Bool)
-> (NullsOrder -> NullsOrder -> Bool)
-> (NullsOrder -> NullsOrder -> Bool)
-> (NullsOrder -> NullsOrder -> Bool)
-> (NullsOrder -> NullsOrder -> NullsOrder)
-> (NullsOrder -> NullsOrder -> NullsOrder)
-> Ord NullsOrder
NullsOrder -> NullsOrder -> Bool
NullsOrder -> NullsOrder -> Ordering
NullsOrder -> NullsOrder -> NullsOrder
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 :: NullsOrder -> NullsOrder -> Ordering
compare :: NullsOrder -> NullsOrder -> Ordering
$c< :: NullsOrder -> NullsOrder -> Bool
< :: NullsOrder -> NullsOrder -> Bool
$c<= :: NullsOrder -> NullsOrder -> Bool
<= :: NullsOrder -> NullsOrder -> Bool
$c> :: NullsOrder -> NullsOrder -> Bool
> :: NullsOrder -> NullsOrder -> Bool
$c>= :: NullsOrder -> NullsOrder -> Bool
>= :: NullsOrder -> NullsOrder -> Bool
$cmax :: NullsOrder -> NullsOrder -> NullsOrder
max :: NullsOrder -> NullsOrder -> NullsOrder
$cmin :: NullsOrder -> NullsOrder -> NullsOrder
min :: NullsOrder -> NullsOrder -> NullsOrder
Ord, Int -> NullsOrder -> ShowS
[NullsOrder] -> ShowS
NullsOrder -> String
(Int -> NullsOrder -> ShowS)
-> (NullsOrder -> String)
-> ([NullsOrder] -> ShowS)
-> Show NullsOrder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NullsOrder -> ShowS
showsPrec :: Int -> NullsOrder -> ShowS
$cshow :: NullsOrder -> String
show :: NullsOrder -> String
$cshowList :: [NullsOrder] -> ShowS
showList :: [NullsOrder] -> ShowS
Show, (forall x. NullsOrder -> Rep NullsOrder x)
-> (forall x. Rep NullsOrder x -> NullsOrder) -> Generic NullsOrder
forall x. Rep NullsOrder x -> NullsOrder
forall x. NullsOrder -> Rep NullsOrder x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NullsOrder -> Rep NullsOrder x
from :: forall x. NullsOrder -> Rep NullsOrder x
$cto :: forall x. Rep NullsOrder x -> NullsOrder
to :: forall x. Rep NullsOrder x -> NullsOrder
Generic, Typeable NullsOrder
Typeable NullsOrder
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> NullsOrder -> c NullsOrder)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c NullsOrder)
-> (NullsOrder -> Constr)
-> (NullsOrder -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c NullsOrder))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c NullsOrder))
-> ((forall b. Data b => b -> b) -> NullsOrder -> NullsOrder)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> NullsOrder -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> NullsOrder -> r)
-> (forall u. (forall d. Data d => d -> u) -> NullsOrder -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> NullsOrder -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> NullsOrder -> m NullsOrder)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> NullsOrder -> m NullsOrder)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> NullsOrder -> m NullsOrder)
-> Data NullsOrder
NullsOrder -> Constr
NullsOrder -> DataType
(forall b. Data b => b -> b) -> NullsOrder -> NullsOrder
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> NullsOrder -> u
forall u. (forall d. Data d => d -> u) -> NullsOrder -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NullsOrder -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NullsOrder -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NullsOrder -> m NullsOrder
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NullsOrder -> m NullsOrder
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NullsOrder
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NullsOrder -> c NullsOrder
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NullsOrder)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NullsOrder)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NullsOrder -> c NullsOrder
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NullsOrder -> c NullsOrder
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NullsOrder
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NullsOrder
$ctoConstr :: NullsOrder -> Constr
toConstr :: NullsOrder -> Constr
$cdataTypeOf :: NullsOrder -> DataType
dataTypeOf :: NullsOrder -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NullsOrder)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NullsOrder)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NullsOrder)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NullsOrder)
$cgmapT :: (forall b. Data b => b -> b) -> NullsOrder -> NullsOrder
gmapT :: (forall b. Data b => b -> b) -> NullsOrder -> NullsOrder
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NullsOrder -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NullsOrder -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NullsOrder -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NullsOrder -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> NullsOrder -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> NullsOrder -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> NullsOrder -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> NullsOrder -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NullsOrder -> m NullsOrder
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NullsOrder -> m NullsOrder
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NullsOrder -> m NullsOrder
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NullsOrder -> m NullsOrder
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NullsOrder -> m NullsOrder
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NullsOrder -> m NullsOrder
Data, (forall (m :: * -> *). Quote m => NullsOrder -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    NullsOrder -> Code m NullsOrder)
-> Lift NullsOrder
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => NullsOrder -> m Exp
forall (m :: * -> *). Quote m => NullsOrder -> Code m NullsOrder
$clift :: forall (m :: * -> *). Quote m => NullsOrder -> m Exp
lift :: forall (m :: * -> *). Quote m => NullsOrder -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => NullsOrder -> Code m NullsOrder
liftTyped :: forall (m :: * -> *). Quote m => NullsOrder -> Code m NullsOrder
Lift)
  deriving anyclass (Value -> Parser [NullsOrder]
Value -> Parser NullsOrder
(Value -> Parser NullsOrder)
-> (Value -> Parser [NullsOrder]) -> FromJSON NullsOrder
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser NullsOrder
parseJSON :: Value -> Parser NullsOrder
$cparseJSONList :: Value -> Parser [NullsOrder]
parseJSONList :: Value -> Parser [NullsOrder]
FromJSON, Eq NullsOrder
Eq NullsOrder
-> (Int -> NullsOrder -> Int)
-> (NullsOrder -> Int)
-> Hashable NullsOrder
Int -> NullsOrder -> Int
NullsOrder -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> NullsOrder -> Int
hashWithSalt :: Int -> NullsOrder -> Int
$chash :: NullsOrder -> Int
hash :: NullsOrder -> Int
Hashable, NullsOrder -> ()
(NullsOrder -> ()) -> NFData NullsOrder
forall a. (a -> ()) -> NFData a
$crnf :: NullsOrder -> ()
rnf :: NullsOrder -> ()
NFData, [NullsOrder] -> Value
[NullsOrder] -> Encoding
NullsOrder -> Value
NullsOrder -> Encoding
(NullsOrder -> Value)
-> (NullsOrder -> Encoding)
-> ([NullsOrder] -> Value)
-> ([NullsOrder] -> Encoding)
-> ToJSON NullsOrder
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: NullsOrder -> Value
toJSON :: NullsOrder -> Value
$ctoEncoding :: NullsOrder -> Encoding
toEncoding :: NullsOrder -> Encoding
$ctoJSONList :: [NullsOrder] -> Value
toJSONList :: [NullsOrder] -> Value
$ctoEncodingList :: [NullsOrder] -> Encoding
toEncodingList :: [NullsOrder] -> Encoding
ToJSON)

data FieldOrigin
  = NoOrigin
  | AggregateOrigin [Aliased Aggregate]
  deriving stock (FieldOrigin -> FieldOrigin -> Bool
(FieldOrigin -> FieldOrigin -> Bool)
-> (FieldOrigin -> FieldOrigin -> Bool) -> Eq FieldOrigin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FieldOrigin -> FieldOrigin -> Bool
== :: FieldOrigin -> FieldOrigin -> Bool
$c/= :: FieldOrigin -> FieldOrigin -> Bool
/= :: FieldOrigin -> FieldOrigin -> Bool
Eq, Eq FieldOrigin
Eq FieldOrigin
-> (FieldOrigin -> FieldOrigin -> Ordering)
-> (FieldOrigin -> FieldOrigin -> Bool)
-> (FieldOrigin -> FieldOrigin -> Bool)
-> (FieldOrigin -> FieldOrigin -> Bool)
-> (FieldOrigin -> FieldOrigin -> Bool)
-> (FieldOrigin -> FieldOrigin -> FieldOrigin)
-> (FieldOrigin -> FieldOrigin -> FieldOrigin)
-> Ord FieldOrigin
FieldOrigin -> FieldOrigin -> Bool
FieldOrigin -> FieldOrigin -> Ordering
FieldOrigin -> FieldOrigin -> FieldOrigin
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 :: FieldOrigin -> FieldOrigin -> Ordering
compare :: FieldOrigin -> FieldOrigin -> Ordering
$c< :: FieldOrigin -> FieldOrigin -> Bool
< :: FieldOrigin -> FieldOrigin -> Bool
$c<= :: FieldOrigin -> FieldOrigin -> Bool
<= :: FieldOrigin -> FieldOrigin -> Bool
$c> :: FieldOrigin -> FieldOrigin -> Bool
> :: FieldOrigin -> FieldOrigin -> Bool
$c>= :: FieldOrigin -> FieldOrigin -> Bool
>= :: FieldOrigin -> FieldOrigin -> Bool
$cmax :: FieldOrigin -> FieldOrigin -> FieldOrigin
max :: FieldOrigin -> FieldOrigin -> FieldOrigin
$cmin :: FieldOrigin -> FieldOrigin -> FieldOrigin
min :: FieldOrigin -> FieldOrigin -> FieldOrigin
Ord, Int -> FieldOrigin -> ShowS
[FieldOrigin] -> ShowS
FieldOrigin -> String
(Int -> FieldOrigin -> ShowS)
-> (FieldOrigin -> String)
-> ([FieldOrigin] -> ShowS)
-> Show FieldOrigin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FieldOrigin -> ShowS
showsPrec :: Int -> FieldOrigin -> ShowS
$cshow :: FieldOrigin -> String
show :: FieldOrigin -> String
$cshowList :: [FieldOrigin] -> ShowS
showList :: [FieldOrigin] -> ShowS
Show, (forall x. FieldOrigin -> Rep FieldOrigin x)
-> (forall x. Rep FieldOrigin x -> FieldOrigin)
-> Generic FieldOrigin
forall x. Rep FieldOrigin x -> FieldOrigin
forall x. FieldOrigin -> Rep FieldOrigin x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FieldOrigin -> Rep FieldOrigin x
from :: forall x. FieldOrigin -> Rep FieldOrigin x
$cto :: forall x. Rep FieldOrigin x -> FieldOrigin
to :: forall x. Rep FieldOrigin x -> FieldOrigin
Generic, Typeable FieldOrigin
Typeable FieldOrigin
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> FieldOrigin -> c FieldOrigin)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c FieldOrigin)
-> (FieldOrigin -> Constr)
-> (FieldOrigin -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c FieldOrigin))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c FieldOrigin))
-> ((forall b. Data b => b -> b) -> FieldOrigin -> FieldOrigin)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> FieldOrigin -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> FieldOrigin -> r)
-> (forall u. (forall d. Data d => d -> u) -> FieldOrigin -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> FieldOrigin -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> FieldOrigin -> m FieldOrigin)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FieldOrigin -> m FieldOrigin)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FieldOrigin -> m FieldOrigin)
-> Data FieldOrigin
FieldOrigin -> Constr
FieldOrigin -> DataType
(forall b. Data b => b -> b) -> FieldOrigin -> FieldOrigin
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> FieldOrigin -> u
forall u. (forall d. Data d => d -> u) -> FieldOrigin -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FieldOrigin -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FieldOrigin -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FieldOrigin -> m FieldOrigin
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FieldOrigin -> m FieldOrigin
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FieldOrigin
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FieldOrigin -> c FieldOrigin
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FieldOrigin)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FieldOrigin)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FieldOrigin -> c FieldOrigin
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FieldOrigin -> c FieldOrigin
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FieldOrigin
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FieldOrigin
$ctoConstr :: FieldOrigin -> Constr
toConstr :: FieldOrigin -> Constr
$cdataTypeOf :: FieldOrigin -> DataType
dataTypeOf :: FieldOrigin -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FieldOrigin)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FieldOrigin)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FieldOrigin)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FieldOrigin)
$cgmapT :: (forall b. Data b => b -> b) -> FieldOrigin -> FieldOrigin
gmapT :: (forall b. Data b => b -> b) -> FieldOrigin -> FieldOrigin
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FieldOrigin -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FieldOrigin -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FieldOrigin -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FieldOrigin -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FieldOrigin -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> FieldOrigin -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FieldOrigin -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FieldOrigin -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FieldOrigin -> m FieldOrigin
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FieldOrigin -> m FieldOrigin
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FieldOrigin -> m FieldOrigin
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FieldOrigin -> m FieldOrigin
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FieldOrigin -> m FieldOrigin
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FieldOrigin -> m FieldOrigin
Data, (forall (m :: * -> *). Quote m => FieldOrigin -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    FieldOrigin -> Code m FieldOrigin)
-> Lift FieldOrigin
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => FieldOrigin -> m Exp
forall (m :: * -> *). Quote m => FieldOrigin -> Code m FieldOrigin
$clift :: forall (m :: * -> *). Quote m => FieldOrigin -> m Exp
lift :: forall (m :: * -> *). Quote m => FieldOrigin -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => FieldOrigin -> Code m FieldOrigin
liftTyped :: forall (m :: * -> *). Quote m => FieldOrigin -> Code m FieldOrigin
Lift)
  deriving anyclass (Eq FieldOrigin
Eq FieldOrigin
-> (Int -> FieldOrigin -> Int)
-> (FieldOrigin -> Int)
-> Hashable FieldOrigin
Int -> FieldOrigin -> Int
FieldOrigin -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> FieldOrigin -> Int
hashWithSalt :: Int -> FieldOrigin -> Int
$chash :: FieldOrigin -> Int
hash :: FieldOrigin -> Int
Hashable, FieldOrigin -> ()
(FieldOrigin -> ()) -> NFData FieldOrigin
forall a. (a -> ()) -> NFData a
$crnf :: FieldOrigin -> ()
rnf :: FieldOrigin -> ()
NFData)

aggregateProjectionsFieldOrigin :: Projection -> FieldOrigin
aggregateProjectionsFieldOrigin :: Projection -> FieldOrigin
aggregateProjectionsFieldOrigin = \case
  AggregateProjections Aliased (NonEmpty (Aliased Aggregate))
a -> [Aliased Aggregate] -> FieldOrigin
AggregateOrigin ([Aliased Aggregate] -> FieldOrigin)
-> (Aliased (NonEmpty (Aliased Aggregate)) -> [Aliased Aggregate])
-> Aliased (NonEmpty (Aliased Aggregate))
-> FieldOrigin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Aliased Aggregate) -> [Aliased Aggregate]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty (Aliased Aggregate) -> [Aliased Aggregate])
-> (Aliased (NonEmpty (Aliased Aggregate))
    -> NonEmpty (Aliased Aggregate))
-> Aliased (NonEmpty (Aliased Aggregate))
-> [Aliased Aggregate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Aliased (NonEmpty (Aliased Aggregate))
-> NonEmpty (Aliased Aggregate)
forall a. Aliased a -> a
aliasedThing (Aliased (NonEmpty (Aliased Aggregate)) -> FieldOrigin)
-> Aliased (NonEmpty (Aliased Aggregate)) -> FieldOrigin
forall a b. (a -> b) -> a -> b
$ Aliased (NonEmpty (Aliased Aggregate))
a
  AggregateProjection Aliased Aggregate
a -> [Aliased Aggregate] -> FieldOrigin
AggregateOrigin [Aliased Aggregate
a]
  Projection
_ -> FieldOrigin
NoOrigin

data Projection
  = ExpressionProjection (Aliased Expression)
  | FieldNameProjection (Aliased FieldName)
  | AggregateProjections (Aliased (NonEmpty (Aliased Aggregate)))
  | AggregateProjection (Aliased Aggregate)
  | StarProjection
  | ArrayAggProjection (Aliased ArrayAgg)
  | EntityProjection (Aliased [(FieldName, FieldOrigin)])
  | ArrayEntityProjection EntityAlias (Aliased [FieldName])
  | WindowProjection (Aliased WindowFunction)
  deriving stock (Projection -> Projection -> Bool
(Projection -> Projection -> Bool)
-> (Projection -> Projection -> Bool) -> Eq Projection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Projection -> Projection -> Bool
== :: Projection -> Projection -> Bool
$c/= :: Projection -> Projection -> Bool
/= :: Projection -> Projection -> Bool
Eq, Int -> Projection -> ShowS
[Projection] -> ShowS
Projection -> String
(Int -> Projection -> ShowS)
-> (Projection -> String)
-> ([Projection] -> ShowS)
-> Show Projection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Projection -> ShowS
showsPrec :: Int -> Projection -> ShowS
$cshow :: Projection -> String
show :: Projection -> String
$cshowList :: [Projection] -> ShowS
showList :: [Projection] -> ShowS
Show, (forall x. Projection -> Rep Projection x)
-> (forall x. Rep Projection x -> Projection) -> Generic Projection
forall x. Rep Projection x -> Projection
forall x. Projection -> Rep Projection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Projection -> Rep Projection x
from :: forall x. Projection -> Rep Projection x
$cto :: forall x. Rep Projection x -> Projection
to :: forall x. Rep Projection x -> Projection
Generic, Typeable Projection
Typeable Projection
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Projection -> c Projection)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Projection)
-> (Projection -> Constr)
-> (Projection -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Projection))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Projection))
-> ((forall b. Data b => b -> b) -> Projection -> Projection)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Projection -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Projection -> r)
-> (forall u. (forall d. Data d => d -> u) -> Projection -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Projection -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Projection -> m Projection)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Projection -> m Projection)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Projection -> m Projection)
-> Data Projection
Projection -> Constr
Projection -> DataType
(forall b. Data b => b -> b) -> Projection -> Projection
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Projection -> u
forall u. (forall d. Data d => d -> u) -> Projection -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Projection -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Projection -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Projection -> m Projection
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Projection -> m Projection
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Projection
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Projection -> c Projection
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Projection)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Projection)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Projection -> c Projection
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Projection -> c Projection
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Projection
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Projection
$ctoConstr :: Projection -> Constr
toConstr :: Projection -> Constr
$cdataTypeOf :: Projection -> DataType
dataTypeOf :: Projection -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Projection)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Projection)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Projection)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Projection)
$cgmapT :: (forall b. Data b => b -> b) -> Projection -> Projection
gmapT :: (forall b. Data b => b -> b) -> Projection -> Projection
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Projection -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Projection -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Projection -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Projection -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Projection -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Projection -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Projection -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Projection -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Projection -> m Projection
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Projection -> m Projection
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Projection -> m Projection
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Projection -> m Projection
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Projection -> m Projection
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Projection -> m Projection
Data, (forall (m :: * -> *). Quote m => Projection -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    Projection -> Code m Projection)
-> Lift Projection
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Projection -> m Exp
forall (m :: * -> *). Quote m => Projection -> Code m Projection
$clift :: forall (m :: * -> *). Quote m => Projection -> m Exp
lift :: forall (m :: * -> *). Quote m => Projection -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Projection -> Code m Projection
liftTyped :: forall (m :: * -> *). Quote m => Projection -> Code m Projection
Lift, Eq Projection
Eq Projection
-> (Projection -> Projection -> Ordering)
-> (Projection -> Projection -> Bool)
-> (Projection -> Projection -> Bool)
-> (Projection -> Projection -> Bool)
-> (Projection -> Projection -> Bool)
-> (Projection -> Projection -> Projection)
-> (Projection -> Projection -> Projection)
-> Ord Projection
Projection -> Projection -> Bool
Projection -> Projection -> Ordering
Projection -> Projection -> Projection
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 :: Projection -> Projection -> Ordering
compare :: Projection -> Projection -> Ordering
$c< :: Projection -> Projection -> Bool
< :: Projection -> Projection -> Bool
$c<= :: Projection -> Projection -> Bool
<= :: Projection -> Projection -> Bool
$c> :: Projection -> Projection -> Bool
> :: Projection -> Projection -> Bool
$c>= :: Projection -> Projection -> Bool
>= :: Projection -> Projection -> Bool
$cmax :: Projection -> Projection -> Projection
max :: Projection -> Projection -> Projection
$cmin :: Projection -> Projection -> Projection
min :: Projection -> Projection -> Projection
Ord)
  deriving anyclass (Eq Projection
Eq Projection
-> (Int -> Projection -> Int)
-> (Projection -> Int)
-> Hashable Projection
Int -> Projection -> Int
Projection -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Projection -> Int
hashWithSalt :: Int -> Projection -> Int
$chash :: Projection -> Int
hash :: Projection -> Int
Hashable, Projection -> ()
(Projection -> ()) -> NFData Projection
forall a. (a -> ()) -> NFData a
$crnf :: Projection -> ()
rnf :: Projection -> ()
NFData)

data WindowFunction
  = -- | ROW_NUMBER() OVER(PARTITION BY field)
    RowNumberOverPartitionBy (NonEmpty FieldName) (Maybe (NonEmpty OrderBy))
  deriving stock (WindowFunction -> WindowFunction -> Bool
(WindowFunction -> WindowFunction -> Bool)
-> (WindowFunction -> WindowFunction -> Bool) -> Eq WindowFunction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WindowFunction -> WindowFunction -> Bool
== :: WindowFunction -> WindowFunction -> Bool
$c/= :: WindowFunction -> WindowFunction -> Bool
/= :: WindowFunction -> WindowFunction -> Bool
Eq, Int -> WindowFunction -> ShowS
[WindowFunction] -> ShowS
WindowFunction -> String
(Int -> WindowFunction -> ShowS)
-> (WindowFunction -> String)
-> ([WindowFunction] -> ShowS)
-> Show WindowFunction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WindowFunction -> ShowS
showsPrec :: Int -> WindowFunction -> ShowS
$cshow :: WindowFunction -> String
show :: WindowFunction -> String
$cshowList :: [WindowFunction] -> ShowS
showList :: [WindowFunction] -> ShowS
Show, (forall x. WindowFunction -> Rep WindowFunction x)
-> (forall x. Rep WindowFunction x -> WindowFunction)
-> Generic WindowFunction
forall x. Rep WindowFunction x -> WindowFunction
forall x. WindowFunction -> Rep WindowFunction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. WindowFunction -> Rep WindowFunction x
from :: forall x. WindowFunction -> Rep WindowFunction x
$cto :: forall x. Rep WindowFunction x -> WindowFunction
to :: forall x. Rep WindowFunction x -> WindowFunction
Generic, Typeable WindowFunction
Typeable WindowFunction
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> WindowFunction -> c WindowFunction)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c WindowFunction)
-> (WindowFunction -> Constr)
-> (WindowFunction -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c WindowFunction))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c WindowFunction))
-> ((forall b. Data b => b -> b)
    -> WindowFunction -> WindowFunction)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> WindowFunction -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> WindowFunction -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> WindowFunction -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> WindowFunction -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> WindowFunction -> m WindowFunction)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> WindowFunction -> m WindowFunction)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> WindowFunction -> m WindowFunction)
-> Data WindowFunction
WindowFunction -> Constr
WindowFunction -> DataType
(forall b. Data b => b -> b) -> WindowFunction -> WindowFunction
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> WindowFunction -> u
forall u. (forall d. Data d => d -> u) -> WindowFunction -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WindowFunction -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WindowFunction -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> WindowFunction -> m WindowFunction
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> WindowFunction -> m WindowFunction
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WindowFunction
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WindowFunction -> c WindowFunction
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WindowFunction)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c WindowFunction)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WindowFunction -> c WindowFunction
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WindowFunction -> c WindowFunction
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WindowFunction
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WindowFunction
$ctoConstr :: WindowFunction -> Constr
toConstr :: WindowFunction -> Constr
$cdataTypeOf :: WindowFunction -> DataType
dataTypeOf :: WindowFunction -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WindowFunction)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WindowFunction)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c WindowFunction)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c WindowFunction)
$cgmapT :: (forall b. Data b => b -> b) -> WindowFunction -> WindowFunction
gmapT :: (forall b. Data b => b -> b) -> WindowFunction -> WindowFunction
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WindowFunction -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WindowFunction -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WindowFunction -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WindowFunction -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> WindowFunction -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> WindowFunction -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> WindowFunction -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> WindowFunction -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> WindowFunction -> m WindowFunction
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> WindowFunction -> m WindowFunction
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> WindowFunction -> m WindowFunction
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> WindowFunction -> m WindowFunction
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> WindowFunction -> m WindowFunction
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> WindowFunction -> m WindowFunction
Data, (forall (m :: * -> *). Quote m => WindowFunction -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    WindowFunction -> Code m WindowFunction)
-> Lift WindowFunction
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => WindowFunction -> m Exp
forall (m :: * -> *).
Quote m =>
WindowFunction -> Code m WindowFunction
$clift :: forall (m :: * -> *). Quote m => WindowFunction -> m Exp
lift :: forall (m :: * -> *). Quote m => WindowFunction -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
WindowFunction -> Code m WindowFunction
liftTyped :: forall (m :: * -> *).
Quote m =>
WindowFunction -> Code m WindowFunction
Lift, Eq WindowFunction
Eq WindowFunction
-> (WindowFunction -> WindowFunction -> Ordering)
-> (WindowFunction -> WindowFunction -> Bool)
-> (WindowFunction -> WindowFunction -> Bool)
-> (WindowFunction -> WindowFunction -> Bool)
-> (WindowFunction -> WindowFunction -> Bool)
-> (WindowFunction -> WindowFunction -> WindowFunction)
-> (WindowFunction -> WindowFunction -> WindowFunction)
-> Ord WindowFunction
WindowFunction -> WindowFunction -> Bool
WindowFunction -> WindowFunction -> Ordering
WindowFunction -> WindowFunction -> WindowFunction
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 :: WindowFunction -> WindowFunction -> Ordering
compare :: WindowFunction -> WindowFunction -> Ordering
$c< :: WindowFunction -> WindowFunction -> Bool
< :: WindowFunction -> WindowFunction -> Bool
$c<= :: WindowFunction -> WindowFunction -> Bool
<= :: WindowFunction -> WindowFunction -> Bool
$c> :: WindowFunction -> WindowFunction -> Bool
> :: WindowFunction -> WindowFunction -> Bool
$c>= :: WindowFunction -> WindowFunction -> Bool
>= :: WindowFunction -> WindowFunction -> Bool
$cmax :: WindowFunction -> WindowFunction -> WindowFunction
max :: WindowFunction -> WindowFunction -> WindowFunction
$cmin :: WindowFunction -> WindowFunction -> WindowFunction
min :: WindowFunction -> WindowFunction -> WindowFunction
Ord)
  deriving anyclass (Value -> Parser [WindowFunction]
Value -> Parser WindowFunction
(Value -> Parser WindowFunction)
-> (Value -> Parser [WindowFunction]) -> FromJSON WindowFunction
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser WindowFunction
parseJSON :: Value -> Parser WindowFunction
$cparseJSONList :: Value -> Parser [WindowFunction]
parseJSONList :: Value -> Parser [WindowFunction]
FromJSON, Eq WindowFunction
Eq WindowFunction
-> (Int -> WindowFunction -> Int)
-> (WindowFunction -> Int)
-> Hashable WindowFunction
Int -> WindowFunction -> Int
WindowFunction -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> WindowFunction -> Int
hashWithSalt :: Int -> WindowFunction -> Int
$chash :: WindowFunction -> Int
hash :: WindowFunction -> Int
Hashable, WindowFunction -> ()
(WindowFunction -> ()) -> NFData WindowFunction
forall a. (a -> ()) -> NFData a
$crnf :: WindowFunction -> ()
rnf :: WindowFunction -> ()
NFData, [WindowFunction] -> Value
[WindowFunction] -> Encoding
WindowFunction -> Value
WindowFunction -> Encoding
(WindowFunction -> Value)
-> (WindowFunction -> Encoding)
-> ([WindowFunction] -> Value)
-> ([WindowFunction] -> Encoding)
-> ToJSON WindowFunction
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: WindowFunction -> Value
toJSON :: WindowFunction -> Value
$ctoEncoding :: WindowFunction -> Encoding
toEncoding :: WindowFunction -> Encoding
$ctoJSONList :: [WindowFunction] -> Value
toJSONList :: [WindowFunction] -> Value
$ctoEncodingList :: [WindowFunction] -> Encoding
toEncodingList :: [WindowFunction] -> Encoding
ToJSON)

data JoinType = LeftOuter | Inner
  deriving stock (JoinType -> JoinType -> Bool
(JoinType -> JoinType -> Bool)
-> (JoinType -> JoinType -> Bool) -> Eq JoinType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JoinType -> JoinType -> Bool
== :: JoinType -> JoinType -> Bool
$c/= :: JoinType -> JoinType -> Bool
/= :: JoinType -> JoinType -> Bool
Eq, Int -> JoinType -> ShowS
[JoinType] -> ShowS
JoinType -> String
(Int -> JoinType -> ShowS)
-> (JoinType -> String) -> ([JoinType] -> ShowS) -> Show JoinType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JoinType -> ShowS
showsPrec :: Int -> JoinType -> ShowS
$cshow :: JoinType -> String
show :: JoinType -> String
$cshowList :: [JoinType] -> ShowS
showList :: [JoinType] -> ShowS
Show, (forall x. JoinType -> Rep JoinType x)
-> (forall x. Rep JoinType x -> JoinType) -> Generic JoinType
forall x. Rep JoinType x -> JoinType
forall x. JoinType -> Rep JoinType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JoinType -> Rep JoinType x
from :: forall x. JoinType -> Rep JoinType x
$cto :: forall x. Rep JoinType x -> JoinType
to :: forall x. Rep JoinType x -> JoinType
Generic, Typeable JoinType
Typeable JoinType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> JoinType -> c JoinType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c JoinType)
-> (JoinType -> Constr)
-> (JoinType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c JoinType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JoinType))
-> ((forall b. Data b => b -> b) -> JoinType -> JoinType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> JoinType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> JoinType -> r)
-> (forall u. (forall d. Data d => d -> u) -> JoinType -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> JoinType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> JoinType -> m JoinType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> JoinType -> m JoinType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> JoinType -> m JoinType)
-> Data JoinType
JoinType -> Constr
JoinType -> DataType
(forall b. Data b => b -> b) -> JoinType -> JoinType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> JoinType -> u
forall u. (forall d. Data d => d -> u) -> JoinType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JoinType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JoinType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JoinType -> m JoinType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JoinType -> m JoinType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoinType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JoinType -> c JoinType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JoinType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JoinType)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JoinType -> c JoinType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JoinType -> c JoinType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoinType
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoinType
$ctoConstr :: JoinType -> Constr
toConstr :: JoinType -> Constr
$cdataTypeOf :: JoinType -> DataType
dataTypeOf :: JoinType -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JoinType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JoinType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JoinType)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JoinType)
$cgmapT :: (forall b. Data b => b -> b) -> JoinType -> JoinType
gmapT :: (forall b. Data b => b -> b) -> JoinType -> JoinType
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JoinType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JoinType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JoinType -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JoinType -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> JoinType -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> JoinType -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JoinType -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JoinType -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JoinType -> m JoinType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JoinType -> m JoinType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JoinType -> m JoinType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JoinType -> m JoinType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JoinType -> m JoinType
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JoinType -> m JoinType
Data, (forall (m :: * -> *). Quote m => JoinType -> m Exp)
-> (forall (m :: * -> *). Quote m => JoinType -> Code m JoinType)
-> Lift JoinType
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => JoinType -> m Exp
forall (m :: * -> *). Quote m => JoinType -> Code m JoinType
$clift :: forall (m :: * -> *). Quote m => JoinType -> m Exp
lift :: forall (m :: * -> *). Quote m => JoinType -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => JoinType -> Code m JoinType
liftTyped :: forall (m :: * -> *). Quote m => JoinType -> Code m JoinType
Lift, Eq JoinType
Eq JoinType
-> (JoinType -> JoinType -> Ordering)
-> (JoinType -> JoinType -> Bool)
-> (JoinType -> JoinType -> Bool)
-> (JoinType -> JoinType -> Bool)
-> (JoinType -> JoinType -> Bool)
-> (JoinType -> JoinType -> JoinType)
-> (JoinType -> JoinType -> JoinType)
-> Ord JoinType
JoinType -> JoinType -> Bool
JoinType -> JoinType -> Ordering
JoinType -> JoinType -> JoinType
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 :: JoinType -> JoinType -> Ordering
compare :: JoinType -> JoinType -> Ordering
$c< :: JoinType -> JoinType -> Bool
< :: JoinType -> JoinType -> Bool
$c<= :: JoinType -> JoinType -> Bool
<= :: JoinType -> JoinType -> Bool
$c> :: JoinType -> JoinType -> Bool
> :: JoinType -> JoinType -> Bool
$c>= :: JoinType -> JoinType -> Bool
>= :: JoinType -> JoinType -> Bool
$cmax :: JoinType -> JoinType -> JoinType
max :: JoinType -> JoinType -> JoinType
$cmin :: JoinType -> JoinType -> JoinType
min :: JoinType -> JoinType -> JoinType
Ord)
  deriving anyclass (Value -> Parser [JoinType]
Value -> Parser JoinType
(Value -> Parser JoinType)
-> (Value -> Parser [JoinType]) -> FromJSON JoinType
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser JoinType
parseJSON :: Value -> Parser JoinType
$cparseJSONList :: Value -> Parser [JoinType]
parseJSONList :: Value -> Parser [JoinType]
FromJSON, Eq JoinType
Eq JoinType
-> (Int -> JoinType -> Int)
-> (JoinType -> Int)
-> Hashable JoinType
Int -> JoinType -> Int
JoinType -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> JoinType -> Int
hashWithSalt :: Int -> JoinType -> Int
$chash :: JoinType -> Int
hash :: JoinType -> Int
Hashable, JoinType -> ()
(JoinType -> ()) -> NFData JoinType
forall a. (a -> ()) -> NFData a
$crnf :: JoinType -> ()
rnf :: JoinType -> ()
NFData, [JoinType] -> Value
[JoinType] -> Encoding
JoinType -> Value
JoinType -> Encoding
(JoinType -> Value)
-> (JoinType -> Encoding)
-> ([JoinType] -> Value)
-> ([JoinType] -> Encoding)
-> ToJSON JoinType
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: JoinType -> Value
toJSON :: JoinType -> Value
$ctoEncoding :: JoinType -> Encoding
toEncoding :: JoinType -> Encoding
$ctoJSONList :: [JoinType] -> Value
toJSONList :: [JoinType] -> Value
$ctoEncodingList :: [JoinType] -> Encoding
toEncodingList :: [JoinType] -> Encoding
ToJSON)

data Join = Join
  { Join -> JoinSource
joinSource :: JoinSource,
    Join -> EntityAlias
joinAlias :: EntityAlias,
    Join -> [(FieldName, FieldName)]
joinOn :: [(FieldName, FieldName)],
    Join -> JoinProvenance
joinProvenance :: JoinProvenance,
    Join -> Text
joinFieldName :: Text,
    Join -> Maybe Text
joinExtractPath :: Maybe Text,
    Join -> EntityAlias
joinRightTable :: EntityAlias,
    Join -> JoinType
joinType :: JoinType
  }
  deriving stock (Join -> Join -> Bool
(Join -> Join -> Bool) -> (Join -> Join -> Bool) -> Eq Join
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Join -> Join -> Bool
== :: Join -> Join -> Bool
$c/= :: Join -> Join -> Bool
/= :: Join -> Join -> Bool
Eq, Eq Join
Eq Join
-> (Join -> Join -> Ordering)
-> (Join -> Join -> Bool)
-> (Join -> Join -> Bool)
-> (Join -> Join -> Bool)
-> (Join -> Join -> Bool)
-> (Join -> Join -> Join)
-> (Join -> Join -> Join)
-> Ord Join
Join -> Join -> Bool
Join -> Join -> Ordering
Join -> Join -> Join
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 :: Join -> Join -> Ordering
compare :: Join -> Join -> Ordering
$c< :: Join -> Join -> Bool
< :: Join -> Join -> Bool
$c<= :: Join -> Join -> Bool
<= :: Join -> Join -> Bool
$c> :: Join -> Join -> Bool
> :: Join -> Join -> Bool
$c>= :: Join -> Join -> Bool
>= :: Join -> Join -> Bool
$cmax :: Join -> Join -> Join
max :: Join -> Join -> Join
$cmin :: Join -> Join -> Join
min :: Join -> Join -> Join
Ord, Int -> Join -> ShowS
[Join] -> ShowS
Join -> String
(Int -> Join -> ShowS)
-> (Join -> String) -> ([Join] -> ShowS) -> Show Join
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Join -> ShowS
showsPrec :: Int -> Join -> ShowS
$cshow :: Join -> String
show :: Join -> String
$cshowList :: [Join] -> ShowS
showList :: [Join] -> ShowS
Show, (forall x. Join -> Rep Join x)
-> (forall x. Rep Join x -> Join) -> Generic Join
forall x. Rep Join x -> Join
forall x. Join -> Rep Join x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Join -> Rep Join x
from :: forall x. Join -> Rep Join x
$cto :: forall x. Rep Join x -> Join
to :: forall x. Rep Join x -> Join
Generic, Typeable Join
Typeable Join
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Join -> c Join)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Join)
-> (Join -> Constr)
-> (Join -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Join))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Join))
-> ((forall b. Data b => b -> b) -> Join -> Join)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Join -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Join -> r)
-> (forall u. (forall d. Data d => d -> u) -> Join -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Join -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Join -> m Join)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Join -> m Join)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Join -> m Join)
-> Data Join
Join -> Constr
Join -> DataType
(forall b. Data b => b -> b) -> Join -> Join
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Join -> u
forall u. (forall d. Data d => d -> u) -> Join -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Join -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Join -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Join -> m Join
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Join -> m Join
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Join
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Join -> c Join
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Join)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Join)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Join -> c Join
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Join -> c Join
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Join
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Join
$ctoConstr :: Join -> Constr
toConstr :: Join -> Constr
$cdataTypeOf :: Join -> DataType
dataTypeOf :: Join -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Join)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Join)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Join)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Join)
$cgmapT :: (forall b. Data b => b -> b) -> Join -> Join
gmapT :: (forall b. Data b => b -> b) -> Join -> Join
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Join -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Join -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Join -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Join -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Join -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Join -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Join -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Join -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Join -> m Join
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Join -> m Join
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Join -> m Join
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Join -> m Join
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Join -> m Join
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Join -> m Join
Data, (forall (m :: * -> *). Quote m => Join -> m Exp)
-> (forall (m :: * -> *). Quote m => Join -> Code m Join)
-> Lift Join
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Join -> m Exp
forall (m :: * -> *). Quote m => Join -> Code m Join
$clift :: forall (m :: * -> *). Quote m => Join -> m Exp
lift :: forall (m :: * -> *). Quote m => Join -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Join -> Code m Join
liftTyped :: forall (m :: * -> *). Quote m => Join -> Code m Join
Lift)
  deriving anyclass (Eq Join
Eq Join -> (Int -> Join -> Int) -> (Join -> Int) -> Hashable Join
Int -> Join -> Int
Join -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Join -> Int
hashWithSalt :: Int -> Join -> Int
$chash :: Join -> Int
hash :: Join -> Int
Hashable, Join -> ()
(Join -> ()) -> NFData Join
forall a. (a -> ()) -> NFData a
$crnf :: Join -> ()
rnf :: Join -> ()
NFData)

data JoinProvenance
  = OrderByJoinProvenance
  | ObjectJoinProvenance [Text]
  | ArrayAggregateJoinProvenance [(Text, FieldOrigin)]
  | ArrayJoinProvenance [Text]
  | MultiplexProvenance
  deriving stock (JoinProvenance -> JoinProvenance -> Bool
(JoinProvenance -> JoinProvenance -> Bool)
-> (JoinProvenance -> JoinProvenance -> Bool) -> Eq JoinProvenance
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JoinProvenance -> JoinProvenance -> Bool
== :: JoinProvenance -> JoinProvenance -> Bool
$c/= :: JoinProvenance -> JoinProvenance -> Bool
/= :: JoinProvenance -> JoinProvenance -> Bool
Eq, Eq JoinProvenance
Eq JoinProvenance
-> (JoinProvenance -> JoinProvenance -> Ordering)
-> (JoinProvenance -> JoinProvenance -> Bool)
-> (JoinProvenance -> JoinProvenance -> Bool)
-> (JoinProvenance -> JoinProvenance -> Bool)
-> (JoinProvenance -> JoinProvenance -> Bool)
-> (JoinProvenance -> JoinProvenance -> JoinProvenance)
-> (JoinProvenance -> JoinProvenance -> JoinProvenance)
-> Ord JoinProvenance
JoinProvenance -> JoinProvenance -> Bool
JoinProvenance -> JoinProvenance -> Ordering
JoinProvenance -> JoinProvenance -> JoinProvenance
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 :: JoinProvenance -> JoinProvenance -> Ordering
compare :: JoinProvenance -> JoinProvenance -> Ordering
$c< :: JoinProvenance -> JoinProvenance -> Bool
< :: JoinProvenance -> JoinProvenance -> Bool
$c<= :: JoinProvenance -> JoinProvenance -> Bool
<= :: JoinProvenance -> JoinProvenance -> Bool
$c> :: JoinProvenance -> JoinProvenance -> Bool
> :: JoinProvenance -> JoinProvenance -> Bool
$c>= :: JoinProvenance -> JoinProvenance -> Bool
>= :: JoinProvenance -> JoinProvenance -> Bool
$cmax :: JoinProvenance -> JoinProvenance -> JoinProvenance
max :: JoinProvenance -> JoinProvenance -> JoinProvenance
$cmin :: JoinProvenance -> JoinProvenance -> JoinProvenance
min :: JoinProvenance -> JoinProvenance -> JoinProvenance
Ord, Int -> JoinProvenance -> ShowS
[JoinProvenance] -> ShowS
JoinProvenance -> String
(Int -> JoinProvenance -> ShowS)
-> (JoinProvenance -> String)
-> ([JoinProvenance] -> ShowS)
-> Show JoinProvenance
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JoinProvenance -> ShowS
showsPrec :: Int -> JoinProvenance -> ShowS
$cshow :: JoinProvenance -> String
show :: JoinProvenance -> String
$cshowList :: [JoinProvenance] -> ShowS
showList :: [JoinProvenance] -> ShowS
Show, (forall x. JoinProvenance -> Rep JoinProvenance x)
-> (forall x. Rep JoinProvenance x -> JoinProvenance)
-> Generic JoinProvenance
forall x. Rep JoinProvenance x -> JoinProvenance
forall x. JoinProvenance -> Rep JoinProvenance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JoinProvenance -> Rep JoinProvenance x
from :: forall x. JoinProvenance -> Rep JoinProvenance x
$cto :: forall x. Rep JoinProvenance x -> JoinProvenance
to :: forall x. Rep JoinProvenance x -> JoinProvenance
Generic, Typeable JoinProvenance
Typeable JoinProvenance
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> JoinProvenance -> c JoinProvenance)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c JoinProvenance)
-> (JoinProvenance -> Constr)
-> (JoinProvenance -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c JoinProvenance))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c JoinProvenance))
-> ((forall b. Data b => b -> b)
    -> JoinProvenance -> JoinProvenance)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> JoinProvenance -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> JoinProvenance -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> JoinProvenance -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> JoinProvenance -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> JoinProvenance -> m JoinProvenance)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> JoinProvenance -> m JoinProvenance)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> JoinProvenance -> m JoinProvenance)
-> Data JoinProvenance
JoinProvenance -> Constr
JoinProvenance -> DataType
(forall b. Data b => b -> b) -> JoinProvenance -> JoinProvenance
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> JoinProvenance -> u
forall u. (forall d. Data d => d -> u) -> JoinProvenance -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JoinProvenance -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JoinProvenance -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> JoinProvenance -> m JoinProvenance
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> JoinProvenance -> m JoinProvenance
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoinProvenance
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JoinProvenance -> c JoinProvenance
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JoinProvenance)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c JoinProvenance)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JoinProvenance -> c JoinProvenance
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JoinProvenance -> c JoinProvenance
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoinProvenance
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoinProvenance
$ctoConstr :: JoinProvenance -> Constr
toConstr :: JoinProvenance -> Constr
$cdataTypeOf :: JoinProvenance -> DataType
dataTypeOf :: JoinProvenance -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JoinProvenance)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JoinProvenance)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c JoinProvenance)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c JoinProvenance)
$cgmapT :: (forall b. Data b => b -> b) -> JoinProvenance -> JoinProvenance
gmapT :: (forall b. Data b => b -> b) -> JoinProvenance -> JoinProvenance
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JoinProvenance -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JoinProvenance -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JoinProvenance -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JoinProvenance -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> JoinProvenance -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> JoinProvenance -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> JoinProvenance -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> JoinProvenance -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> JoinProvenance -> m JoinProvenance
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> JoinProvenance -> m JoinProvenance
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> JoinProvenance -> m JoinProvenance
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> JoinProvenance -> m JoinProvenance
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> JoinProvenance -> m JoinProvenance
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> JoinProvenance -> m JoinProvenance
Data, (forall (m :: * -> *). Quote m => JoinProvenance -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    JoinProvenance -> Code m JoinProvenance)
-> Lift JoinProvenance
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => JoinProvenance -> m Exp
forall (m :: * -> *).
Quote m =>
JoinProvenance -> Code m JoinProvenance
$clift :: forall (m :: * -> *). Quote m => JoinProvenance -> m Exp
lift :: forall (m :: * -> *). Quote m => JoinProvenance -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
JoinProvenance -> Code m JoinProvenance
liftTyped :: forall (m :: * -> *).
Quote m =>
JoinProvenance -> Code m JoinProvenance
Lift)
  deriving anyclass (Eq JoinProvenance
Eq JoinProvenance
-> (Int -> JoinProvenance -> Int)
-> (JoinProvenance -> Int)
-> Hashable JoinProvenance
Int -> JoinProvenance -> Int
JoinProvenance -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> JoinProvenance -> Int
hashWithSalt :: Int -> JoinProvenance -> Int
$chash :: JoinProvenance -> Int
hash :: JoinProvenance -> Int
Hashable, JoinProvenance -> ()
(JoinProvenance -> ()) -> NFData JoinProvenance
forall a. (a -> ()) -> NFData a
$crnf :: JoinProvenance -> ()
rnf :: JoinProvenance -> ()
NFData)

data JoinSource
  = JoinSelect Select
  -- We're not using existingJoins at the moment, which was used to
  -- avoid re-joining on the same table twice.
  deriving stock (JoinSource -> JoinSource -> Bool
(JoinSource -> JoinSource -> Bool)
-> (JoinSource -> JoinSource -> Bool) -> Eq JoinSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JoinSource -> JoinSource -> Bool
== :: JoinSource -> JoinSource -> Bool
$c/= :: JoinSource -> JoinSource -> Bool
/= :: JoinSource -> JoinSource -> Bool
Eq, Eq JoinSource
Eq JoinSource
-> (JoinSource -> JoinSource -> Ordering)
-> (JoinSource -> JoinSource -> Bool)
-> (JoinSource -> JoinSource -> Bool)
-> (JoinSource -> JoinSource -> Bool)
-> (JoinSource -> JoinSource -> Bool)
-> (JoinSource -> JoinSource -> JoinSource)
-> (JoinSource -> JoinSource -> JoinSource)
-> Ord JoinSource
JoinSource -> JoinSource -> Bool
JoinSource -> JoinSource -> Ordering
JoinSource -> JoinSource -> JoinSource
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 :: JoinSource -> JoinSource -> Ordering
compare :: JoinSource -> JoinSource -> Ordering
$c< :: JoinSource -> JoinSource -> Bool
< :: JoinSource -> JoinSource -> Bool
$c<= :: JoinSource -> JoinSource -> Bool
<= :: JoinSource -> JoinSource -> Bool
$c> :: JoinSource -> JoinSource -> Bool
> :: JoinSource -> JoinSource -> Bool
$c>= :: JoinSource -> JoinSource -> Bool
>= :: JoinSource -> JoinSource -> Bool
$cmax :: JoinSource -> JoinSource -> JoinSource
max :: JoinSource -> JoinSource -> JoinSource
$cmin :: JoinSource -> JoinSource -> JoinSource
min :: JoinSource -> JoinSource -> JoinSource
Ord, Int -> JoinSource -> ShowS
[JoinSource] -> ShowS
JoinSource -> String
(Int -> JoinSource -> ShowS)
-> (JoinSource -> String)
-> ([JoinSource] -> ShowS)
-> Show JoinSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JoinSource -> ShowS
showsPrec :: Int -> JoinSource -> ShowS
$cshow :: JoinSource -> String
show :: JoinSource -> String
$cshowList :: [JoinSource] -> ShowS
showList :: [JoinSource] -> ShowS
Show, (forall x. JoinSource -> Rep JoinSource x)
-> (forall x. Rep JoinSource x -> JoinSource) -> Generic JoinSource
forall x. Rep JoinSource x -> JoinSource
forall x. JoinSource -> Rep JoinSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JoinSource -> Rep JoinSource x
from :: forall x. JoinSource -> Rep JoinSource x
$cto :: forall x. Rep JoinSource x -> JoinSource
to :: forall x. Rep JoinSource x -> JoinSource
Generic, Typeable JoinSource
Typeable JoinSource
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> JoinSource -> c JoinSource)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c JoinSource)
-> (JoinSource -> Constr)
-> (JoinSource -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c JoinSource))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c JoinSource))
-> ((forall b. Data b => b -> b) -> JoinSource -> JoinSource)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> JoinSource -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> JoinSource -> r)
-> (forall u. (forall d. Data d => d -> u) -> JoinSource -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> JoinSource -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> JoinSource -> m JoinSource)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> JoinSource -> m JoinSource)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> JoinSource -> m JoinSource)
-> Data JoinSource
JoinSource -> Constr
JoinSource -> DataType
(forall b. Data b => b -> b) -> JoinSource -> JoinSource
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> JoinSource -> u
forall u. (forall d. Data d => d -> u) -> JoinSource -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JoinSource -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JoinSource -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JoinSource -> m JoinSource
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JoinSource -> m JoinSource
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoinSource
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JoinSource -> c JoinSource
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JoinSource)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JoinSource)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JoinSource -> c JoinSource
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JoinSource -> c JoinSource
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoinSource
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoinSource
$ctoConstr :: JoinSource -> Constr
toConstr :: JoinSource -> Constr
$cdataTypeOf :: JoinSource -> DataType
dataTypeOf :: JoinSource -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JoinSource)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JoinSource)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JoinSource)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JoinSource)
$cgmapT :: (forall b. Data b => b -> b) -> JoinSource -> JoinSource
gmapT :: (forall b. Data b => b -> b) -> JoinSource -> JoinSource
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JoinSource -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JoinSource -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JoinSource -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JoinSource -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> JoinSource -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> JoinSource -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JoinSource -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JoinSource -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JoinSource -> m JoinSource
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JoinSource -> m JoinSource
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JoinSource -> m JoinSource
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JoinSource -> m JoinSource
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JoinSource -> m JoinSource
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JoinSource -> m JoinSource
Data, (forall (m :: * -> *). Quote m => JoinSource -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    JoinSource -> Code m JoinSource)
-> Lift JoinSource
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => JoinSource -> m Exp
forall (m :: * -> *). Quote m => JoinSource -> Code m JoinSource
$clift :: forall (m :: * -> *). Quote m => JoinSource -> m Exp
lift :: forall (m :: * -> *). Quote m => JoinSource -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => JoinSource -> Code m JoinSource
liftTyped :: forall (m :: * -> *). Quote m => JoinSource -> Code m JoinSource
Lift)
  deriving anyclass (Eq JoinSource
Eq JoinSource
-> (Int -> JoinSource -> Int)
-> (JoinSource -> Int)
-> Hashable JoinSource
Int -> JoinSource -> Int
JoinSource -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> JoinSource -> Int
hashWithSalt :: Int -> JoinSource -> Int
$chash :: JoinSource -> Int
hash :: JoinSource -> Int
Hashable, JoinSource -> ()
(JoinSource -> ()) -> NFData JoinSource
forall a. (a -> ()) -> NFData a
$crnf :: JoinSource -> ()
rnf :: JoinSource -> ()
NFData)

newtype Where
  = Where [Expression]
  deriving stock (Where -> Where -> Bool
(Where -> Where -> Bool) -> (Where -> Where -> Bool) -> Eq Where
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Where -> Where -> Bool
== :: Where -> Where -> Bool
$c/= :: Where -> Where -> Bool
/= :: Where -> Where -> Bool
Eq, Eq Where
Eq Where
-> (Where -> Where -> Ordering)
-> (Where -> Where -> Bool)
-> (Where -> Where -> Bool)
-> (Where -> Where -> Bool)
-> (Where -> Where -> Bool)
-> (Where -> Where -> Where)
-> (Where -> Where -> Where)
-> Ord Where
Where -> Where -> Bool
Where -> Where -> Ordering
Where -> Where -> Where
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 :: Where -> Where -> Ordering
compare :: Where -> Where -> Ordering
$c< :: Where -> Where -> Bool
< :: Where -> Where -> Bool
$c<= :: Where -> Where -> Bool
<= :: Where -> Where -> Bool
$c> :: Where -> Where -> Bool
> :: Where -> Where -> Bool
$c>= :: Where -> Where -> Bool
>= :: Where -> Where -> Bool
$cmax :: Where -> Where -> Where
max :: Where -> Where -> Where
$cmin :: Where -> Where -> Where
min :: Where -> Where -> Where
Ord, Int -> Where -> ShowS
[Where] -> ShowS
Where -> String
(Int -> Where -> ShowS)
-> (Where -> String) -> ([Where] -> ShowS) -> Show Where
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Where -> ShowS
showsPrec :: Int -> Where -> ShowS
$cshow :: Where -> String
show :: Where -> String
$cshowList :: [Where] -> ShowS
showList :: [Where] -> ShowS
Show, (forall x. Where -> Rep Where x)
-> (forall x. Rep Where x -> Where) -> Generic Where
forall x. Rep Where x -> Where
forall x. Where -> Rep Where x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Where -> Rep Where x
from :: forall x. Where -> Rep Where x
$cto :: forall x. Rep Where x -> Where
to :: forall x. Rep Where x -> Where
Generic, Typeable Where
Typeable Where
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Where -> c Where)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Where)
-> (Where -> Constr)
-> (Where -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Where))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Where))
-> ((forall b. Data b => b -> b) -> Where -> Where)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Where -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Where -> r)
-> (forall u. (forall d. Data d => d -> u) -> Where -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Where -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Where -> m Where)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Where -> m Where)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Where -> m Where)
-> Data Where
Where -> Constr
Where -> DataType
(forall b. Data b => b -> b) -> Where -> Where
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Where -> u
forall u. (forall d. Data d => d -> u) -> Where -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Where -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Where -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Where -> m Where
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Where -> m Where
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Where
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Where -> c Where
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Where)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Where)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Where -> c Where
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Where -> c Where
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Where
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Where
$ctoConstr :: Where -> Constr
toConstr :: Where -> Constr
$cdataTypeOf :: Where -> DataType
dataTypeOf :: Where -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Where)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Where)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Where)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Where)
$cgmapT :: (forall b. Data b => b -> b) -> Where -> Where
gmapT :: (forall b. Data b => b -> b) -> Where -> Where
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Where -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Where -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Where -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Where -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Where -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Where -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Where -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Where -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Where -> m Where
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Where -> m Where
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Where -> m Where
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Where -> m Where
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Where -> m Where
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Where -> m Where
Data, (forall (m :: * -> *). Quote m => Where -> m Exp)
-> (forall (m :: * -> *). Quote m => Where -> Code m Where)
-> Lift Where
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Where -> m Exp
forall (m :: * -> *). Quote m => Where -> Code m Where
$clift :: forall (m :: * -> *). Quote m => Where -> m Exp
lift :: forall (m :: * -> *). Quote m => Where -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Where -> Code m Where
liftTyped :: forall (m :: * -> *). Quote m => Where -> Code m Where
Lift)
  deriving newtype (Eq Where
Eq Where
-> (Int -> Where -> Int) -> (Where -> Int) -> Hashable Where
Int -> Where -> Int
Where -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Where -> Int
hashWithSalt :: Int -> Where -> Int
$chash :: Where -> Int
hash :: Where -> Int
Hashable, Semigroup Where
Where
Semigroup Where
-> Where
-> (Where -> Where -> Where)
-> ([Where] -> Where)
-> Monoid Where
[Where] -> Where
Where -> Where -> Where
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: Where
mempty :: Where
$cmappend :: Where -> Where -> Where
mappend :: Where -> Where -> Where
$cmconcat :: [Where] -> Where
mconcat :: [Where] -> Where
Monoid, Where -> ()
(Where -> ()) -> NFData Where
forall a. (a -> ()) -> NFData a
$crnf :: Where -> ()
rnf :: Where -> ()
NFData, NonEmpty Where -> Where
Where -> Where -> Where
(Where -> Where -> Where)
-> (NonEmpty Where -> Where)
-> (forall b. Integral b => b -> Where -> Where)
-> Semigroup Where
forall b. Integral b => b -> Where -> Where
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Where -> Where -> Where
<> :: Where -> Where -> Where
$csconcat :: NonEmpty Where -> Where
sconcat :: NonEmpty Where -> Where
$cstimes :: forall b. Integral b => b -> Where -> Where
stimes :: forall b. Integral b => b -> Where -> Where
Semigroup)

data Cardinality
  = Many
  | One
  deriving stock (Cardinality -> Cardinality -> Bool
(Cardinality -> Cardinality -> Bool)
-> (Cardinality -> Cardinality -> Bool) -> Eq Cardinality
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Cardinality -> Cardinality -> Bool
== :: Cardinality -> Cardinality -> Bool
$c/= :: Cardinality -> Cardinality -> Bool
/= :: Cardinality -> Cardinality -> Bool
Eq, Eq Cardinality
Eq Cardinality
-> (Cardinality -> Cardinality -> Ordering)
-> (Cardinality -> Cardinality -> Bool)
-> (Cardinality -> Cardinality -> Bool)
-> (Cardinality -> Cardinality -> Bool)
-> (Cardinality -> Cardinality -> Bool)
-> (Cardinality -> Cardinality -> Cardinality)
-> (Cardinality -> Cardinality -> Cardinality)
-> Ord Cardinality
Cardinality -> Cardinality -> Bool
Cardinality -> Cardinality -> Ordering
Cardinality -> Cardinality -> Cardinality
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 :: Cardinality -> Cardinality -> Ordering
compare :: Cardinality -> Cardinality -> Ordering
$c< :: Cardinality -> Cardinality -> Bool
< :: Cardinality -> Cardinality -> Bool
$c<= :: Cardinality -> Cardinality -> Bool
<= :: Cardinality -> Cardinality -> Bool
$c> :: Cardinality -> Cardinality -> Bool
> :: Cardinality -> Cardinality -> Bool
$c>= :: Cardinality -> Cardinality -> Bool
>= :: Cardinality -> Cardinality -> Bool
$cmax :: Cardinality -> Cardinality -> Cardinality
max :: Cardinality -> Cardinality -> Cardinality
$cmin :: Cardinality -> Cardinality -> Cardinality
min :: Cardinality -> Cardinality -> Cardinality
Ord, Int -> Cardinality -> ShowS
[Cardinality] -> ShowS
Cardinality -> String
(Int -> Cardinality -> ShowS)
-> (Cardinality -> String)
-> ([Cardinality] -> ShowS)
-> Show Cardinality
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cardinality -> ShowS
showsPrec :: Int -> Cardinality -> ShowS
$cshow :: Cardinality -> String
show :: Cardinality -> String
$cshowList :: [Cardinality] -> ShowS
showList :: [Cardinality] -> ShowS
Show, (forall x. Cardinality -> Rep Cardinality x)
-> (forall x. Rep Cardinality x -> Cardinality)
-> Generic Cardinality
forall x. Rep Cardinality x -> Cardinality
forall x. Cardinality -> Rep Cardinality x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Cardinality -> Rep Cardinality x
from :: forall x. Cardinality -> Rep Cardinality x
$cto :: forall x. Rep Cardinality x -> Cardinality
to :: forall x. Rep Cardinality x -> Cardinality
Generic, Typeable Cardinality
Typeable Cardinality
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Cardinality -> c Cardinality)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Cardinality)
-> (Cardinality -> Constr)
-> (Cardinality -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Cardinality))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Cardinality))
-> ((forall b. Data b => b -> b) -> Cardinality -> Cardinality)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Cardinality -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Cardinality -> r)
-> (forall u. (forall d. Data d => d -> u) -> Cardinality -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Cardinality -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Cardinality -> m Cardinality)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Cardinality -> m Cardinality)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Cardinality -> m Cardinality)
-> Data Cardinality
Cardinality -> Constr
Cardinality -> DataType
(forall b. Data b => b -> b) -> Cardinality -> Cardinality
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Cardinality -> u
forall u. (forall d. Data d => d -> u) -> Cardinality -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Cardinality -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Cardinality -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Cardinality -> m Cardinality
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Cardinality -> m Cardinality
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Cardinality
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Cardinality -> c Cardinality
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Cardinality)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Cardinality)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Cardinality -> c Cardinality
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Cardinality -> c Cardinality
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Cardinality
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Cardinality
$ctoConstr :: Cardinality -> Constr
toConstr :: Cardinality -> Constr
$cdataTypeOf :: Cardinality -> DataType
dataTypeOf :: Cardinality -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Cardinality)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Cardinality)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Cardinality)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Cardinality)
$cgmapT :: (forall b. Data b => b -> b) -> Cardinality -> Cardinality
gmapT :: (forall b. Data b => b -> b) -> Cardinality -> Cardinality
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Cardinality -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Cardinality -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Cardinality -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Cardinality -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Cardinality -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Cardinality -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Cardinality -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Cardinality -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Cardinality -> m Cardinality
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Cardinality -> m Cardinality
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Cardinality -> m Cardinality
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Cardinality -> m Cardinality
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Cardinality -> m Cardinality
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Cardinality -> m Cardinality
Data, (forall (m :: * -> *). Quote m => Cardinality -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    Cardinality -> Code m Cardinality)
-> Lift Cardinality
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Cardinality -> m Exp
forall (m :: * -> *). Quote m => Cardinality -> Code m Cardinality
$clift :: forall (m :: * -> *). Quote m => Cardinality -> m Exp
lift :: forall (m :: * -> *). Quote m => Cardinality -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Cardinality -> Code m Cardinality
liftTyped :: forall (m :: * -> *). Quote m => Cardinality -> Code m Cardinality
Lift)
  deriving anyclass (Value -> Parser [Cardinality]
Value -> Parser Cardinality
(Value -> Parser Cardinality)
-> (Value -> Parser [Cardinality]) -> FromJSON Cardinality
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Cardinality
parseJSON :: Value -> Parser Cardinality
$cparseJSONList :: Value -> Parser [Cardinality]
parseJSONList :: Value -> Parser [Cardinality]
FromJSON, Eq Cardinality
Eq Cardinality
-> (Int -> Cardinality -> Int)
-> (Cardinality -> Int)
-> Hashable Cardinality
Int -> Cardinality -> Int
Cardinality -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Cardinality -> Int
hashWithSalt :: Int -> Cardinality -> Int
$chash :: Cardinality -> Int
hash :: Cardinality -> Int
Hashable, Cardinality -> ()
(Cardinality -> ()) -> NFData Cardinality
forall a. (a -> ()) -> NFData a
$crnf :: Cardinality -> ()
rnf :: Cardinality -> ()
NFData, [Cardinality] -> Value
[Cardinality] -> Encoding
Cardinality -> Value
Cardinality -> Encoding
(Cardinality -> Value)
-> (Cardinality -> Encoding)
-> ([Cardinality] -> Value)
-> ([Cardinality] -> Encoding)
-> ToJSON Cardinality
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Cardinality -> Value
toJSON :: Cardinality -> Value
$ctoEncoding :: Cardinality -> Encoding
toEncoding :: Cardinality -> Encoding
$ctoJSONList :: [Cardinality] -> Value
toJSONList :: [Cardinality] -> Value
$ctoEncodingList :: [Cardinality] -> Encoding
toEncodingList :: [Cardinality] -> Encoding
ToJSON)

data AsStruct
  = NoAsStruct
  | AsStruct
  deriving stock (AsStruct -> AsStruct -> Bool
(AsStruct -> AsStruct -> Bool)
-> (AsStruct -> AsStruct -> Bool) -> Eq AsStruct
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AsStruct -> AsStruct -> Bool
== :: AsStruct -> AsStruct -> Bool
$c/= :: AsStruct -> AsStruct -> Bool
/= :: AsStruct -> AsStruct -> Bool
Eq, Eq AsStruct
Eq AsStruct
-> (AsStruct -> AsStruct -> Ordering)
-> (AsStruct -> AsStruct -> Bool)
-> (AsStruct -> AsStruct -> Bool)
-> (AsStruct -> AsStruct -> Bool)
-> (AsStruct -> AsStruct -> Bool)
-> (AsStruct -> AsStruct -> AsStruct)
-> (AsStruct -> AsStruct -> AsStruct)
-> Ord AsStruct
AsStruct -> AsStruct -> Bool
AsStruct -> AsStruct -> Ordering
AsStruct -> AsStruct -> AsStruct
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 :: AsStruct -> AsStruct -> Ordering
compare :: AsStruct -> AsStruct -> Ordering
$c< :: AsStruct -> AsStruct -> Bool
< :: AsStruct -> AsStruct -> Bool
$c<= :: AsStruct -> AsStruct -> Bool
<= :: AsStruct -> AsStruct -> Bool
$c> :: AsStruct -> AsStruct -> Bool
> :: AsStruct -> AsStruct -> Bool
$c>= :: AsStruct -> AsStruct -> Bool
>= :: AsStruct -> AsStruct -> Bool
$cmax :: AsStruct -> AsStruct -> AsStruct
max :: AsStruct -> AsStruct -> AsStruct
$cmin :: AsStruct -> AsStruct -> AsStruct
min :: AsStruct -> AsStruct -> AsStruct
Ord, Int -> AsStruct -> ShowS
[AsStruct] -> ShowS
AsStruct -> String
(Int -> AsStruct -> ShowS)
-> (AsStruct -> String) -> ([AsStruct] -> ShowS) -> Show AsStruct
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AsStruct -> ShowS
showsPrec :: Int -> AsStruct -> ShowS
$cshow :: AsStruct -> String
show :: AsStruct -> String
$cshowList :: [AsStruct] -> ShowS
showList :: [AsStruct] -> ShowS
Show, (forall x. AsStruct -> Rep AsStruct x)
-> (forall x. Rep AsStruct x -> AsStruct) -> Generic AsStruct
forall x. Rep AsStruct x -> AsStruct
forall x. AsStruct -> Rep AsStruct x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AsStruct -> Rep AsStruct x
from :: forall x. AsStruct -> Rep AsStruct x
$cto :: forall x. Rep AsStruct x -> AsStruct
to :: forall x. Rep AsStruct x -> AsStruct
Generic, Typeable AsStruct
Typeable AsStruct
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> AsStruct -> c AsStruct)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c AsStruct)
-> (AsStruct -> Constr)
-> (AsStruct -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c AsStruct))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AsStruct))
-> ((forall b. Data b => b -> b) -> AsStruct -> AsStruct)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> AsStruct -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> AsStruct -> r)
-> (forall u. (forall d. Data d => d -> u) -> AsStruct -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> AsStruct -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> AsStruct -> m AsStruct)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> AsStruct -> m AsStruct)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> AsStruct -> m AsStruct)
-> Data AsStruct
AsStruct -> Constr
AsStruct -> DataType
(forall b. Data b => b -> b) -> AsStruct -> AsStruct
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> AsStruct -> u
forall u. (forall d. Data d => d -> u) -> AsStruct -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AsStruct -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AsStruct -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AsStruct -> m AsStruct
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AsStruct -> m AsStruct
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AsStruct
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AsStruct -> c AsStruct
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AsStruct)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AsStruct)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AsStruct -> c AsStruct
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AsStruct -> c AsStruct
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AsStruct
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AsStruct
$ctoConstr :: AsStruct -> Constr
toConstr :: AsStruct -> Constr
$cdataTypeOf :: AsStruct -> DataType
dataTypeOf :: AsStruct -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AsStruct)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AsStruct)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AsStruct)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AsStruct)
$cgmapT :: (forall b. Data b => b -> b) -> AsStruct -> AsStruct
gmapT :: (forall b. Data b => b -> b) -> AsStruct -> AsStruct
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AsStruct -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AsStruct -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AsStruct -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AsStruct -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> AsStruct -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> AsStruct -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AsStruct -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AsStruct -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AsStruct -> m AsStruct
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AsStruct -> m AsStruct
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AsStruct -> m AsStruct
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AsStruct -> m AsStruct
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AsStruct -> m AsStruct
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AsStruct -> m AsStruct
Data, (forall (m :: * -> *). Quote m => AsStruct -> m Exp)
-> (forall (m :: * -> *). Quote m => AsStruct -> Code m AsStruct)
-> Lift AsStruct
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => AsStruct -> m Exp
forall (m :: * -> *). Quote m => AsStruct -> Code m AsStruct
$clift :: forall (m :: * -> *). Quote m => AsStruct -> m Exp
lift :: forall (m :: * -> *). Quote m => AsStruct -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => AsStruct -> Code m AsStruct
liftTyped :: forall (m :: * -> *). Quote m => AsStruct -> Code m AsStruct
Lift)
  deriving anyclass (Value -> Parser [AsStruct]
Value -> Parser AsStruct
(Value -> Parser AsStruct)
-> (Value -> Parser [AsStruct]) -> FromJSON AsStruct
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser AsStruct
parseJSON :: Value -> Parser AsStruct
$cparseJSONList :: Value -> Parser [AsStruct]
parseJSONList :: Value -> Parser [AsStruct]
FromJSON, Eq AsStruct
Eq AsStruct
-> (Int -> AsStruct -> Int)
-> (AsStruct -> Int)
-> Hashable AsStruct
Int -> AsStruct -> Int
AsStruct -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> AsStruct -> Int
hashWithSalt :: Int -> AsStruct -> Int
$chash :: AsStruct -> Int
hash :: AsStruct -> Int
Hashable, AsStruct -> ()
(AsStruct -> ()) -> NFData AsStruct
forall a. (a -> ()) -> NFData a
$crnf :: AsStruct -> ()
rnf :: AsStruct -> ()
NFData, [AsStruct] -> Value
[AsStruct] -> Encoding
AsStruct -> Value
AsStruct -> Encoding
(AsStruct -> Value)
-> (AsStruct -> Encoding)
-> ([AsStruct] -> Value)
-> ([AsStruct] -> Encoding)
-> ToJSON AsStruct
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: AsStruct -> Value
toJSON :: AsStruct -> Value
$ctoEncoding :: AsStruct -> Encoding
toEncoding :: AsStruct -> Encoding
$ctoJSONList :: [AsStruct] -> Value
toJSONList :: [AsStruct] -> Value
$ctoEncodingList :: [AsStruct] -> Encoding
toEncodingList :: [AsStruct] -> Encoding
ToJSON)

-- | A Common Table Expression clause.
newtype With = With (NonEmpty (Aliased (InterpolatedQuery Expression)))
  deriving stock (Typeable With
Typeable With
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> With -> c With)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c With)
-> (With -> Constr)
-> (With -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c With))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c With))
-> ((forall b. Data b => b -> b) -> With -> With)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> With -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> With -> r)
-> (forall u. (forall d. Data d => d -> u) -> With -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> With -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> With -> m With)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> With -> m With)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> With -> m With)
-> Data With
With -> Constr
With -> DataType
(forall b. Data b => b -> b) -> With -> With
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> With -> u
forall u. (forall d. Data d => d -> u) -> With -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> With -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> With -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> With -> m With
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> With -> m With
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c With
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> With -> c With
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c With)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c With)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> With -> c With
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> With -> c With
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c With
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c With
$ctoConstr :: With -> Constr
toConstr :: With -> Constr
$cdataTypeOf :: With -> DataType
dataTypeOf :: With -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c With)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c With)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c With)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c With)
$cgmapT :: (forall b. Data b => b -> b) -> With -> With
gmapT :: (forall b. Data b => b -> b) -> With -> With
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> With -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> With -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> With -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> With -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> With -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> With -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> With -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> With -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> With -> m With
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> With -> m With
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> With -> m With
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> With -> m With
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> With -> m With
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> With -> m With
Data, (forall x. With -> Rep With x)
-> (forall x. Rep With x -> With) -> Generic With
forall x. Rep With x -> With
forall x. With -> Rep With x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. With -> Rep With x
from :: forall x. With -> Rep With x
$cto :: forall x. Rep With x -> With
to :: forall x. Rep With x -> With
Generic, (forall (m :: * -> *). Quote m => With -> m Exp)
-> (forall (m :: * -> *). Quote m => With -> Code m With)
-> Lift With
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => With -> m Exp
forall (m :: * -> *). Quote m => With -> Code m With
$clift :: forall (m :: * -> *). Quote m => With -> m Exp
lift :: forall (m :: * -> *). Quote m => With -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => With -> Code m With
liftTyped :: forall (m :: * -> *). Quote m => With -> Code m With
Lift)
  deriving newtype (With -> With -> Bool
(With -> With -> Bool) -> (With -> With -> Bool) -> Eq With
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: With -> With -> Bool
== :: With -> With -> Bool
$c/= :: With -> With -> Bool
/= :: With -> With -> Bool
Eq, Eq With
Eq With -> (Int -> With -> Int) -> (With -> Int) -> Hashable With
Int -> With -> Int
With -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> With -> Int
hashWithSalt :: Int -> With -> Int
$chash :: With -> Int
hash :: With -> Int
Hashable, With -> ()
(With -> ()) -> NFData With
forall a. (a -> ()) -> NFData a
$crnf :: With -> ()
rnf :: With -> ()
NFData, Eq With
Eq With
-> (With -> With -> Ordering)
-> (With -> With -> Bool)
-> (With -> With -> Bool)
-> (With -> With -> Bool)
-> (With -> With -> Bool)
-> (With -> With -> With)
-> (With -> With -> With)
-> Ord With
With -> With -> Bool
With -> With -> Ordering
With -> With -> With
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 :: With -> With -> Ordering
compare :: With -> With -> Ordering
$c< :: With -> With -> Bool
< :: With -> With -> Bool
$c<= :: With -> With -> Bool
<= :: With -> With -> Bool
$c> :: With -> With -> Bool
> :: With -> With -> Bool
$c>= :: With -> With -> Bool
>= :: With -> With -> Bool
$cmax :: With -> With -> With
max :: With -> With -> With
$cmin :: With -> With -> With
min :: With -> With -> With
Ord, NonEmpty With -> With
With -> With -> With
(With -> With -> With)
-> (NonEmpty With -> With)
-> (forall b. Integral b => b -> With -> With)
-> Semigroup With
forall b. Integral b => b -> With -> With
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: With -> With -> With
<> :: With -> With -> With
$csconcat :: NonEmpty With -> With
sconcat :: NonEmpty With -> With
$cstimes :: forall b. Integral b => b -> With -> With
stimes :: forall b. Integral b => b -> With -> With
Semigroup, Int -> With -> ShowS
[With] -> ShowS
With -> String
(Int -> With -> ShowS)
-> (With -> String) -> ([With] -> ShowS) -> Show With
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> With -> ShowS
showsPrec :: Int -> With -> ShowS
$cshow :: With -> String
show :: With -> String
$cshowList :: [With] -> ShowS
showList :: [With] -> ShowS
Show)

data Top
  = NoTop
  | Top Int.Int64
  deriving stock (Top -> Top -> Bool
(Top -> Top -> Bool) -> (Top -> Top -> Bool) -> Eq Top
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Top -> Top -> Bool
== :: Top -> Top -> Bool
$c/= :: Top -> Top -> Bool
/= :: Top -> Top -> Bool
Eq, Eq Top
Eq Top
-> (Top -> Top -> Ordering)
-> (Top -> Top -> Bool)
-> (Top -> Top -> Bool)
-> (Top -> Top -> Bool)
-> (Top -> Top -> Bool)
-> (Top -> Top -> Top)
-> (Top -> Top -> Top)
-> Ord Top
Top -> Top -> Bool
Top -> Top -> Ordering
Top -> Top -> Top
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 :: Top -> Top -> Ordering
compare :: Top -> Top -> Ordering
$c< :: Top -> Top -> Bool
< :: Top -> Top -> Bool
$c<= :: Top -> Top -> Bool
<= :: Top -> Top -> Bool
$c> :: Top -> Top -> Bool
> :: Top -> Top -> Bool
$c>= :: Top -> Top -> Bool
>= :: Top -> Top -> Bool
$cmax :: Top -> Top -> Top
max :: Top -> Top -> Top
$cmin :: Top -> Top -> Top
min :: Top -> Top -> Top
Ord, Int -> Top -> ShowS
[Top] -> ShowS
Top -> String
(Int -> Top -> ShowS)
-> (Top -> String) -> ([Top] -> ShowS) -> Show Top
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Top -> ShowS
showsPrec :: Int -> Top -> ShowS
$cshow :: Top -> String
show :: Top -> String
$cshowList :: [Top] -> ShowS
showList :: [Top] -> ShowS
Show, (forall x. Top -> Rep Top x)
-> (forall x. Rep Top x -> Top) -> Generic Top
forall x. Rep Top x -> Top
forall x. Top -> Rep Top x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Top -> Rep Top x
from :: forall x. Top -> Rep Top x
$cto :: forall x. Rep Top x -> Top
to :: forall x. Rep Top x -> Top
Generic, Typeable Top
Typeable Top
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Top -> c Top)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Top)
-> (Top -> Constr)
-> (Top -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Top))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Top))
-> ((forall b. Data b => b -> b) -> Top -> Top)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Top -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Top -> r)
-> (forall u. (forall d. Data d => d -> u) -> Top -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Top -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Top -> m Top)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Top -> m Top)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Top -> m Top)
-> Data Top
Top -> Constr
Top -> DataType
(forall b. Data b => b -> b) -> Top -> Top
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Top -> u
forall u. (forall d. Data d => d -> u) -> Top -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Top -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Top -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Top -> m Top
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Top -> m Top
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Top
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Top -> c Top
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Top)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Top)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Top -> c Top
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Top -> c Top
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Top
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Top
$ctoConstr :: Top -> Constr
toConstr :: Top -> Constr
$cdataTypeOf :: Top -> DataType
dataTypeOf :: Top -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Top)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Top)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Top)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Top)
$cgmapT :: (forall b. Data b => b -> b) -> Top -> Top
gmapT :: (forall b. Data b => b -> b) -> Top -> Top
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Top -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Top -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Top -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Top -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Top -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Top -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Top -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Top -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Top -> m Top
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Top -> m Top
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Top -> m Top
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Top -> m Top
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Top -> m Top
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Top -> m Top
Data, (forall (m :: * -> *). Quote m => Top -> m Exp)
-> (forall (m :: * -> *). Quote m => Top -> Code m Top) -> Lift Top
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Top -> m Exp
forall (m :: * -> *). Quote m => Top -> Code m Top
$clift :: forall (m :: * -> *). Quote m => Top -> m Exp
lift :: forall (m :: * -> *). Quote m => Top -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Top -> Code m Top
liftTyped :: forall (m :: * -> *). Quote m => Top -> Code m Top
Lift)
  deriving anyclass (Value -> Parser [Top]
Value -> Parser Top
(Value -> Parser Top) -> (Value -> Parser [Top]) -> FromJSON Top
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Top
parseJSON :: Value -> Parser Top
$cparseJSONList :: Value -> Parser [Top]
parseJSONList :: Value -> Parser [Top]
FromJSON, Eq Top
Eq Top -> (Int -> Top -> Int) -> (Top -> Int) -> Hashable Top
Int -> Top -> Int
Top -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Top -> Int
hashWithSalt :: Int -> Top -> Int
$chash :: Top -> Int
hash :: Top -> Int
Hashable, Top -> ()
(Top -> ()) -> NFData Top
forall a. (a -> ()) -> NFData a
$crnf :: Top -> ()
rnf :: Top -> ()
NFData, [Top] -> Value
[Top] -> Encoding
Top -> Value
Top -> Encoding
(Top -> Value)
-> (Top -> Encoding)
-> ([Top] -> Value)
-> ([Top] -> Encoding)
-> ToJSON Top
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Top -> Value
toJSON :: Top -> Value
$ctoEncoding :: Top -> Encoding
toEncoding :: Top -> Encoding
$ctoJSONList :: [Top] -> Value
toJSONList :: [Top] -> Value
$ctoEncodingList :: [Top] -> Encoding
toEncodingList :: [Top] -> Encoding
ToJSON)

instance Monoid Top where
  mempty :: Top
mempty = Top
NoTop

instance Semigroup Top where
  (<>) :: Top -> Top -> Top
  <> :: Top -> Top -> Top
(<>) Top
NoTop Top
x = Top
x
  (<>) Top
x Top
NoTop = Top
x
  (<>) (Top Int64
x) (Top Int64
y) = Int64 -> Top
Top (Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
min Int64
x Int64
y)

data Expression
  = ValueExpression TypedValue
  | InExpression Expression TypedValue
  | AndExpression [Expression]
  | OrExpression [Expression]
  | NotExpression Expression
  | ExistsExpression Select
  | SelectExpression Select
  | IsNullExpression Expression
  | IsNotNullExpression Expression
  | ColumnExpression FieldName
  | EqualExpression Expression Expression
  | NotEqualExpression Expression Expression
  | -- | This one acts like a "cast to JSON" and makes SQL Server
    -- behave like it knows your field is JSON and not double-encode
    -- it.
    JsonQueryExpression Expression
  | ToStringExpression Expression
  | -- | This is for getting actual atomic values out of a JSON
    -- string.
    JsonValueExpression Expression JsonPath
  | OpExpression Op Expression Expression
  | ListExpression [Expression]
  | CastExpression Expression ScalarType
  | FunctionExpression FunctionName [Expression]
  | ConditionalProjection Expression FieldName
  | -- | A function input argument expression with argument name
    -- `argument_name` => 'argument_value'
    FunctionNamedArgument Text Expression
  deriving stock (Expression -> Expression -> Bool
(Expression -> Expression -> Bool)
-> (Expression -> Expression -> Bool) -> Eq Expression
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Expression -> Expression -> Bool
== :: Expression -> Expression -> Bool
$c/= :: Expression -> Expression -> Bool
/= :: Expression -> Expression -> Bool
Eq, Eq Expression
Eq Expression
-> (Expression -> Expression -> Ordering)
-> (Expression -> Expression -> Bool)
-> (Expression -> Expression -> Bool)
-> (Expression -> Expression -> Bool)
-> (Expression -> Expression -> Bool)
-> (Expression -> Expression -> Expression)
-> (Expression -> Expression -> Expression)
-> Ord Expression
Expression -> Expression -> Bool
Expression -> Expression -> Ordering
Expression -> Expression -> Expression
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 :: Expression -> Expression -> Ordering
compare :: Expression -> Expression -> Ordering
$c< :: Expression -> Expression -> Bool
< :: Expression -> Expression -> Bool
$c<= :: Expression -> Expression -> Bool
<= :: Expression -> Expression -> Bool
$c> :: Expression -> Expression -> Bool
> :: Expression -> Expression -> Bool
$c>= :: Expression -> Expression -> Bool
>= :: Expression -> Expression -> Bool
$cmax :: Expression -> Expression -> Expression
max :: Expression -> Expression -> Expression
$cmin :: Expression -> Expression -> Expression
min :: Expression -> Expression -> Expression
Ord, Int -> Expression -> ShowS
[Expression] -> ShowS
Expression -> String
(Int -> Expression -> ShowS)
-> (Expression -> String)
-> ([Expression] -> ShowS)
-> Show Expression
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Expression -> ShowS
showsPrec :: Int -> Expression -> ShowS
$cshow :: Expression -> String
show :: Expression -> String
$cshowList :: [Expression] -> ShowS
showList :: [Expression] -> ShowS
Show, (forall x. Expression -> Rep Expression x)
-> (forall x. Rep Expression x -> Expression) -> Generic Expression
forall x. Rep Expression x -> Expression
forall x. Expression -> Rep Expression x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Expression -> Rep Expression x
from :: forall x. Expression -> Rep Expression x
$cto :: forall x. Rep Expression x -> Expression
to :: forall x. Rep Expression x -> Expression
Generic, Typeable Expression
Typeable Expression
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Expression -> c Expression)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Expression)
-> (Expression -> Constr)
-> (Expression -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Expression))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Expression))
-> ((forall b. Data b => b -> b) -> Expression -> Expression)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Expression -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Expression -> r)
-> (forall u. (forall d. Data d => d -> u) -> Expression -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Expression -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Expression -> m Expression)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Expression -> m Expression)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Expression -> m Expression)
-> Data Expression
Expression -> Constr
Expression -> DataType
(forall b. Data b => b -> b) -> Expression -> Expression
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Expression -> u
forall u. (forall d. Data d => d -> u) -> Expression -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Expression -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Expression -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Expression -> m Expression
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Expression -> m Expression
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Expression
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Expression -> c Expression
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Expression)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Expression)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Expression -> c Expression
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Expression -> c Expression
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Expression
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Expression
$ctoConstr :: Expression -> Constr
toConstr :: Expression -> Constr
$cdataTypeOf :: Expression -> DataType
dataTypeOf :: Expression -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Expression)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Expression)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Expression)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Expression)
$cgmapT :: (forall b. Data b => b -> b) -> Expression -> Expression
gmapT :: (forall b. Data b => b -> b) -> Expression -> Expression
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Expression -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Expression -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Expression -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Expression -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Expression -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Expression -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Expression -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Expression -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Expression -> m Expression
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Expression -> m Expression
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Expression -> m Expression
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Expression -> m Expression
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Expression -> m Expression
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Expression -> m Expression
Data, (forall (m :: * -> *). Quote m => Expression -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    Expression -> Code m Expression)
-> Lift Expression
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Expression -> m Exp
forall (m :: * -> *). Quote m => Expression -> Code m Expression
$clift :: forall (m :: * -> *). Quote m => Expression -> m Exp
lift :: forall (m :: * -> *). Quote m => Expression -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Expression -> Code m Expression
liftTyped :: forall (m :: * -> *). Quote m => Expression -> Code m Expression
Lift)
  deriving anyclass (Eq Expression
Eq Expression
-> (Int -> Expression -> Int)
-> (Expression -> Int)
-> Hashable Expression
Int -> Expression -> Int
Expression -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Expression -> Int
hashWithSalt :: Int -> Expression -> Int
$chash :: Expression -> Int
hash :: Expression -> Int
Hashable, Expression -> ()
(Expression -> ()) -> NFData Expression
forall a. (a -> ()) -> NFData a
$crnf :: Expression -> ()
rnf :: Expression -> ()
NFData)

data JsonPath
  = RootPath
  | FieldPath JsonPath Text
  | IndexPath JsonPath Integer
  deriving stock (JsonPath -> JsonPath -> Bool
(JsonPath -> JsonPath -> Bool)
-> (JsonPath -> JsonPath -> Bool) -> Eq JsonPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JsonPath -> JsonPath -> Bool
== :: JsonPath -> JsonPath -> Bool
$c/= :: JsonPath -> JsonPath -> Bool
/= :: JsonPath -> JsonPath -> Bool
Eq, Eq JsonPath
Eq JsonPath
-> (JsonPath -> JsonPath -> Ordering)
-> (JsonPath -> JsonPath -> Bool)
-> (JsonPath -> JsonPath -> Bool)
-> (JsonPath -> JsonPath -> Bool)
-> (JsonPath -> JsonPath -> Bool)
-> (JsonPath -> JsonPath -> JsonPath)
-> (JsonPath -> JsonPath -> JsonPath)
-> Ord JsonPath
JsonPath -> JsonPath -> Bool
JsonPath -> JsonPath -> Ordering
JsonPath -> JsonPath -> JsonPath
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 :: JsonPath -> JsonPath -> Ordering
compare :: JsonPath -> JsonPath -> Ordering
$c< :: JsonPath -> JsonPath -> Bool
< :: JsonPath -> JsonPath -> Bool
$c<= :: JsonPath -> JsonPath -> Bool
<= :: JsonPath -> JsonPath -> Bool
$c> :: JsonPath -> JsonPath -> Bool
> :: JsonPath -> JsonPath -> Bool
$c>= :: JsonPath -> JsonPath -> Bool
>= :: JsonPath -> JsonPath -> Bool
$cmax :: JsonPath -> JsonPath -> JsonPath
max :: JsonPath -> JsonPath -> JsonPath
$cmin :: JsonPath -> JsonPath -> JsonPath
min :: JsonPath -> JsonPath -> JsonPath
Ord, Int -> JsonPath -> ShowS
[JsonPath] -> ShowS
JsonPath -> String
(Int -> JsonPath -> ShowS)
-> (JsonPath -> String) -> ([JsonPath] -> ShowS) -> Show JsonPath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JsonPath -> ShowS
showsPrec :: Int -> JsonPath -> ShowS
$cshow :: JsonPath -> String
show :: JsonPath -> String
$cshowList :: [JsonPath] -> ShowS
showList :: [JsonPath] -> ShowS
Show, (forall x. JsonPath -> Rep JsonPath x)
-> (forall x. Rep JsonPath x -> JsonPath) -> Generic JsonPath
forall x. Rep JsonPath x -> JsonPath
forall x. JsonPath -> Rep JsonPath x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JsonPath -> Rep JsonPath x
from :: forall x. JsonPath -> Rep JsonPath x
$cto :: forall x. Rep JsonPath x -> JsonPath
to :: forall x. Rep JsonPath x -> JsonPath
Generic, Typeable JsonPath
Typeable JsonPath
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> JsonPath -> c JsonPath)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c JsonPath)
-> (JsonPath -> Constr)
-> (JsonPath -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c JsonPath))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JsonPath))
-> ((forall b. Data b => b -> b) -> JsonPath -> JsonPath)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> JsonPath -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> JsonPath -> r)
-> (forall u. (forall d. Data d => d -> u) -> JsonPath -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> JsonPath -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> JsonPath -> m JsonPath)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> JsonPath -> m JsonPath)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> JsonPath -> m JsonPath)
-> Data JsonPath
JsonPath -> Constr
JsonPath -> DataType
(forall b. Data b => b -> b) -> JsonPath -> JsonPath
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> JsonPath -> u
forall u. (forall d. Data d => d -> u) -> JsonPath -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JsonPath -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JsonPath -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JsonPath -> m JsonPath
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JsonPath -> m JsonPath
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JsonPath
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JsonPath -> c JsonPath
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JsonPath)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JsonPath)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JsonPath -> c JsonPath
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JsonPath -> c JsonPath
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JsonPath
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JsonPath
$ctoConstr :: JsonPath -> Constr
toConstr :: JsonPath -> Constr
$cdataTypeOf :: JsonPath -> DataType
dataTypeOf :: JsonPath -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JsonPath)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JsonPath)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JsonPath)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JsonPath)
$cgmapT :: (forall b. Data b => b -> b) -> JsonPath -> JsonPath
gmapT :: (forall b. Data b => b -> b) -> JsonPath -> JsonPath
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JsonPath -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JsonPath -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JsonPath -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JsonPath -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> JsonPath -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> JsonPath -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JsonPath -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JsonPath -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JsonPath -> m JsonPath
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JsonPath -> m JsonPath
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JsonPath -> m JsonPath
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JsonPath -> m JsonPath
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JsonPath -> m JsonPath
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JsonPath -> m JsonPath
Data, (forall (m :: * -> *). Quote m => JsonPath -> m Exp)
-> (forall (m :: * -> *). Quote m => JsonPath -> Code m JsonPath)
-> Lift JsonPath
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => JsonPath -> m Exp
forall (m :: * -> *). Quote m => JsonPath -> Code m JsonPath
$clift :: forall (m :: * -> *). Quote m => JsonPath -> m Exp
lift :: forall (m :: * -> *). Quote m => JsonPath -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => JsonPath -> Code m JsonPath
liftTyped :: forall (m :: * -> *). Quote m => JsonPath -> Code m JsonPath
Lift)
  deriving anyclass (Value -> Parser [JsonPath]
Value -> Parser JsonPath
(Value -> Parser JsonPath)
-> (Value -> Parser [JsonPath]) -> FromJSON JsonPath
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser JsonPath
parseJSON :: Value -> Parser JsonPath
$cparseJSONList :: Value -> Parser [JsonPath]
parseJSONList :: Value -> Parser [JsonPath]
FromJSON, Eq JsonPath
Eq JsonPath
-> (Int -> JsonPath -> Int)
-> (JsonPath -> Int)
-> Hashable JsonPath
Int -> JsonPath -> Int
JsonPath -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> JsonPath -> Int
hashWithSalt :: Int -> JsonPath -> Int
$chash :: JsonPath -> Int
hash :: JsonPath -> Int
Hashable, JsonPath -> ()
(JsonPath -> ()) -> NFData JsonPath
forall a. (a -> ()) -> NFData a
$crnf :: JsonPath -> ()
rnf :: JsonPath -> ()
NFData, [JsonPath] -> Value
[JsonPath] -> Encoding
JsonPath -> Value
JsonPath -> Encoding
(JsonPath -> Value)
-> (JsonPath -> Encoding)
-> ([JsonPath] -> Value)
-> ([JsonPath] -> Encoding)
-> ToJSON JsonPath
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: JsonPath -> Value
toJSON :: JsonPath -> Value
$ctoEncoding :: JsonPath -> Encoding
toEncoding :: JsonPath -> Encoding
$ctoJSONList :: [JsonPath] -> Value
toJSONList :: [JsonPath] -> Value
$ctoEncodingList :: [JsonPath] -> Encoding
toEncodingList :: [JsonPath] -> Encoding
ToJSON)

data Aggregate
  = CountAggregate (Countable FieldName)
  | OpAggregates Text (NonEmpty (Text, Expression))
  | OpAggregate Text Expression
  | TextAggregate Text
  deriving stock (Aggregate -> Aggregate -> Bool
(Aggregate -> Aggregate -> Bool)
-> (Aggregate -> Aggregate -> Bool) -> Eq Aggregate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Aggregate -> Aggregate -> Bool
== :: Aggregate -> Aggregate -> Bool
$c/= :: Aggregate -> Aggregate -> Bool
/= :: Aggregate -> Aggregate -> Bool
Eq, Eq Aggregate
Eq Aggregate
-> (Aggregate -> Aggregate -> Ordering)
-> (Aggregate -> Aggregate -> Bool)
-> (Aggregate -> Aggregate -> Bool)
-> (Aggregate -> Aggregate -> Bool)
-> (Aggregate -> Aggregate -> Bool)
-> (Aggregate -> Aggregate -> Aggregate)
-> (Aggregate -> Aggregate -> Aggregate)
-> Ord Aggregate
Aggregate -> Aggregate -> Bool
Aggregate -> Aggregate -> Ordering
Aggregate -> Aggregate -> Aggregate
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 :: Aggregate -> Aggregate -> Ordering
compare :: Aggregate -> Aggregate -> Ordering
$c< :: Aggregate -> Aggregate -> Bool
< :: Aggregate -> Aggregate -> Bool
$c<= :: Aggregate -> Aggregate -> Bool
<= :: Aggregate -> Aggregate -> Bool
$c> :: Aggregate -> Aggregate -> Bool
> :: Aggregate -> Aggregate -> Bool
$c>= :: Aggregate -> Aggregate -> Bool
>= :: Aggregate -> Aggregate -> Bool
$cmax :: Aggregate -> Aggregate -> Aggregate
max :: Aggregate -> Aggregate -> Aggregate
$cmin :: Aggregate -> Aggregate -> Aggregate
min :: Aggregate -> Aggregate -> Aggregate
Ord, Int -> Aggregate -> ShowS
[Aggregate] -> ShowS
Aggregate -> String
(Int -> Aggregate -> ShowS)
-> (Aggregate -> String)
-> ([Aggregate] -> ShowS)
-> Show Aggregate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Aggregate -> ShowS
showsPrec :: Int -> Aggregate -> ShowS
$cshow :: Aggregate -> String
show :: Aggregate -> String
$cshowList :: [Aggregate] -> ShowS
showList :: [Aggregate] -> ShowS
Show, (forall x. Aggregate -> Rep Aggregate x)
-> (forall x. Rep Aggregate x -> Aggregate) -> Generic Aggregate
forall x. Rep Aggregate x -> Aggregate
forall x. Aggregate -> Rep Aggregate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Aggregate -> Rep Aggregate x
from :: forall x. Aggregate -> Rep Aggregate x
$cto :: forall x. Rep Aggregate x -> Aggregate
to :: forall x. Rep Aggregate x -> Aggregate
Generic, Typeable Aggregate
Typeable Aggregate
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Aggregate -> c Aggregate)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Aggregate)
-> (Aggregate -> Constr)
-> (Aggregate -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Aggregate))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Aggregate))
-> ((forall b. Data b => b -> b) -> Aggregate -> Aggregate)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Aggregate -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Aggregate -> r)
-> (forall u. (forall d. Data d => d -> u) -> Aggregate -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Aggregate -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Aggregate -> m Aggregate)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Aggregate -> m Aggregate)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Aggregate -> m Aggregate)
-> Data Aggregate
Aggregate -> Constr
Aggregate -> DataType
(forall b. Data b => b -> b) -> Aggregate -> Aggregate
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Aggregate -> u
forall u. (forall d. Data d => d -> u) -> Aggregate -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Aggregate -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Aggregate -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Aggregate -> m Aggregate
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Aggregate -> m Aggregate
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Aggregate
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Aggregate -> c Aggregate
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Aggregate)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Aggregate)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Aggregate -> c Aggregate
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Aggregate -> c Aggregate
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Aggregate
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Aggregate
$ctoConstr :: Aggregate -> Constr
toConstr :: Aggregate -> Constr
$cdataTypeOf :: Aggregate -> DataType
dataTypeOf :: Aggregate -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Aggregate)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Aggregate)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Aggregate)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Aggregate)
$cgmapT :: (forall b. Data b => b -> b) -> Aggregate -> Aggregate
gmapT :: (forall b. Data b => b -> b) -> Aggregate -> Aggregate
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Aggregate -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Aggregate -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Aggregate -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Aggregate -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Aggregate -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Aggregate -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Aggregate -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Aggregate -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Aggregate -> m Aggregate
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Aggregate -> m Aggregate
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Aggregate -> m Aggregate
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Aggregate -> m Aggregate
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Aggregate -> m Aggregate
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Aggregate -> m Aggregate
Data, (forall (m :: * -> *). Quote m => Aggregate -> m Exp)
-> (forall (m :: * -> *). Quote m => Aggregate -> Code m Aggregate)
-> Lift Aggregate
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Aggregate -> m Exp
forall (m :: * -> *). Quote m => Aggregate -> Code m Aggregate
$clift :: forall (m :: * -> *). Quote m => Aggregate -> m Exp
lift :: forall (m :: * -> *). Quote m => Aggregate -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Aggregate -> Code m Aggregate
liftTyped :: forall (m :: * -> *). Quote m => Aggregate -> Code m Aggregate
Lift)
  deriving anyclass (Eq Aggregate
Eq Aggregate
-> (Int -> Aggregate -> Int)
-> (Aggregate -> Int)
-> Hashable Aggregate
Int -> Aggregate -> Int
Aggregate -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Aggregate -> Int
hashWithSalt :: Int -> Aggregate -> Int
$chash :: Aggregate -> Int
hash :: Aggregate -> Int
Hashable, Aggregate -> ()
(Aggregate -> ()) -> NFData Aggregate
forall a. (a -> ()) -> NFData a
$crnf :: Aggregate -> ()
rnf :: Aggregate -> ()
NFData)

data Countable fieldname
  = StarCountable
  | NonNullFieldCountable (NonEmpty fieldname)
  | DistinctCountable (NonEmpty fieldname)
  deriving stock (Countable fieldname -> Countable fieldname -> Bool
(Countable fieldname -> Countable fieldname -> Bool)
-> (Countable fieldname -> Countable fieldname -> Bool)
-> Eq (Countable fieldname)
forall fieldname.
Eq fieldname =>
Countable fieldname -> Countable fieldname -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall fieldname.
Eq fieldname =>
Countable fieldname -> Countable fieldname -> Bool
== :: Countable fieldname -> Countable fieldname -> Bool
$c/= :: forall fieldname.
Eq fieldname =>
Countable fieldname -> Countable fieldname -> Bool
/= :: Countable fieldname -> Countable fieldname -> Bool
Eq, Eq (Countable fieldname)
Eq (Countable fieldname)
-> (Countable fieldname -> Countable fieldname -> Ordering)
-> (Countable fieldname -> Countable fieldname -> Bool)
-> (Countable fieldname -> Countable fieldname -> Bool)
-> (Countable fieldname -> Countable fieldname -> Bool)
-> (Countable fieldname -> Countable fieldname -> Bool)
-> (Countable fieldname
    -> Countable fieldname -> Countable fieldname)
-> (Countable fieldname
    -> Countable fieldname -> Countable fieldname)
-> Ord (Countable fieldname)
Countable fieldname -> Countable fieldname -> Bool
Countable fieldname -> Countable fieldname -> Ordering
Countable fieldname -> Countable fieldname -> Countable fieldname
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
forall {fieldname}. Ord fieldname => Eq (Countable fieldname)
forall fieldname.
Ord fieldname =>
Countable fieldname -> Countable fieldname -> Bool
forall fieldname.
Ord fieldname =>
Countable fieldname -> Countable fieldname -> Ordering
forall fieldname.
Ord fieldname =>
Countable fieldname -> Countable fieldname -> Countable fieldname
$ccompare :: forall fieldname.
Ord fieldname =>
Countable fieldname -> Countable fieldname -> Ordering
compare :: Countable fieldname -> Countable fieldname -> Ordering
$c< :: forall fieldname.
Ord fieldname =>
Countable fieldname -> Countable fieldname -> Bool
< :: Countable fieldname -> Countable fieldname -> Bool
$c<= :: forall fieldname.
Ord fieldname =>
Countable fieldname -> Countable fieldname -> Bool
<= :: Countable fieldname -> Countable fieldname -> Bool
$c> :: forall fieldname.
Ord fieldname =>
Countable fieldname -> Countable fieldname -> Bool
> :: Countable fieldname -> Countable fieldname -> Bool
$c>= :: forall fieldname.
Ord fieldname =>
Countable fieldname -> Countable fieldname -> Bool
>= :: Countable fieldname -> Countable fieldname -> Bool
$cmax :: forall fieldname.
Ord fieldname =>
Countable fieldname -> Countable fieldname -> Countable fieldname
max :: Countable fieldname -> Countable fieldname -> Countable fieldname
$cmin :: forall fieldname.
Ord fieldname =>
Countable fieldname -> Countable fieldname -> Countable fieldname
min :: Countable fieldname -> Countable fieldname -> Countable fieldname
Ord, Int -> Countable fieldname -> ShowS
[Countable fieldname] -> ShowS
Countable fieldname -> String
(Int -> Countable fieldname -> ShowS)
-> (Countable fieldname -> String)
-> ([Countable fieldname] -> ShowS)
-> Show (Countable fieldname)
forall fieldname.
Show fieldname =>
Int -> Countable fieldname -> ShowS
forall fieldname. Show fieldname => [Countable fieldname] -> ShowS
forall fieldname. Show fieldname => Countable fieldname -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall fieldname.
Show fieldname =>
Int -> Countable fieldname -> ShowS
showsPrec :: Int -> Countable fieldname -> ShowS
$cshow :: forall fieldname. Show fieldname => Countable fieldname -> String
show :: Countable fieldname -> String
$cshowList :: forall fieldname. Show fieldname => [Countable fieldname] -> ShowS
showList :: [Countable fieldname] -> ShowS
Show, (forall x. Countable fieldname -> Rep (Countable fieldname) x)
-> (forall x. Rep (Countable fieldname) x -> Countable fieldname)
-> Generic (Countable fieldname)
forall x. Rep (Countable fieldname) x -> Countable fieldname
forall x. Countable fieldname -> Rep (Countable fieldname) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall fieldname x.
Rep (Countable fieldname) x -> Countable fieldname
forall fieldname x.
Countable fieldname -> Rep (Countable fieldname) x
$cfrom :: forall fieldname x.
Countable fieldname -> Rep (Countable fieldname) x
from :: forall x. Countable fieldname -> Rep (Countable fieldname) x
$cto :: forall fieldname x.
Rep (Countable fieldname) x -> Countable fieldname
to :: forall x. Rep (Countable fieldname) x -> Countable fieldname
Generic, Typeable (Countable fieldname)
Typeable (Countable fieldname)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> Countable fieldname
    -> c (Countable fieldname))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Countable fieldname))
-> (Countable fieldname -> Constr)
-> (Countable fieldname -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Countable fieldname)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Countable fieldname)))
-> ((forall b. Data b => b -> b)
    -> Countable fieldname -> Countable fieldname)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Countable fieldname -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Countable fieldname -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> Countable fieldname -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Countable fieldname -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> Countable fieldname -> m (Countable fieldname))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Countable fieldname -> m (Countable fieldname))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Countable fieldname -> m (Countable fieldname))
-> Data (Countable fieldname)
Countable fieldname -> Constr
Countable fieldname -> DataType
(forall b. Data b => b -> b)
-> Countable fieldname -> Countable fieldname
forall {fieldname}.
Data fieldname =>
Typeable (Countable fieldname)
forall fieldname. Data fieldname => Countable fieldname -> Constr
forall fieldname. Data fieldname => Countable fieldname -> DataType
forall fieldname.
Data fieldname =>
(forall b. Data b => b -> b)
-> Countable fieldname -> Countable fieldname
forall fieldname u.
Data fieldname =>
Int -> (forall d. Data d => d -> u) -> Countable fieldname -> u
forall fieldname u.
Data fieldname =>
(forall d. Data d => d -> u) -> Countable fieldname -> [u]
forall fieldname r r'.
Data fieldname =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Countable fieldname -> r
forall fieldname r r'.
Data fieldname =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Countable fieldname -> r
forall fieldname (m :: * -> *).
(Data fieldname, Monad m) =>
(forall d. Data d => d -> m d)
-> Countable fieldname -> m (Countable fieldname)
forall fieldname (m :: * -> *).
(Data fieldname, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Countable fieldname -> m (Countable fieldname)
forall fieldname (c :: * -> *).
Data fieldname =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Countable fieldname)
forall fieldname (c :: * -> *).
Data fieldname =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> Countable fieldname
-> c (Countable fieldname)
forall fieldname (t :: * -> *) (c :: * -> *).
(Data fieldname, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Countable fieldname))
forall fieldname (t :: * -> * -> *) (c :: * -> *).
(Data fieldname, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Countable fieldname))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> Countable fieldname -> u
forall u.
(forall d. Data d => d -> u) -> Countable fieldname -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Countable fieldname -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Countable fieldname -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Countable fieldname -> m (Countable fieldname)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Countable fieldname -> m (Countable fieldname)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Countable fieldname)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> Countable fieldname
-> c (Countable fieldname)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Countable fieldname))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Countable fieldname))
$cgfoldl :: forall fieldname (c :: * -> *).
Data fieldname =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> Countable fieldname
-> c (Countable fieldname)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> Countable fieldname
-> c (Countable fieldname)
$cgunfold :: forall fieldname (c :: * -> *).
Data fieldname =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Countable fieldname)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Countable fieldname)
$ctoConstr :: forall fieldname. Data fieldname => Countable fieldname -> Constr
toConstr :: Countable fieldname -> Constr
$cdataTypeOf :: forall fieldname. Data fieldname => Countable fieldname -> DataType
dataTypeOf :: Countable fieldname -> DataType
$cdataCast1 :: forall fieldname (t :: * -> *) (c :: * -> *).
(Data fieldname, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Countable fieldname))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Countable fieldname))
$cdataCast2 :: forall fieldname (t :: * -> * -> *) (c :: * -> *).
(Data fieldname, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Countable fieldname))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Countable fieldname))
$cgmapT :: forall fieldname.
Data fieldname =>
(forall b. Data b => b -> b)
-> Countable fieldname -> Countable fieldname
gmapT :: (forall b. Data b => b -> b)
-> Countable fieldname -> Countable fieldname
$cgmapQl :: forall fieldname r r'.
Data fieldname =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Countable fieldname -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Countable fieldname -> r
$cgmapQr :: forall fieldname r r'.
Data fieldname =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Countable fieldname -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Countable fieldname -> r
$cgmapQ :: forall fieldname u.
Data fieldname =>
(forall d. Data d => d -> u) -> Countable fieldname -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> Countable fieldname -> [u]
$cgmapQi :: forall fieldname u.
Data fieldname =>
Int -> (forall d. Data d => d -> u) -> Countable fieldname -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> Countable fieldname -> u
$cgmapM :: forall fieldname (m :: * -> *).
(Data fieldname, Monad m) =>
(forall d. Data d => d -> m d)
-> Countable fieldname -> m (Countable fieldname)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Countable fieldname -> m (Countable fieldname)
$cgmapMp :: forall fieldname (m :: * -> *).
(Data fieldname, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Countable fieldname -> m (Countable fieldname)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Countable fieldname -> m (Countable fieldname)
$cgmapMo :: forall fieldname (m :: * -> *).
(Data fieldname, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Countable fieldname -> m (Countable fieldname)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Countable fieldname -> m (Countable fieldname)
Data, (forall (m :: * -> *). Quote m => Countable fieldname -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    Countable fieldname -> Code m (Countable fieldname))
-> Lift (Countable fieldname)
forall fieldname (m :: * -> *).
(Lift fieldname, Quote m) =>
Countable fieldname -> m Exp
forall fieldname (m :: * -> *).
(Lift fieldname, Quote m) =>
Countable fieldname -> Code m (Countable fieldname)
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Countable fieldname -> m Exp
forall (m :: * -> *).
Quote m =>
Countable fieldname -> Code m (Countable fieldname)
$clift :: forall fieldname (m :: * -> *).
(Lift fieldname, Quote m) =>
Countable fieldname -> m Exp
lift :: forall (m :: * -> *). Quote m => Countable fieldname -> m Exp
$cliftTyped :: forall fieldname (m :: * -> *).
(Lift fieldname, Quote m) =>
Countable fieldname -> Code m (Countable fieldname)
liftTyped :: forall (m :: * -> *).
Quote m =>
Countable fieldname -> Code m (Countable fieldname)
Lift)

deriving anyclass instance (FromJSON a) => FromJSON (Countable a)

deriving anyclass instance (Hashable a) => Hashable (Countable a)

deriving anyclass instance (ToJSON a) => ToJSON (Countable a)

deriving anyclass instance (NFData a) => NFData (Countable a)

data From
  = FromQualifiedTable (Aliased TableName)
  | FromSelect (Aliased Select)
  | FromSelectJson (Aliased SelectJson)
  | FromFunction (Aliased SelectFromFunction)
  | FromNativeQuery (Aliased NativeQueryName)
  deriving stock (From -> From -> Bool
(From -> From -> Bool) -> (From -> From -> Bool) -> Eq From
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: From -> From -> Bool
== :: From -> From -> Bool
$c/= :: From -> From -> Bool
/= :: From -> From -> Bool
Eq, Int -> From -> ShowS
[From] -> ShowS
From -> String
(Int -> From -> ShowS)
-> (From -> String) -> ([From] -> ShowS) -> Show From
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> From -> ShowS
showsPrec :: Int -> From -> ShowS
$cshow :: From -> String
show :: From -> String
$cshowList :: [From] -> ShowS
showList :: [From] -> ShowS
Show, (forall x. From -> Rep From x)
-> (forall x. Rep From x -> From) -> Generic From
forall x. Rep From x -> From
forall x. From -> Rep From x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. From -> Rep From x
from :: forall x. From -> Rep From x
$cto :: forall x. Rep From x -> From
to :: forall x. Rep From x -> From
Generic, Typeable From
Typeable From
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> From -> c From)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c From)
-> (From -> Constr)
-> (From -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c From))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c From))
-> ((forall b. Data b => b -> b) -> From -> From)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> From -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> From -> r)
-> (forall u. (forall d. Data d => d -> u) -> From -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> From -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> From -> m From)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> From -> m From)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> From -> m From)
-> Data From
From -> Constr
From -> DataType
(forall b. Data b => b -> b) -> From -> From
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> From -> u
forall u. (forall d. Data d => d -> u) -> From -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> From -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> From -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> From -> m From
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> From -> m From
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c From
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> From -> c From
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c From)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c From)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> From -> c From
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> From -> c From
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c From
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c From
$ctoConstr :: From -> Constr
toConstr :: From -> Constr
$cdataTypeOf :: From -> DataType
dataTypeOf :: From -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c From)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c From)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c From)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c From)
$cgmapT :: (forall b. Data b => b -> b) -> From -> From
gmapT :: (forall b. Data b => b -> b) -> From -> From
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> From -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> From -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> From -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> From -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> From -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> From -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> From -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> From -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> From -> m From
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> From -> m From
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> From -> m From
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> From -> m From
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> From -> m From
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> From -> m From
Data, (forall (m :: * -> *). Quote m => From -> m Exp)
-> (forall (m :: * -> *). Quote m => From -> Code m From)
-> Lift From
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => From -> m Exp
forall (m :: * -> *). Quote m => From -> Code m From
$clift :: forall (m :: * -> *). Quote m => From -> m Exp
lift :: forall (m :: * -> *). Quote m => From -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => From -> Code m From
liftTyped :: forall (m :: * -> *). Quote m => From -> Code m From
Lift, Eq From
Eq From
-> (From -> From -> Ordering)
-> (From -> From -> Bool)
-> (From -> From -> Bool)
-> (From -> From -> Bool)
-> (From -> From -> Bool)
-> (From -> From -> From)
-> (From -> From -> From)
-> Ord From
From -> From -> Bool
From -> From -> Ordering
From -> From -> From
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 :: From -> From -> Ordering
compare :: From -> From -> Ordering
$c< :: From -> From -> Bool
< :: From -> From -> Bool
$c<= :: From -> From -> Bool
<= :: From -> From -> Bool
$c> :: From -> From -> Bool
> :: From -> From -> Bool
$c>= :: From -> From -> Bool
>= :: From -> From -> Bool
$cmax :: From -> From -> From
max :: From -> From -> From
$cmin :: From -> From -> From
min :: From -> From -> From
Ord)
  deriving anyclass (Eq From
Eq From -> (Int -> From -> Int) -> (From -> Int) -> Hashable From
Int -> From -> Int
From -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> From -> Int
hashWithSalt :: Int -> From -> Int
$chash :: From -> Int
hash :: From -> Int
Hashable, From -> ()
(From -> ()) -> NFData From
forall a. (a -> ()) -> NFData a
$crnf :: From -> ()
rnf :: From -> ()
NFData)

data SelectJson = SelectJson
  { SelectJson -> Expression
selectJsonBody :: Expression,
    SelectJson -> [(ColumnName, ScalarType)]
selectJsonFields :: [(ColumnName, ScalarType)]
  }
  deriving stock (SelectJson -> SelectJson -> Bool
(SelectJson -> SelectJson -> Bool)
-> (SelectJson -> SelectJson -> Bool) -> Eq SelectJson
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SelectJson -> SelectJson -> Bool
== :: SelectJson -> SelectJson -> Bool
$c/= :: SelectJson -> SelectJson -> Bool
/= :: SelectJson -> SelectJson -> Bool
Eq, Eq SelectJson
Eq SelectJson
-> (SelectJson -> SelectJson -> Ordering)
-> (SelectJson -> SelectJson -> Bool)
-> (SelectJson -> SelectJson -> Bool)
-> (SelectJson -> SelectJson -> Bool)
-> (SelectJson -> SelectJson -> Bool)
-> (SelectJson -> SelectJson -> SelectJson)
-> (SelectJson -> SelectJson -> SelectJson)
-> Ord SelectJson
SelectJson -> SelectJson -> Bool
SelectJson -> SelectJson -> Ordering
SelectJson -> SelectJson -> SelectJson
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 :: SelectJson -> SelectJson -> Ordering
compare :: SelectJson -> SelectJson -> Ordering
$c< :: SelectJson -> SelectJson -> Bool
< :: SelectJson -> SelectJson -> Bool
$c<= :: SelectJson -> SelectJson -> Bool
<= :: SelectJson -> SelectJson -> Bool
$c> :: SelectJson -> SelectJson -> Bool
> :: SelectJson -> SelectJson -> Bool
$c>= :: SelectJson -> SelectJson -> Bool
>= :: SelectJson -> SelectJson -> Bool
$cmax :: SelectJson -> SelectJson -> SelectJson
max :: SelectJson -> SelectJson -> SelectJson
$cmin :: SelectJson -> SelectJson -> SelectJson
min :: SelectJson -> SelectJson -> SelectJson
Ord, Int -> SelectJson -> ShowS
[SelectJson] -> ShowS
SelectJson -> String
(Int -> SelectJson -> ShowS)
-> (SelectJson -> String)
-> ([SelectJson] -> ShowS)
-> Show SelectJson
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SelectJson -> ShowS
showsPrec :: Int -> SelectJson -> ShowS
$cshow :: SelectJson -> String
show :: SelectJson -> String
$cshowList :: [SelectJson] -> ShowS
showList :: [SelectJson] -> ShowS
Show, (forall x. SelectJson -> Rep SelectJson x)
-> (forall x. Rep SelectJson x -> SelectJson) -> Generic SelectJson
forall x. Rep SelectJson x -> SelectJson
forall x. SelectJson -> Rep SelectJson x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SelectJson -> Rep SelectJson x
from :: forall x. SelectJson -> Rep SelectJson x
$cto :: forall x. Rep SelectJson x -> SelectJson
to :: forall x. Rep SelectJson x -> SelectJson
Generic, Typeable SelectJson
Typeable SelectJson
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SelectJson -> c SelectJson)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SelectJson)
-> (SelectJson -> Constr)
-> (SelectJson -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SelectJson))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SelectJson))
-> ((forall b. Data b => b -> b) -> SelectJson -> SelectJson)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SelectJson -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SelectJson -> r)
-> (forall u. (forall d. Data d => d -> u) -> SelectJson -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SelectJson -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SelectJson -> m SelectJson)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SelectJson -> m SelectJson)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SelectJson -> m SelectJson)
-> Data SelectJson
SelectJson -> Constr
SelectJson -> DataType
(forall b. Data b => b -> b) -> SelectJson -> SelectJson
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SelectJson -> u
forall u. (forall d. Data d => d -> u) -> SelectJson -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelectJson -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectJson -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SelectJson -> m SelectJson
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SelectJson -> m SelectJson
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectJson
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SelectJson -> c SelectJson
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelectJson)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SelectJson)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SelectJson -> c SelectJson
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SelectJson -> c SelectJson
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectJson
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectJson
$ctoConstr :: SelectJson -> Constr
toConstr :: SelectJson -> Constr
$cdataTypeOf :: SelectJson -> DataType
dataTypeOf :: SelectJson -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelectJson)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelectJson)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SelectJson)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SelectJson)
$cgmapT :: (forall b. Data b => b -> b) -> SelectJson -> SelectJson
gmapT :: (forall b. Data b => b -> b) -> SelectJson -> SelectJson
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelectJson -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelectJson -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectJson -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectJson -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SelectJson -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SelectJson -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SelectJson -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SelectJson -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SelectJson -> m SelectJson
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SelectJson -> m SelectJson
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SelectJson -> m SelectJson
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SelectJson -> m SelectJson
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SelectJson -> m SelectJson
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SelectJson -> m SelectJson
Data, (forall (m :: * -> *). Quote m => SelectJson -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    SelectJson -> Code m SelectJson)
-> Lift SelectJson
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => SelectJson -> m Exp
forall (m :: * -> *). Quote m => SelectJson -> Code m SelectJson
$clift :: forall (m :: * -> *). Quote m => SelectJson -> m Exp
lift :: forall (m :: * -> *). Quote m => SelectJson -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => SelectJson -> Code m SelectJson
liftTyped :: forall (m :: * -> *). Quote m => SelectJson -> Code m SelectJson
Lift)
  deriving anyclass (Eq SelectJson
Eq SelectJson
-> (Int -> SelectJson -> Int)
-> (SelectJson -> Int)
-> Hashable SelectJson
Int -> SelectJson -> Int
SelectJson -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> SelectJson -> Int
hashWithSalt :: Int -> SelectJson -> Int
$chash :: SelectJson -> Int
hash :: SelectJson -> Int
Hashable, SelectJson -> ()
(SelectJson -> ()) -> NFData SelectJson
forall a. (a -> ()) -> NFData a
$crnf :: SelectJson -> ()
rnf :: SelectJson -> ()
NFData)

data SelectFromFunction = SelectFromFunction
  { SelectFromFunction -> FunctionName
sffFunctionName :: FunctionName,
    SelectFromFunction -> [Expression]
sffArguments :: [Expression]
  }
  deriving stock (SelectFromFunction -> SelectFromFunction -> Bool
(SelectFromFunction -> SelectFromFunction -> Bool)
-> (SelectFromFunction -> SelectFromFunction -> Bool)
-> Eq SelectFromFunction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SelectFromFunction -> SelectFromFunction -> Bool
== :: SelectFromFunction -> SelectFromFunction -> Bool
$c/= :: SelectFromFunction -> SelectFromFunction -> Bool
/= :: SelectFromFunction -> SelectFromFunction -> Bool
Eq, Int -> SelectFromFunction -> ShowS
[SelectFromFunction] -> ShowS
SelectFromFunction -> String
(Int -> SelectFromFunction -> ShowS)
-> (SelectFromFunction -> String)
-> ([SelectFromFunction] -> ShowS)
-> Show SelectFromFunction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SelectFromFunction -> ShowS
showsPrec :: Int -> SelectFromFunction -> ShowS
$cshow :: SelectFromFunction -> String
show :: SelectFromFunction -> String
$cshowList :: [SelectFromFunction] -> ShowS
showList :: [SelectFromFunction] -> ShowS
Show, (forall x. SelectFromFunction -> Rep SelectFromFunction x)
-> (forall x. Rep SelectFromFunction x -> SelectFromFunction)
-> Generic SelectFromFunction
forall x. Rep SelectFromFunction x -> SelectFromFunction
forall x. SelectFromFunction -> Rep SelectFromFunction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SelectFromFunction -> Rep SelectFromFunction x
from :: forall x. SelectFromFunction -> Rep SelectFromFunction x
$cto :: forall x. Rep SelectFromFunction x -> SelectFromFunction
to :: forall x. Rep SelectFromFunction x -> SelectFromFunction
Generic, Typeable SelectFromFunction
Typeable SelectFromFunction
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> SelectFromFunction
    -> c SelectFromFunction)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SelectFromFunction)
-> (SelectFromFunction -> Constr)
-> (SelectFromFunction -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SelectFromFunction))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SelectFromFunction))
-> ((forall b. Data b => b -> b)
    -> SelectFromFunction -> SelectFromFunction)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SelectFromFunction -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SelectFromFunction -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> SelectFromFunction -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SelectFromFunction -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SelectFromFunction -> m SelectFromFunction)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SelectFromFunction -> m SelectFromFunction)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SelectFromFunction -> m SelectFromFunction)
-> Data SelectFromFunction
SelectFromFunction -> Constr
SelectFromFunction -> DataType
(forall b. Data b => b -> b)
-> SelectFromFunction -> SelectFromFunction
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> SelectFromFunction -> u
forall u. (forall d. Data d => d -> u) -> SelectFromFunction -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelectFromFunction -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectFromFunction -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SelectFromFunction -> m SelectFromFunction
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelectFromFunction -> m SelectFromFunction
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectFromFunction
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelectFromFunction
-> c SelectFromFunction
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelectFromFunction)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelectFromFunction)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelectFromFunction
-> c SelectFromFunction
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelectFromFunction
-> c SelectFromFunction
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectFromFunction
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelectFromFunction
$ctoConstr :: SelectFromFunction -> Constr
toConstr :: SelectFromFunction -> Constr
$cdataTypeOf :: SelectFromFunction -> DataType
dataTypeOf :: SelectFromFunction -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelectFromFunction)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelectFromFunction)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelectFromFunction)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelectFromFunction)
$cgmapT :: (forall b. Data b => b -> b)
-> SelectFromFunction -> SelectFromFunction
gmapT :: (forall b. Data b => b -> b)
-> SelectFromFunction -> SelectFromFunction
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelectFromFunction -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelectFromFunction -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectFromFunction -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelectFromFunction -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SelectFromFunction -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SelectFromFunction -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SelectFromFunction -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SelectFromFunction -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SelectFromFunction -> m SelectFromFunction
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SelectFromFunction -> m SelectFromFunction
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelectFromFunction -> m SelectFromFunction
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelectFromFunction -> m SelectFromFunction
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelectFromFunction -> m SelectFromFunction
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelectFromFunction -> m SelectFromFunction
Data, (forall (m :: * -> *). Quote m => SelectFromFunction -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    SelectFromFunction -> Code m SelectFromFunction)
-> Lift SelectFromFunction
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => SelectFromFunction -> m Exp
forall (m :: * -> *).
Quote m =>
SelectFromFunction -> Code m SelectFromFunction
$clift :: forall (m :: * -> *). Quote m => SelectFromFunction -> m Exp
lift :: forall (m :: * -> *). Quote m => SelectFromFunction -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
SelectFromFunction -> Code m SelectFromFunction
liftTyped :: forall (m :: * -> *).
Quote m =>
SelectFromFunction -> Code m SelectFromFunction
Lift, Eq SelectFromFunction
Eq SelectFromFunction
-> (SelectFromFunction -> SelectFromFunction -> Ordering)
-> (SelectFromFunction -> SelectFromFunction -> Bool)
-> (SelectFromFunction -> SelectFromFunction -> Bool)
-> (SelectFromFunction -> SelectFromFunction -> Bool)
-> (SelectFromFunction -> SelectFromFunction -> Bool)
-> (SelectFromFunction -> SelectFromFunction -> SelectFromFunction)
-> (SelectFromFunction -> SelectFromFunction -> SelectFromFunction)
-> Ord SelectFromFunction
SelectFromFunction -> SelectFromFunction -> Bool
SelectFromFunction -> SelectFromFunction -> Ordering
SelectFromFunction -> SelectFromFunction -> SelectFromFunction
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 :: SelectFromFunction -> SelectFromFunction -> Ordering
compare :: SelectFromFunction -> SelectFromFunction -> Ordering
$c< :: SelectFromFunction -> SelectFromFunction -> Bool
< :: SelectFromFunction -> SelectFromFunction -> Bool
$c<= :: SelectFromFunction -> SelectFromFunction -> Bool
<= :: SelectFromFunction -> SelectFromFunction -> Bool
$c> :: SelectFromFunction -> SelectFromFunction -> Bool
> :: SelectFromFunction -> SelectFromFunction -> Bool
$c>= :: SelectFromFunction -> SelectFromFunction -> Bool
>= :: SelectFromFunction -> SelectFromFunction -> Bool
$cmax :: SelectFromFunction -> SelectFromFunction -> SelectFromFunction
max :: SelectFromFunction -> SelectFromFunction -> SelectFromFunction
$cmin :: SelectFromFunction -> SelectFromFunction -> SelectFromFunction
min :: SelectFromFunction -> SelectFromFunction -> SelectFromFunction
Ord)
  deriving anyclass (Eq SelectFromFunction
Eq SelectFromFunction
-> (Int -> SelectFromFunction -> Int)
-> (SelectFromFunction -> Int)
-> Hashable SelectFromFunction
Int -> SelectFromFunction -> Int
SelectFromFunction -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> SelectFromFunction -> Int
hashWithSalt :: Int -> SelectFromFunction -> Int
$chash :: SelectFromFunction -> Int
hash :: SelectFromFunction -> Int
Hashable, SelectFromFunction -> ()
(SelectFromFunction -> ()) -> NFData SelectFromFunction
forall a. (a -> ()) -> NFData a
$crnf :: SelectFromFunction -> ()
rnf :: SelectFromFunction -> ()
NFData)

data OpenJson = OpenJson
  { OpenJson -> Expression
openJsonExpression :: Expression,
    OpenJson -> NonEmpty JsonFieldSpec
openJsonWith :: NonEmpty JsonFieldSpec
  }
  deriving stock (OpenJson -> OpenJson -> Bool
(OpenJson -> OpenJson -> Bool)
-> (OpenJson -> OpenJson -> Bool) -> Eq OpenJson
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OpenJson -> OpenJson -> Bool
== :: OpenJson -> OpenJson -> Bool
$c/= :: OpenJson -> OpenJson -> Bool
/= :: OpenJson -> OpenJson -> Bool
Eq, Eq OpenJson
Eq OpenJson
-> (OpenJson -> OpenJson -> Ordering)
-> (OpenJson -> OpenJson -> Bool)
-> (OpenJson -> OpenJson -> Bool)
-> (OpenJson -> OpenJson -> Bool)
-> (OpenJson -> OpenJson -> Bool)
-> (OpenJson -> OpenJson -> OpenJson)
-> (OpenJson -> OpenJson -> OpenJson)
-> Ord OpenJson
OpenJson -> OpenJson -> Bool
OpenJson -> OpenJson -> Ordering
OpenJson -> OpenJson -> OpenJson
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 :: OpenJson -> OpenJson -> Ordering
compare :: OpenJson -> OpenJson -> Ordering
$c< :: OpenJson -> OpenJson -> Bool
< :: OpenJson -> OpenJson -> Bool
$c<= :: OpenJson -> OpenJson -> Bool
<= :: OpenJson -> OpenJson -> Bool
$c> :: OpenJson -> OpenJson -> Bool
> :: OpenJson -> OpenJson -> Bool
$c>= :: OpenJson -> OpenJson -> Bool
>= :: OpenJson -> OpenJson -> Bool
$cmax :: OpenJson -> OpenJson -> OpenJson
max :: OpenJson -> OpenJson -> OpenJson
$cmin :: OpenJson -> OpenJson -> OpenJson
min :: OpenJson -> OpenJson -> OpenJson
Ord, Int -> OpenJson -> ShowS
[OpenJson] -> ShowS
OpenJson -> String
(Int -> OpenJson -> ShowS)
-> (OpenJson -> String) -> ([OpenJson] -> ShowS) -> Show OpenJson
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OpenJson -> ShowS
showsPrec :: Int -> OpenJson -> ShowS
$cshow :: OpenJson -> String
show :: OpenJson -> String
$cshowList :: [OpenJson] -> ShowS
showList :: [OpenJson] -> ShowS
Show, (forall x. OpenJson -> Rep OpenJson x)
-> (forall x. Rep OpenJson x -> OpenJson) -> Generic OpenJson
forall x. Rep OpenJson x -> OpenJson
forall x. OpenJson -> Rep OpenJson x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OpenJson -> Rep OpenJson x
from :: forall x. OpenJson -> Rep OpenJson x
$cto :: forall x. Rep OpenJson x -> OpenJson
to :: forall x. Rep OpenJson x -> OpenJson
Generic, Typeable OpenJson
Typeable OpenJson
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> OpenJson -> c OpenJson)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c OpenJson)
-> (OpenJson -> Constr)
-> (OpenJson -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c OpenJson))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OpenJson))
-> ((forall b. Data b => b -> b) -> OpenJson -> OpenJson)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> OpenJson -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> OpenJson -> r)
-> (forall u. (forall d. Data d => d -> u) -> OpenJson -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> OpenJson -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> OpenJson -> m OpenJson)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> OpenJson -> m OpenJson)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> OpenJson -> m OpenJson)
-> Data OpenJson
OpenJson -> Constr
OpenJson -> DataType
(forall b. Data b => b -> b) -> OpenJson -> OpenJson
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> OpenJson -> u
forall u. (forall d. Data d => d -> u) -> OpenJson -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OpenJson -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OpenJson -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OpenJson -> m OpenJson
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OpenJson -> m OpenJson
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OpenJson
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OpenJson -> c OpenJson
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OpenJson)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OpenJson)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OpenJson -> c OpenJson
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OpenJson -> c OpenJson
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OpenJson
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OpenJson
$ctoConstr :: OpenJson -> Constr
toConstr :: OpenJson -> Constr
$cdataTypeOf :: OpenJson -> DataType
dataTypeOf :: OpenJson -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OpenJson)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OpenJson)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OpenJson)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OpenJson)
$cgmapT :: (forall b. Data b => b -> b) -> OpenJson -> OpenJson
gmapT :: (forall b. Data b => b -> b) -> OpenJson -> OpenJson
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OpenJson -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OpenJson -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OpenJson -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OpenJson -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OpenJson -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> OpenJson -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OpenJson -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OpenJson -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OpenJson -> m OpenJson
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OpenJson -> m OpenJson
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OpenJson -> m OpenJson
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OpenJson -> m OpenJson
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OpenJson -> m OpenJson
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OpenJson -> m OpenJson
Data, (forall (m :: * -> *). Quote m => OpenJson -> m Exp)
-> (forall (m :: * -> *). Quote m => OpenJson -> Code m OpenJson)
-> Lift OpenJson
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => OpenJson -> m Exp
forall (m :: * -> *). Quote m => OpenJson -> Code m OpenJson
$clift :: forall (m :: * -> *). Quote m => OpenJson -> m Exp
lift :: forall (m :: * -> *). Quote m => OpenJson -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => OpenJson -> Code m OpenJson
liftTyped :: forall (m :: * -> *). Quote m => OpenJson -> Code m OpenJson
Lift)
  deriving anyclass (Eq OpenJson
Eq OpenJson
-> (Int -> OpenJson -> Int)
-> (OpenJson -> Int)
-> Hashable OpenJson
Int -> OpenJson -> Int
OpenJson -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> OpenJson -> Int
hashWithSalt :: Int -> OpenJson -> Int
$chash :: OpenJson -> Int
hash :: OpenJson -> Int
Hashable, OpenJson -> ()
(OpenJson -> ()) -> NFData OpenJson
forall a. (a -> ()) -> NFData a
$crnf :: OpenJson -> ()
rnf :: OpenJson -> ()
NFData)

data JsonFieldSpec
  = IntField Text
  | JsonField Text
  deriving stock (JsonFieldSpec -> JsonFieldSpec -> Bool
(JsonFieldSpec -> JsonFieldSpec -> Bool)
-> (JsonFieldSpec -> JsonFieldSpec -> Bool) -> Eq JsonFieldSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JsonFieldSpec -> JsonFieldSpec -> Bool
== :: JsonFieldSpec -> JsonFieldSpec -> Bool
$c/= :: JsonFieldSpec -> JsonFieldSpec -> Bool
/= :: JsonFieldSpec -> JsonFieldSpec -> Bool
Eq, Eq JsonFieldSpec
Eq JsonFieldSpec
-> (JsonFieldSpec -> JsonFieldSpec -> Ordering)
-> (JsonFieldSpec -> JsonFieldSpec -> Bool)
-> (JsonFieldSpec -> JsonFieldSpec -> Bool)
-> (JsonFieldSpec -> JsonFieldSpec -> Bool)
-> (JsonFieldSpec -> JsonFieldSpec -> Bool)
-> (JsonFieldSpec -> JsonFieldSpec -> JsonFieldSpec)
-> (JsonFieldSpec -> JsonFieldSpec -> JsonFieldSpec)
-> Ord JsonFieldSpec
JsonFieldSpec -> JsonFieldSpec -> Bool
JsonFieldSpec -> JsonFieldSpec -> Ordering
JsonFieldSpec -> JsonFieldSpec -> JsonFieldSpec
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 :: JsonFieldSpec -> JsonFieldSpec -> Ordering
compare :: JsonFieldSpec -> JsonFieldSpec -> Ordering
$c< :: JsonFieldSpec -> JsonFieldSpec -> Bool
< :: JsonFieldSpec -> JsonFieldSpec -> Bool
$c<= :: JsonFieldSpec -> JsonFieldSpec -> Bool
<= :: JsonFieldSpec -> JsonFieldSpec -> Bool
$c> :: JsonFieldSpec -> JsonFieldSpec -> Bool
> :: JsonFieldSpec -> JsonFieldSpec -> Bool
$c>= :: JsonFieldSpec -> JsonFieldSpec -> Bool
>= :: JsonFieldSpec -> JsonFieldSpec -> Bool
$cmax :: JsonFieldSpec -> JsonFieldSpec -> JsonFieldSpec
max :: JsonFieldSpec -> JsonFieldSpec -> JsonFieldSpec
$cmin :: JsonFieldSpec -> JsonFieldSpec -> JsonFieldSpec
min :: JsonFieldSpec -> JsonFieldSpec -> JsonFieldSpec
Ord, Int -> JsonFieldSpec -> ShowS
[JsonFieldSpec] -> ShowS
JsonFieldSpec -> String
(Int -> JsonFieldSpec -> ShowS)
-> (JsonFieldSpec -> String)
-> ([JsonFieldSpec] -> ShowS)
-> Show JsonFieldSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JsonFieldSpec -> ShowS
showsPrec :: Int -> JsonFieldSpec -> ShowS
$cshow :: JsonFieldSpec -> String
show :: JsonFieldSpec -> String
$cshowList :: [JsonFieldSpec] -> ShowS
showList :: [JsonFieldSpec] -> ShowS
Show, (forall x. JsonFieldSpec -> Rep JsonFieldSpec x)
-> (forall x. Rep JsonFieldSpec x -> JsonFieldSpec)
-> Generic JsonFieldSpec
forall x. Rep JsonFieldSpec x -> JsonFieldSpec
forall x. JsonFieldSpec -> Rep JsonFieldSpec x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JsonFieldSpec -> Rep JsonFieldSpec x
from :: forall x. JsonFieldSpec -> Rep JsonFieldSpec x
$cto :: forall x. Rep JsonFieldSpec x -> JsonFieldSpec
to :: forall x. Rep JsonFieldSpec x -> JsonFieldSpec
Generic, Typeable JsonFieldSpec
Typeable JsonFieldSpec
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> JsonFieldSpec -> c JsonFieldSpec)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c JsonFieldSpec)
-> (JsonFieldSpec -> Constr)
-> (JsonFieldSpec -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c JsonFieldSpec))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c JsonFieldSpec))
-> ((forall b. Data b => b -> b) -> JsonFieldSpec -> JsonFieldSpec)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> JsonFieldSpec -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> JsonFieldSpec -> r)
-> (forall u. (forall d. Data d => d -> u) -> JsonFieldSpec -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> JsonFieldSpec -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> JsonFieldSpec -> m JsonFieldSpec)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> JsonFieldSpec -> m JsonFieldSpec)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> JsonFieldSpec -> m JsonFieldSpec)
-> Data JsonFieldSpec
JsonFieldSpec -> Constr
JsonFieldSpec -> DataType
(forall b. Data b => b -> b) -> JsonFieldSpec -> JsonFieldSpec
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> JsonFieldSpec -> u
forall u. (forall d. Data d => d -> u) -> JsonFieldSpec -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JsonFieldSpec -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JsonFieldSpec -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JsonFieldSpec -> m JsonFieldSpec
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JsonFieldSpec -> m JsonFieldSpec
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JsonFieldSpec
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JsonFieldSpec -> c JsonFieldSpec
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JsonFieldSpec)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c JsonFieldSpec)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JsonFieldSpec -> c JsonFieldSpec
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JsonFieldSpec -> c JsonFieldSpec
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JsonFieldSpec
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JsonFieldSpec
$ctoConstr :: JsonFieldSpec -> Constr
toConstr :: JsonFieldSpec -> Constr
$cdataTypeOf :: JsonFieldSpec -> DataType
dataTypeOf :: JsonFieldSpec -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JsonFieldSpec)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JsonFieldSpec)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c JsonFieldSpec)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c JsonFieldSpec)
$cgmapT :: (forall b. Data b => b -> b) -> JsonFieldSpec -> JsonFieldSpec
gmapT :: (forall b. Data b => b -> b) -> JsonFieldSpec -> JsonFieldSpec
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JsonFieldSpec -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JsonFieldSpec -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JsonFieldSpec -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JsonFieldSpec -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> JsonFieldSpec -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> JsonFieldSpec -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JsonFieldSpec -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JsonFieldSpec -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JsonFieldSpec -> m JsonFieldSpec
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JsonFieldSpec -> m JsonFieldSpec
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JsonFieldSpec -> m JsonFieldSpec
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JsonFieldSpec -> m JsonFieldSpec
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JsonFieldSpec -> m JsonFieldSpec
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JsonFieldSpec -> m JsonFieldSpec
Data, (forall (m :: * -> *). Quote m => JsonFieldSpec -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    JsonFieldSpec -> Code m JsonFieldSpec)
-> Lift JsonFieldSpec
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => JsonFieldSpec -> m Exp
forall (m :: * -> *).
Quote m =>
JsonFieldSpec -> Code m JsonFieldSpec
$clift :: forall (m :: * -> *). Quote m => JsonFieldSpec -> m Exp
lift :: forall (m :: * -> *). Quote m => JsonFieldSpec -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
JsonFieldSpec -> Code m JsonFieldSpec
liftTyped :: forall (m :: * -> *).
Quote m =>
JsonFieldSpec -> Code m JsonFieldSpec
Lift)
  deriving anyclass (Value -> Parser [JsonFieldSpec]
Value -> Parser JsonFieldSpec
(Value -> Parser JsonFieldSpec)
-> (Value -> Parser [JsonFieldSpec]) -> FromJSON JsonFieldSpec
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser JsonFieldSpec
parseJSON :: Value -> Parser JsonFieldSpec
$cparseJSONList :: Value -> Parser [JsonFieldSpec]
parseJSONList :: Value -> Parser [JsonFieldSpec]
FromJSON, Eq JsonFieldSpec
Eq JsonFieldSpec
-> (Int -> JsonFieldSpec -> Int)
-> (JsonFieldSpec -> Int)
-> Hashable JsonFieldSpec
Int -> JsonFieldSpec -> Int
JsonFieldSpec -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> JsonFieldSpec -> Int
hashWithSalt :: Int -> JsonFieldSpec -> Int
$chash :: JsonFieldSpec -> Int
hash :: JsonFieldSpec -> Int
Hashable, JsonFieldSpec -> ()
(JsonFieldSpec -> ()) -> NFData JsonFieldSpec
forall a. (a -> ()) -> NFData a
$crnf :: JsonFieldSpec -> ()
rnf :: JsonFieldSpec -> ()
NFData, [JsonFieldSpec] -> Value
[JsonFieldSpec] -> Encoding
JsonFieldSpec -> Value
JsonFieldSpec -> Encoding
(JsonFieldSpec -> Value)
-> (JsonFieldSpec -> Encoding)
-> ([JsonFieldSpec] -> Value)
-> ([JsonFieldSpec] -> Encoding)
-> ToJSON JsonFieldSpec
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: JsonFieldSpec -> Value
toJSON :: JsonFieldSpec -> Value
$ctoEncoding :: JsonFieldSpec -> Encoding
toEncoding :: JsonFieldSpec -> Encoding
$ctoJSONList :: [JsonFieldSpec] -> Value
toJSONList :: [JsonFieldSpec] -> Value
$ctoEncodingList :: [JsonFieldSpec] -> Encoding
toEncodingList :: [JsonFieldSpec] -> Encoding
ToJSON)

data Aliased a = Aliased
  { forall a. Aliased a -> a
aliasedThing :: a,
    forall a. Aliased a -> Text
aliasedAlias :: Text
  }
  deriving stock (Aliased a -> Aliased a -> Bool
(Aliased a -> Aliased a -> Bool)
-> (Aliased a -> Aliased a -> Bool) -> Eq (Aliased a)
forall a. Eq a => Aliased a -> Aliased a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Aliased a -> Aliased a -> Bool
== :: Aliased a -> Aliased a -> Bool
$c/= :: forall a. Eq a => Aliased a -> Aliased a -> Bool
/= :: Aliased a -> Aliased a -> Bool
Eq, Eq (Aliased a)
Eq (Aliased a)
-> (Aliased a -> Aliased a -> Ordering)
-> (Aliased a -> Aliased a -> Bool)
-> (Aliased a -> Aliased a -> Bool)
-> (Aliased a -> Aliased a -> Bool)
-> (Aliased a -> Aliased a -> Bool)
-> (Aliased a -> Aliased a -> Aliased a)
-> (Aliased a -> Aliased a -> Aliased a)
-> Ord (Aliased a)
Aliased a -> Aliased a -> Bool
Aliased a -> Aliased a -> Ordering
Aliased a -> Aliased a -> Aliased a
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
forall {a}. Ord a => Eq (Aliased a)
forall a. Ord a => Aliased a -> Aliased a -> Bool
forall a. Ord a => Aliased a -> Aliased a -> Ordering
forall a. Ord a => Aliased a -> Aliased a -> Aliased a
$ccompare :: forall a. Ord a => Aliased a -> Aliased a -> Ordering
compare :: Aliased a -> Aliased a -> Ordering
$c< :: forall a. Ord a => Aliased a -> Aliased a -> Bool
< :: Aliased a -> Aliased a -> Bool
$c<= :: forall a. Ord a => Aliased a -> Aliased a -> Bool
<= :: Aliased a -> Aliased a -> Bool
$c> :: forall a. Ord a => Aliased a -> Aliased a -> Bool
> :: Aliased a -> Aliased a -> Bool
$c>= :: forall a. Ord a => Aliased a -> Aliased a -> Bool
>= :: Aliased a -> Aliased a -> Bool
$cmax :: forall a. Ord a => Aliased a -> Aliased a -> Aliased a
max :: Aliased a -> Aliased a -> Aliased a
$cmin :: forall a. Ord a => Aliased a -> Aliased a -> Aliased a
min :: Aliased a -> Aliased a -> Aliased a
Ord, Int -> Aliased a -> ShowS
[Aliased a] -> ShowS
Aliased a -> String
(Int -> Aliased a -> ShowS)
-> (Aliased a -> String)
-> ([Aliased a] -> ShowS)
-> Show (Aliased a)
forall a. Show a => Int -> Aliased a -> ShowS
forall a. Show a => [Aliased a] -> ShowS
forall a. Show a => Aliased a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Aliased a -> ShowS
showsPrec :: Int -> Aliased a -> ShowS
$cshow :: forall a. Show a => Aliased a -> String
show :: Aliased a -> String
$cshowList :: forall a. Show a => [Aliased a] -> ShowS
showList :: [Aliased a] -> ShowS
Show, (forall x. Aliased a -> Rep (Aliased a) x)
-> (forall x. Rep (Aliased a) x -> Aliased a)
-> Generic (Aliased a)
forall x. Rep (Aliased a) x -> Aliased a
forall x. Aliased a -> Rep (Aliased a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Aliased a) x -> Aliased a
forall a x. Aliased a -> Rep (Aliased a) x
$cfrom :: forall a x. Aliased a -> Rep (Aliased a) x
from :: forall x. Aliased a -> Rep (Aliased a) x
$cto :: forall a x. Rep (Aliased a) x -> Aliased a
to :: forall x. Rep (Aliased a) x -> Aliased a
Generic, Typeable (Aliased a)
Typeable (Aliased a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Aliased a -> c (Aliased a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Aliased a))
-> (Aliased a -> Constr)
-> (Aliased a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Aliased a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Aliased a)))
-> ((forall b. Data b => b -> b) -> Aliased a -> Aliased a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Aliased a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Aliased a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Aliased a -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Aliased a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Aliased a -> m (Aliased a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Aliased a -> m (Aliased a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Aliased a -> m (Aliased a))
-> Data (Aliased a)
Aliased a -> Constr
Aliased a -> DataType
(forall b. Data b => b -> b) -> Aliased a -> Aliased a
forall {a}. Data a => Typeable (Aliased a)
forall a. Data a => Aliased a -> Constr
forall a. Data a => Aliased a -> DataType
forall a.
Data a =>
(forall b. Data b => b -> b) -> Aliased a -> Aliased a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Aliased a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> Aliased a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Aliased a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Aliased a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Aliased a -> m (Aliased a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Aliased a -> m (Aliased a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Aliased a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Aliased a -> c (Aliased a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Aliased a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Aliased a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Aliased a -> u
forall u. (forall d. Data d => d -> u) -> Aliased a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Aliased a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Aliased a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Aliased a -> m (Aliased a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Aliased a -> m (Aliased a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Aliased a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Aliased a -> c (Aliased a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Aliased a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Aliased a))
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Aliased a -> c (Aliased a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Aliased a -> c (Aliased a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Aliased a)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Aliased a)
$ctoConstr :: forall a. Data a => Aliased a -> Constr
toConstr :: Aliased a -> Constr
$cdataTypeOf :: forall a. Data a => Aliased a -> DataType
dataTypeOf :: Aliased a -> DataType
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Aliased a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Aliased a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Aliased a))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Aliased a))
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Aliased a -> Aliased a
gmapT :: (forall b. Data b => b -> b) -> Aliased a -> Aliased a
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Aliased a -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Aliased a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Aliased a -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Aliased a -> r
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> Aliased a -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Aliased a -> [u]
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Aliased a -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Aliased a -> u
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Aliased a -> m (Aliased a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Aliased a -> m (Aliased a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Aliased a -> m (Aliased a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Aliased a -> m (Aliased a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Aliased a -> m (Aliased a)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Aliased a -> m (Aliased a)
Data, (forall (m :: * -> *). Quote m => Aliased a -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    Aliased a -> Code m (Aliased a))
-> Lift (Aliased a)
forall a (m :: * -> *). (Lift a, Quote m) => Aliased a -> m Exp
forall a (m :: * -> *).
(Lift a, Quote m) =>
Aliased a -> Code m (Aliased a)
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Aliased a -> m Exp
forall (m :: * -> *). Quote m => Aliased a -> Code m (Aliased a)
$clift :: forall a (m :: * -> *). (Lift a, Quote m) => Aliased a -> m Exp
lift :: forall (m :: * -> *). Quote m => Aliased a -> m Exp
$cliftTyped :: forall a (m :: * -> *).
(Lift a, Quote m) =>
Aliased a -> Code m (Aliased a)
liftTyped :: forall (m :: * -> *). Quote m => Aliased a -> Code m (Aliased a)
Lift, (forall a b. (a -> b) -> Aliased a -> Aliased b)
-> (forall a b. a -> Aliased b -> Aliased a) -> Functor Aliased
forall a b. a -> Aliased b -> Aliased a
forall a b. (a -> b) -> Aliased a -> Aliased 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) -> Aliased a -> Aliased b
fmap :: forall a b. (a -> b) -> Aliased a -> Aliased b
$c<$ :: forall a b. a -> Aliased b -> Aliased a
<$ :: forall a b. a -> Aliased b -> Aliased a
Functor)

deriving anyclass instance (FromJSON a) => FromJSON (Aliased a)

deriving anyclass instance (Hashable a) => Hashable (Aliased a)

deriving anyclass instance (ToJSON a) => ToJSON (Aliased a)

deriving anyclass instance (NFData a) => NFData (Aliased a)

data TableName = TableName
  { TableName -> Text
tableName :: Text,
    TableName -> Text
tableNameSchema :: Text
  }
  deriving stock (TableName -> TableName -> Bool
(TableName -> TableName -> Bool)
-> (TableName -> TableName -> Bool) -> Eq TableName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TableName -> TableName -> Bool
== :: TableName -> TableName -> Bool
$c/= :: TableName -> TableName -> Bool
/= :: TableName -> TableName -> Bool
Eq, Int -> TableName -> ShowS
[TableName] -> ShowS
TableName -> String
(Int -> TableName -> ShowS)
-> (TableName -> String)
-> ([TableName] -> ShowS)
-> Show TableName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TableName -> ShowS
showsPrec :: Int -> TableName -> ShowS
$cshow :: TableName -> String
show :: TableName -> String
$cshowList :: [TableName] -> ShowS
showList :: [TableName] -> ShowS
Show, (forall x. TableName -> Rep TableName x)
-> (forall x. Rep TableName x -> TableName) -> Generic TableName
forall x. Rep TableName x -> TableName
forall x. TableName -> Rep TableName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TableName -> Rep TableName x
from :: forall x. TableName -> Rep TableName x
$cto :: forall x. Rep TableName x -> TableName
to :: forall x. Rep TableName x -> TableName
Generic, Typeable TableName
Typeable TableName
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> TableName -> c TableName)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c TableName)
-> (TableName -> Constr)
-> (TableName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c TableName))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TableName))
-> ((forall b. Data b => b -> b) -> TableName -> TableName)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> TableName -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> TableName -> r)
-> (forall u. (forall d. Data d => d -> u) -> TableName -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> TableName -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> TableName -> m TableName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TableName -> m TableName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TableName -> m TableName)
-> Data TableName
TableName -> Constr
TableName -> DataType
(forall b. Data b => b -> b) -> TableName -> TableName
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TableName -> u
forall u. (forall d. Data d => d -> u) -> TableName -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TableName -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TableName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TableName -> m TableName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TableName -> m TableName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TableName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TableName -> c TableName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TableName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TableName)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TableName -> c TableName
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TableName -> c TableName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TableName
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TableName
$ctoConstr :: TableName -> Constr
toConstr :: TableName -> Constr
$cdataTypeOf :: TableName -> DataType
dataTypeOf :: TableName -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TableName)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TableName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TableName)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TableName)
$cgmapT :: (forall b. Data b => b -> b) -> TableName -> TableName
gmapT :: (forall b. Data b => b -> b) -> TableName -> TableName
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TableName -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TableName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TableName -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TableName -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TableName -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> TableName -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TableName -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TableName -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TableName -> m TableName
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TableName -> m TableName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TableName -> m TableName
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TableName -> m TableName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TableName -> m TableName
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TableName -> m TableName
Data, (forall (m :: * -> *). Quote m => TableName -> m Exp)
-> (forall (m :: * -> *). Quote m => TableName -> Code m TableName)
-> Lift TableName
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => TableName -> m Exp
forall (m :: * -> *). Quote m => TableName -> Code m TableName
$clift :: forall (m :: * -> *). Quote m => TableName -> m Exp
lift :: forall (m :: * -> *). Quote m => TableName -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => TableName -> Code m TableName
liftTyped :: forall (m :: * -> *). Quote m => TableName -> Code m TableName
Lift, Eq TableName
Eq TableName
-> (TableName -> TableName -> Ordering)
-> (TableName -> TableName -> Bool)
-> (TableName -> TableName -> Bool)
-> (TableName -> TableName -> Bool)
-> (TableName -> TableName -> Bool)
-> (TableName -> TableName -> TableName)
-> (TableName -> TableName -> TableName)
-> Ord TableName
TableName -> TableName -> Bool
TableName -> TableName -> Ordering
TableName -> TableName -> TableName
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 :: TableName -> TableName -> Ordering
compare :: TableName -> TableName -> Ordering
$c< :: TableName -> TableName -> Bool
< :: TableName -> TableName -> Bool
$c<= :: TableName -> TableName -> Bool
<= :: TableName -> TableName -> Bool
$c> :: TableName -> TableName -> Bool
> :: TableName -> TableName -> Bool
$c>= :: TableName -> TableName -> Bool
>= :: TableName -> TableName -> Bool
$cmax :: TableName -> TableName -> TableName
max :: TableName -> TableName -> TableName
$cmin :: TableName -> TableName -> TableName
min :: TableName -> TableName -> TableName
Ord)
  deriving anyclass (Eq TableName
Eq TableName
-> (Int -> TableName -> Int)
-> (TableName -> Int)
-> Hashable TableName
Int -> TableName -> Int
TableName -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> TableName -> Int
hashWithSalt :: Int -> TableName -> Int
$chash :: TableName -> Int
hash :: TableName -> Int
Hashable, TableName -> ()
(TableName -> ()) -> NFData TableName
forall a. (a -> ()) -> NFData a
$crnf :: TableName -> ()
rnf :: TableName -> ()
NFData, ToJSONKeyFunction [TableName]
ToJSONKeyFunction TableName
ToJSONKeyFunction TableName
-> ToJSONKeyFunction [TableName] -> ToJSONKey TableName
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction TableName
toJSONKey :: ToJSONKeyFunction TableName
$ctoJSONKeyList :: ToJSONKeyFunction [TableName]
toJSONKeyList :: ToJSONKeyFunction [TableName]
ToJSONKey)

instance HasCodec TableName where
  codec :: JSONCodec TableName
codec =
    Text -> ObjectCodec TableName TableName -> JSONCodec TableName
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"BigQueryTableName"
      (ObjectCodec TableName TableName -> JSONCodec TableName)
-> ObjectCodec TableName TableName -> JSONCodec TableName
forall a b. (a -> b) -> a -> b
$ Text -> Text -> TableName
TableName
      (Text -> Text -> TableName)
-> Codec Object TableName Text
-> Codec Object TableName (Text -> TableName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec Text Text
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"name"
      ObjectCodec Text Text
-> (TableName -> Text) -> Codec Object TableName Text
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= TableName -> Text
tableName
        Codec Object TableName (Text -> TableName)
-> Codec Object TableName Text -> ObjectCodec TableName TableName
forall a b.
Codec Object TableName (a -> b)
-> Codec Object TableName a -> Codec Object TableName b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec Text Text
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"dataset"
      ObjectCodec Text Text
-> (TableName -> Text) -> Codec Object TableName Text
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= TableName -> Text
tableNameSchema

instance FromJSON TableName where
  parseJSON :: Value -> Parser TableName
parseJSON =
    String -> (Object -> Parser TableName) -> Value -> Parser TableName
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject
      String
"TableName"
      (\Object
o -> Text -> Text -> TableName
TableName (Text -> Text -> TableName)
-> Parser Text -> Parser (Text -> TableName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
J..: Key
"name" Parser (Text -> TableName) -> Parser Text -> Parser TableName
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
J..: Key
"dataset")

instance ToJSON TableName where
  toJSON :: TableName -> Value
toJSON TableName {Text
$sel:tableName:TableName :: TableName -> Text
$sel:tableNameSchema:TableName :: TableName -> Text
tableName :: Text
tableNameSchema :: Text
..} = [Pair] -> Value
J.object [Key
"name" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= Text
tableName, Key
"dataset" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= Text
tableNameSchema]

instance ToTxt TableName where
  toTxt :: TableName -> Text
toTxt TableName {Text
$sel:tableName:TableName :: TableName -> Text
$sel:tableNameSchema:TableName :: TableName -> Text
tableName :: Text
tableNameSchema :: Text
..} = Text
tableNameSchema Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tableName

instance ToErrorValue TableName where
  toErrorValue :: TableName -> ErrorMessage
toErrorValue = Text -> ErrorMessage
ErrorValue.squote (Text -> ErrorMessage)
-> (TableName -> Text) -> TableName -> ErrorMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableName -> Text
forall a. ToTxt a => a -> Text
toTxt

data FieldName = FieldName
  { FieldName -> Text
fieldName :: Text,
    FieldName -> Text
fieldNameEntity :: Text
  }
  deriving stock (FieldName -> FieldName -> Bool
(FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> Bool) -> Eq FieldName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FieldName -> FieldName -> Bool
== :: FieldName -> FieldName -> Bool
$c/= :: FieldName -> FieldName -> Bool
/= :: FieldName -> FieldName -> Bool
Eq, Eq FieldName
Eq FieldName
-> (FieldName -> FieldName -> Ordering)
-> (FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> FieldName)
-> (FieldName -> FieldName -> FieldName)
-> Ord FieldName
FieldName -> FieldName -> Bool
FieldName -> FieldName -> Ordering
FieldName -> FieldName -> FieldName
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 :: FieldName -> FieldName -> Ordering
compare :: FieldName -> FieldName -> Ordering
$c< :: FieldName -> FieldName -> Bool
< :: FieldName -> FieldName -> Bool
$c<= :: FieldName -> FieldName -> Bool
<= :: FieldName -> FieldName -> Bool
$c> :: FieldName -> FieldName -> Bool
> :: FieldName -> FieldName -> Bool
$c>= :: FieldName -> FieldName -> Bool
>= :: FieldName -> FieldName -> Bool
$cmax :: FieldName -> FieldName -> FieldName
max :: FieldName -> FieldName -> FieldName
$cmin :: FieldName -> FieldName -> FieldName
min :: FieldName -> FieldName -> FieldName
Ord, Int -> FieldName -> ShowS
[FieldName] -> ShowS
FieldName -> String
(Int -> FieldName -> ShowS)
-> (FieldName -> String)
-> ([FieldName] -> ShowS)
-> Show FieldName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FieldName -> ShowS
showsPrec :: Int -> FieldName -> ShowS
$cshow :: FieldName -> String
show :: FieldName -> String
$cshowList :: [FieldName] -> ShowS
showList :: [FieldName] -> ShowS
Show, (forall x. FieldName -> Rep FieldName x)
-> (forall x. Rep FieldName x -> FieldName) -> Generic FieldName
forall x. Rep FieldName x -> FieldName
forall x. FieldName -> Rep FieldName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FieldName -> Rep FieldName x
from :: forall x. FieldName -> Rep FieldName x
$cto :: forall x. Rep FieldName x -> FieldName
to :: forall x. Rep FieldName x -> FieldName
Generic, Typeable FieldName
Typeable FieldName
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> FieldName -> c FieldName)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c FieldName)
-> (FieldName -> Constr)
-> (FieldName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c FieldName))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FieldName))
-> ((forall b. Data b => b -> b) -> FieldName -> FieldName)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> FieldName -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> FieldName -> r)
-> (forall u. (forall d. Data d => d -> u) -> FieldName -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> FieldName -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> FieldName -> m FieldName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FieldName -> m FieldName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FieldName -> m FieldName)
-> Data FieldName
FieldName -> Constr
FieldName -> DataType
(forall b. Data b => b -> b) -> FieldName -> FieldName
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> FieldName -> u
forall u. (forall d. Data d => d -> u) -> FieldName -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FieldName -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FieldName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FieldName -> m FieldName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FieldName -> m FieldName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FieldName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FieldName -> c FieldName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FieldName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FieldName)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FieldName -> c FieldName
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FieldName -> c FieldName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FieldName
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FieldName
$ctoConstr :: FieldName -> Constr
toConstr :: FieldName -> Constr
$cdataTypeOf :: FieldName -> DataType
dataTypeOf :: FieldName -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FieldName)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FieldName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FieldName)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FieldName)
$cgmapT :: (forall b. Data b => b -> b) -> FieldName -> FieldName
gmapT :: (forall b. Data b => b -> b) -> FieldName -> FieldName
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FieldName -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FieldName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FieldName -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FieldName -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FieldName -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> FieldName -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FieldName -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FieldName -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FieldName -> m FieldName
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FieldName -> m FieldName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FieldName -> m FieldName
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FieldName -> m FieldName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FieldName -> m FieldName
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FieldName -> m FieldName
Data, (forall (m :: * -> *). Quote m => FieldName -> m Exp)
-> (forall (m :: * -> *). Quote m => FieldName -> Code m FieldName)
-> Lift FieldName
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => FieldName -> m Exp
forall (m :: * -> *). Quote m => FieldName -> Code m FieldName
$clift :: forall (m :: * -> *). Quote m => FieldName -> m Exp
lift :: forall (m :: * -> *). Quote m => FieldName -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => FieldName -> Code m FieldName
liftTyped :: forall (m :: * -> *). Quote m => FieldName -> Code m FieldName
Lift)
  deriving anyclass (Value -> Parser [FieldName]
Value -> Parser FieldName
(Value -> Parser FieldName)
-> (Value -> Parser [FieldName]) -> FromJSON FieldName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser FieldName
parseJSON :: Value -> Parser FieldName
$cparseJSONList :: Value -> Parser [FieldName]
parseJSONList :: Value -> Parser [FieldName]
FromJSON, Eq FieldName
Eq FieldName
-> (Int -> FieldName -> Int)
-> (FieldName -> Int)
-> Hashable FieldName
Int -> FieldName -> Int
FieldName -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> FieldName -> Int
hashWithSalt :: Int -> FieldName -> Int
$chash :: FieldName -> Int
hash :: FieldName -> Int
Hashable, FieldName -> ()
(FieldName -> ()) -> NFData FieldName
forall a. (a -> ()) -> NFData a
$crnf :: FieldName -> ()
rnf :: FieldName -> ()
NFData, [FieldName] -> Value
[FieldName] -> Encoding
FieldName -> Value
FieldName -> Encoding
(FieldName -> Value)
-> (FieldName -> Encoding)
-> ([FieldName] -> Value)
-> ([FieldName] -> Encoding)
-> ToJSON FieldName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: FieldName -> Value
toJSON :: FieldName -> Value
$ctoEncoding :: FieldName -> Encoding
toEncoding :: FieldName -> Encoding
$ctoJSONList :: [FieldName] -> Value
toJSONList :: [FieldName] -> Value
$ctoEncodingList :: [FieldName] -> Encoding
toEncodingList :: [FieldName] -> Encoding
ToJSON)

newtype ColumnName = ColumnName
  { ColumnName -> Text
columnName :: Text
  }
  deriving stock (ColumnName -> ColumnName -> Bool
(ColumnName -> ColumnName -> Bool)
-> (ColumnName -> ColumnName -> Bool) -> Eq ColumnName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ColumnName -> ColumnName -> Bool
== :: ColumnName -> ColumnName -> Bool
$c/= :: ColumnName -> ColumnName -> Bool
/= :: ColumnName -> ColumnName -> Bool
Eq, Eq ColumnName
Eq ColumnName
-> (ColumnName -> ColumnName -> Ordering)
-> (ColumnName -> ColumnName -> Bool)
-> (ColumnName -> ColumnName -> Bool)
-> (ColumnName -> ColumnName -> Bool)
-> (ColumnName -> ColumnName -> Bool)
-> (ColumnName -> ColumnName -> ColumnName)
-> (ColumnName -> ColumnName -> ColumnName)
-> Ord ColumnName
ColumnName -> ColumnName -> Bool
ColumnName -> ColumnName -> Ordering
ColumnName -> ColumnName -> ColumnName
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 :: ColumnName -> ColumnName -> Ordering
compare :: ColumnName -> ColumnName -> Ordering
$c< :: ColumnName -> ColumnName -> Bool
< :: ColumnName -> ColumnName -> Bool
$c<= :: ColumnName -> ColumnName -> Bool
<= :: ColumnName -> ColumnName -> Bool
$c> :: ColumnName -> ColumnName -> Bool
> :: ColumnName -> ColumnName -> Bool
$c>= :: ColumnName -> ColumnName -> Bool
>= :: ColumnName -> ColumnName -> Bool
$cmax :: ColumnName -> ColumnName -> ColumnName
max :: ColumnName -> ColumnName -> ColumnName
$cmin :: ColumnName -> ColumnName -> ColumnName
min :: ColumnName -> ColumnName -> ColumnName
Ord, Int -> ColumnName -> ShowS
[ColumnName] -> ShowS
ColumnName -> String
(Int -> ColumnName -> ShowS)
-> (ColumnName -> String)
-> ([ColumnName] -> ShowS)
-> Show ColumnName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ColumnName -> ShowS
showsPrec :: Int -> ColumnName -> ShowS
$cshow :: ColumnName -> String
show :: ColumnName -> String
$cshowList :: [ColumnName] -> ShowS
showList :: [ColumnName] -> ShowS
Show, (forall x. ColumnName -> Rep ColumnName x)
-> (forall x. Rep ColumnName x -> ColumnName) -> Generic ColumnName
forall x. Rep ColumnName x -> ColumnName
forall x. ColumnName -> Rep ColumnName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ColumnName -> Rep ColumnName x
from :: forall x. ColumnName -> Rep ColumnName x
$cto :: forall x. Rep ColumnName x -> ColumnName
to :: forall x. Rep ColumnName x -> ColumnName
Generic, Typeable ColumnName
Typeable ColumnName
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ColumnName -> c ColumnName)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ColumnName)
-> (ColumnName -> Constr)
-> (ColumnName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ColumnName))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ColumnName))
-> ((forall b. Data b => b -> b) -> ColumnName -> ColumnName)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ColumnName -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ColumnName -> r)
-> (forall u. (forall d. Data d => d -> u) -> ColumnName -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ColumnName -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ColumnName -> m ColumnName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ColumnName -> m ColumnName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ColumnName -> m ColumnName)
-> Data ColumnName
ColumnName -> Constr
ColumnName -> DataType
(forall b. Data b => b -> b) -> ColumnName -> ColumnName
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ColumnName -> u
forall u. (forall d. Data d => d -> u) -> ColumnName -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ColumnName -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ColumnName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ColumnName -> m ColumnName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ColumnName -> m ColumnName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColumnName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColumnName -> c ColumnName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ColumnName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ColumnName)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColumnName -> c ColumnName
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColumnName -> c ColumnName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColumnName
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColumnName
$ctoConstr :: ColumnName -> Constr
toConstr :: ColumnName -> Constr
$cdataTypeOf :: ColumnName -> DataType
dataTypeOf :: ColumnName -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ColumnName)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ColumnName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ColumnName)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ColumnName)
$cgmapT :: (forall b. Data b => b -> b) -> ColumnName -> ColumnName
gmapT :: (forall b. Data b => b -> b) -> ColumnName -> ColumnName
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ColumnName -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ColumnName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ColumnName -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ColumnName -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ColumnName -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ColumnName -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ColumnName -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ColumnName -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ColumnName -> m ColumnName
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ColumnName -> m ColumnName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ColumnName -> m ColumnName
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ColumnName -> m ColumnName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ColumnName -> m ColumnName
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ColumnName -> m ColumnName
Data, (forall (m :: * -> *). Quote m => ColumnName -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    ColumnName -> Code m ColumnName)
-> Lift ColumnName
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => ColumnName -> m Exp
forall (m :: * -> *). Quote m => ColumnName -> Code m ColumnName
$clift :: forall (m :: * -> *). Quote m => ColumnName -> m Exp
lift :: forall (m :: * -> *). Quote m => ColumnName -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => ColumnName -> Code m ColumnName
liftTyped :: forall (m :: * -> *). Quote m => ColumnName -> Code m ColumnName
Lift)
  deriving newtype (Value -> Parser [ColumnName]
Value -> Parser ColumnName
(Value -> Parser ColumnName)
-> (Value -> Parser [ColumnName]) -> FromJSON ColumnName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ColumnName
parseJSON :: Value -> Parser ColumnName
$cparseJSONList :: Value -> Parser [ColumnName]
parseJSONList :: Value -> Parser [ColumnName]
FromJSON, [ColumnName] -> Value
[ColumnName] -> Encoding
ColumnName -> Value
ColumnName -> Encoding
(ColumnName -> Value)
-> (ColumnName -> Encoding)
-> ([ColumnName] -> Value)
-> ([ColumnName] -> Encoding)
-> ToJSON ColumnName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ColumnName -> Value
toJSON :: ColumnName -> Value
$ctoEncoding :: ColumnName -> Encoding
toEncoding :: ColumnName -> Encoding
$ctoJSONList :: [ColumnName] -> Value
toJSONList :: [ColumnName] -> Value
$ctoEncodingList :: [ColumnName] -> Encoding
toEncodingList :: [ColumnName] -> Encoding
ToJSON, ToJSONKeyFunction [ColumnName]
ToJSONKeyFunction ColumnName
ToJSONKeyFunction ColumnName
-> ToJSONKeyFunction [ColumnName] -> ToJSONKey ColumnName
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction ColumnName
toJSONKey :: ToJSONKeyFunction ColumnName
$ctoJSONKeyList :: ToJSONKeyFunction [ColumnName]
toJSONKeyList :: ToJSONKeyFunction [ColumnName]
ToJSONKey, FromJSONKeyFunction [ColumnName]
FromJSONKeyFunction ColumnName
FromJSONKeyFunction ColumnName
-> FromJSONKeyFunction [ColumnName] -> FromJSONKey ColumnName
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
$cfromJSONKey :: FromJSONKeyFunction ColumnName
fromJSONKey :: FromJSONKeyFunction ColumnName
$cfromJSONKeyList :: FromJSONKeyFunction [ColumnName]
fromJSONKeyList :: FromJSONKeyFunction [ColumnName]
FromJSONKey, Eq ColumnName
Eq ColumnName
-> (Int -> ColumnName -> Int)
-> (ColumnName -> Int)
-> Hashable ColumnName
Int -> ColumnName -> Int
ColumnName -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> ColumnName -> Int
hashWithSalt :: Int -> ColumnName -> Int
$chash :: ColumnName -> Int
hash :: ColumnName -> Int
Hashable, ColumnName -> ()
(ColumnName -> ()) -> NFData ColumnName
forall a. (a -> ()) -> NFData a
$crnf :: ColumnName -> ()
rnf :: ColumnName -> ()
NFData, ColumnName -> Text
(ColumnName -> Text) -> ToTxt ColumnName
forall a. (a -> Text) -> ToTxt a
$ctoTxt :: ColumnName -> Text
toTxt :: ColumnName -> Text
ToTxt)

instance HasCodec ColumnName where
  codec :: JSONCodec ColumnName
codec = (Text -> ColumnName)
-> (ColumnName -> Text)
-> Codec Value Text Text
-> JSONCodec ColumnName
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Text -> ColumnName
ColumnName ColumnName -> Text
columnName Codec Value Text Text
forall value. HasCodec value => JSONCodec value
codec

instance ToErrorValue ColumnName where
  toErrorValue :: ColumnName -> ErrorMessage
toErrorValue = Text -> ErrorMessage
ErrorValue.squote (Text -> ErrorMessage)
-> (ColumnName -> Text) -> ColumnName -> ErrorMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnName -> Text
columnName

data Comment = DueToPermission | RequestedSingleObject
  deriving stock (Comment -> Comment -> Bool
(Comment -> Comment -> Bool)
-> (Comment -> Comment -> Bool) -> Eq Comment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Comment -> Comment -> Bool
== :: Comment -> Comment -> Bool
$c/= :: Comment -> Comment -> Bool
/= :: Comment -> Comment -> Bool
Eq, Eq Comment
Eq Comment
-> (Comment -> Comment -> Ordering)
-> (Comment -> Comment -> Bool)
-> (Comment -> Comment -> Bool)
-> (Comment -> Comment -> Bool)
-> (Comment -> Comment -> Bool)
-> (Comment -> Comment -> Comment)
-> (Comment -> Comment -> Comment)
-> Ord Comment
Comment -> Comment -> Bool
Comment -> Comment -> Ordering
Comment -> Comment -> Comment
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 :: Comment -> Comment -> Ordering
compare :: Comment -> Comment -> Ordering
$c< :: Comment -> Comment -> Bool
< :: Comment -> Comment -> Bool
$c<= :: Comment -> Comment -> Bool
<= :: Comment -> Comment -> Bool
$c> :: Comment -> Comment -> Bool
> :: Comment -> Comment -> Bool
$c>= :: Comment -> Comment -> Bool
>= :: Comment -> Comment -> Bool
$cmax :: Comment -> Comment -> Comment
max :: Comment -> Comment -> Comment
$cmin :: Comment -> Comment -> Comment
min :: Comment -> Comment -> Comment
Ord, Int -> Comment -> ShowS
[Comment] -> ShowS
Comment -> String
(Int -> Comment -> ShowS)
-> (Comment -> String) -> ([Comment] -> ShowS) -> Show Comment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Comment -> ShowS
showsPrec :: Int -> Comment -> ShowS
$cshow :: Comment -> String
show :: Comment -> String
$cshowList :: [Comment] -> ShowS
showList :: [Comment] -> ShowS
Show, (forall x. Comment -> Rep Comment x)
-> (forall x. Rep Comment x -> Comment) -> Generic Comment
forall x. Rep Comment x -> Comment
forall x. Comment -> Rep Comment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Comment -> Rep Comment x
from :: forall x. Comment -> Rep Comment x
$cto :: forall x. Rep Comment x -> Comment
to :: forall x. Rep Comment x -> Comment
Generic, Typeable Comment
Typeable Comment
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Comment -> c Comment)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Comment)
-> (Comment -> Constr)
-> (Comment -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Comment))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Comment))
-> ((forall b. Data b => b -> b) -> Comment -> Comment)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Comment -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Comment -> r)
-> (forall u. (forall d. Data d => d -> u) -> Comment -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Comment -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Comment -> m Comment)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Comment -> m Comment)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Comment -> m Comment)
-> Data Comment
Comment -> Constr
Comment -> DataType
(forall b. Data b => b -> b) -> Comment -> Comment
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Comment -> u
forall u. (forall d. Data d => d -> u) -> Comment -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Comment -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Comment -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Comment -> m Comment
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Comment -> m Comment
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Comment
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Comment -> c Comment
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Comment)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Comment)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Comment -> c Comment
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Comment -> c Comment
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Comment
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Comment
$ctoConstr :: Comment -> Constr
toConstr :: Comment -> Constr
$cdataTypeOf :: Comment -> DataType
dataTypeOf :: Comment -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Comment)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Comment)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Comment)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Comment)
$cgmapT :: (forall b. Data b => b -> b) -> Comment -> Comment
gmapT :: (forall b. Data b => b -> b) -> Comment -> Comment
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Comment -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Comment -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Comment -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Comment -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Comment -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Comment -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Comment -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Comment -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Comment -> m Comment
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Comment -> m Comment
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Comment -> m Comment
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Comment -> m Comment
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Comment -> m Comment
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Comment -> m Comment
Data, (forall (m :: * -> *). Quote m => Comment -> m Exp)
-> (forall (m :: * -> *). Quote m => Comment -> Code m Comment)
-> Lift Comment
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Comment -> m Exp
forall (m :: * -> *). Quote m => Comment -> Code m Comment
$clift :: forall (m :: * -> *). Quote m => Comment -> m Exp
lift :: forall (m :: * -> *). Quote m => Comment -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Comment -> Code m Comment
liftTyped :: forall (m :: * -> *). Quote m => Comment -> Code m Comment
Lift)
  deriving anyclass (Value -> Parser [Comment]
Value -> Parser Comment
(Value -> Parser Comment)
-> (Value -> Parser [Comment]) -> FromJSON Comment
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Comment
parseJSON :: Value -> Parser Comment
$cparseJSONList :: Value -> Parser [Comment]
parseJSONList :: Value -> Parser [Comment]
FromJSON, Eq Comment
Eq Comment
-> (Int -> Comment -> Int) -> (Comment -> Int) -> Hashable Comment
Int -> Comment -> Int
Comment -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Comment -> Int
hashWithSalt :: Int -> Comment -> Int
$chash :: Comment -> Int
hash :: Comment -> Int
Hashable, Comment -> ()
(Comment -> ()) -> NFData Comment
forall a. (a -> ()) -> NFData a
$crnf :: Comment -> ()
rnf :: Comment -> ()
NFData, [Comment] -> Value
[Comment] -> Encoding
Comment -> Value
Comment -> Encoding
(Comment -> Value)
-> (Comment -> Encoding)
-> ([Comment] -> Value)
-> ([Comment] -> Encoding)
-> ToJSON Comment
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Comment -> Value
toJSON :: Comment -> Value
$ctoEncoding :: Comment -> Encoding
toEncoding :: Comment -> Encoding
$ctoJSONList :: [Comment] -> Value
toJSONList :: [Comment] -> Value
$ctoEncodingList :: [Comment] -> Encoding
toEncodingList :: [Comment] -> Encoding
ToJSON)

newtype EntityAlias = EntityAlias
  { EntityAlias -> Text
entityAliasText :: Text
  }
  deriving stock (EntityAlias -> EntityAlias -> Bool
(EntityAlias -> EntityAlias -> Bool)
-> (EntityAlias -> EntityAlias -> Bool) -> Eq EntityAlias
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EntityAlias -> EntityAlias -> Bool
== :: EntityAlias -> EntityAlias -> Bool
$c/= :: EntityAlias -> EntityAlias -> Bool
/= :: EntityAlias -> EntityAlias -> Bool
Eq, Eq EntityAlias
Eq EntityAlias
-> (EntityAlias -> EntityAlias -> Ordering)
-> (EntityAlias -> EntityAlias -> Bool)
-> (EntityAlias -> EntityAlias -> Bool)
-> (EntityAlias -> EntityAlias -> Bool)
-> (EntityAlias -> EntityAlias -> Bool)
-> (EntityAlias -> EntityAlias -> EntityAlias)
-> (EntityAlias -> EntityAlias -> EntityAlias)
-> Ord EntityAlias
EntityAlias -> EntityAlias -> Bool
EntityAlias -> EntityAlias -> Ordering
EntityAlias -> EntityAlias -> EntityAlias
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 :: EntityAlias -> EntityAlias -> Ordering
compare :: EntityAlias -> EntityAlias -> Ordering
$c< :: EntityAlias -> EntityAlias -> Bool
< :: EntityAlias -> EntityAlias -> Bool
$c<= :: EntityAlias -> EntityAlias -> Bool
<= :: EntityAlias -> EntityAlias -> Bool
$c> :: EntityAlias -> EntityAlias -> Bool
> :: EntityAlias -> EntityAlias -> Bool
$c>= :: EntityAlias -> EntityAlias -> Bool
>= :: EntityAlias -> EntityAlias -> Bool
$cmax :: EntityAlias -> EntityAlias -> EntityAlias
max :: EntityAlias -> EntityAlias -> EntityAlias
$cmin :: EntityAlias -> EntityAlias -> EntityAlias
min :: EntityAlias -> EntityAlias -> EntityAlias
Ord, Int -> EntityAlias -> ShowS
[EntityAlias] -> ShowS
EntityAlias -> String
(Int -> EntityAlias -> ShowS)
-> (EntityAlias -> String)
-> ([EntityAlias] -> ShowS)
-> Show EntityAlias
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EntityAlias -> ShowS
showsPrec :: Int -> EntityAlias -> ShowS
$cshow :: EntityAlias -> String
show :: EntityAlias -> String
$cshowList :: [EntityAlias] -> ShowS
showList :: [EntityAlias] -> ShowS
Show, (forall x. EntityAlias -> Rep EntityAlias x)
-> (forall x. Rep EntityAlias x -> EntityAlias)
-> Generic EntityAlias
forall x. Rep EntityAlias x -> EntityAlias
forall x. EntityAlias -> Rep EntityAlias x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EntityAlias -> Rep EntityAlias x
from :: forall x. EntityAlias -> Rep EntityAlias x
$cto :: forall x. Rep EntityAlias x -> EntityAlias
to :: forall x. Rep EntityAlias x -> EntityAlias
Generic, Typeable EntityAlias
Typeable EntityAlias
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> EntityAlias -> c EntityAlias)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c EntityAlias)
-> (EntityAlias -> Constr)
-> (EntityAlias -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c EntityAlias))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c EntityAlias))
-> ((forall b. Data b => b -> b) -> EntityAlias -> EntityAlias)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> EntityAlias -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> EntityAlias -> r)
-> (forall u. (forall d. Data d => d -> u) -> EntityAlias -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> EntityAlias -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> EntityAlias -> m EntityAlias)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> EntityAlias -> m EntityAlias)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> EntityAlias -> m EntityAlias)
-> Data EntityAlias
EntityAlias -> Constr
EntityAlias -> DataType
(forall b. Data b => b -> b) -> EntityAlias -> EntityAlias
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> EntityAlias -> u
forall u. (forall d. Data d => d -> u) -> EntityAlias -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EntityAlias -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EntityAlias -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EntityAlias -> m EntityAlias
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EntityAlias -> m EntityAlias
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EntityAlias
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EntityAlias -> c EntityAlias
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EntityAlias)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EntityAlias)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EntityAlias -> c EntityAlias
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EntityAlias -> c EntityAlias
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EntityAlias
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EntityAlias
$ctoConstr :: EntityAlias -> Constr
toConstr :: EntityAlias -> Constr
$cdataTypeOf :: EntityAlias -> DataType
dataTypeOf :: EntityAlias -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EntityAlias)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EntityAlias)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EntityAlias)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EntityAlias)
$cgmapT :: (forall b. Data b => b -> b) -> EntityAlias -> EntityAlias
gmapT :: (forall b. Data b => b -> b) -> EntityAlias -> EntityAlias
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EntityAlias -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EntityAlias -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EntityAlias -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EntityAlias -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> EntityAlias -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> EntityAlias -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> EntityAlias -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> EntityAlias -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EntityAlias -> m EntityAlias
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EntityAlias -> m EntityAlias
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EntityAlias -> m EntityAlias
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EntityAlias -> m EntityAlias
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EntityAlias -> m EntityAlias
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EntityAlias -> m EntityAlias
Data, (forall (m :: * -> *). Quote m => EntityAlias -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    EntityAlias -> Code m EntityAlias)
-> Lift EntityAlias
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => EntityAlias -> m Exp
forall (m :: * -> *). Quote m => EntityAlias -> Code m EntityAlias
$clift :: forall (m :: * -> *). Quote m => EntityAlias -> m Exp
lift :: forall (m :: * -> *). Quote m => EntityAlias -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => EntityAlias -> Code m EntityAlias
liftTyped :: forall (m :: * -> *). Quote m => EntityAlias -> Code m EntityAlias
Lift)
  deriving newtype (Value -> Parser [EntityAlias]
Value -> Parser EntityAlias
(Value -> Parser EntityAlias)
-> (Value -> Parser [EntityAlias]) -> FromJSON EntityAlias
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser EntityAlias
parseJSON :: Value -> Parser EntityAlias
$cparseJSONList :: Value -> Parser [EntityAlias]
parseJSONList :: Value -> Parser [EntityAlias]
FromJSON, Eq EntityAlias
Eq EntityAlias
-> (Int -> EntityAlias -> Int)
-> (EntityAlias -> Int)
-> Hashable EntityAlias
Int -> EntityAlias -> Int
EntityAlias -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> EntityAlias -> Int
hashWithSalt :: Int -> EntityAlias -> Int
$chash :: EntityAlias -> Int
hash :: EntityAlias -> Int
Hashable, EntityAlias -> ()
(EntityAlias -> ()) -> NFData EntityAlias
forall a. (a -> ()) -> NFData a
$crnf :: EntityAlias -> ()
rnf :: EntityAlias -> ()
NFData, [EntityAlias] -> Value
[EntityAlias] -> Encoding
EntityAlias -> Value
EntityAlias -> Encoding
(EntityAlias -> Value)
-> (EntityAlias -> Encoding)
-> ([EntityAlias] -> Value)
-> ([EntityAlias] -> Encoding)
-> ToJSON EntityAlias
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: EntityAlias -> Value
toJSON :: EntityAlias -> Value
$ctoEncoding :: EntityAlias -> Encoding
toEncoding :: EntityAlias -> Encoding
$ctoJSONList :: [EntityAlias] -> Value
toJSONList :: [EntityAlias] -> Value
$ctoEncodingList :: [EntityAlias] -> Encoding
toEncodingList :: [EntityAlias] -> Encoding
ToJSON)

columnToFieldName :: EntityAlias -> ColumnName -> FieldName
columnToFieldName :: EntityAlias -> ColumnName -> FieldName
columnToFieldName EntityAlias {Text
$sel:entityAliasText:EntityAlias :: EntityAlias -> Text
entityAliasText :: Text
..} ColumnName {Text
$sel:columnName:ColumnName :: ColumnName -> Text
columnName :: Text
..} =
  Text -> Text -> FieldName
FieldName Text
columnName Text
entityAliasText

data Op
  = LessOp
  | LessOrEqualOp
  | MoreOp
  | MoreOrEqualOp
  | InOp
  | NotInOp
  | LikeOp
  | NotLikeOp
  --  | SNE
  --  | SILIKE
  --  | SNILIKE
  --  | SSIMILAR
  --  | SNSIMILAR
  --  | SGTE
  --  | SLTE
  --  | SContains
  --  | SContainedIn
  --  | SHasKey
  --  | SHasKeysAny
  --  | SHasKeysAll
  deriving stock (Op -> Op -> Bool
(Op -> Op -> Bool) -> (Op -> Op -> Bool) -> Eq Op
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Op -> Op -> Bool
== :: Op -> Op -> Bool
$c/= :: Op -> Op -> Bool
/= :: Op -> Op -> Bool
Eq, Eq Op
Eq Op
-> (Op -> Op -> Ordering)
-> (Op -> Op -> Bool)
-> (Op -> Op -> Bool)
-> (Op -> Op -> Bool)
-> (Op -> Op -> Bool)
-> (Op -> Op -> Op)
-> (Op -> Op -> Op)
-> Ord Op
Op -> Op -> Bool
Op -> Op -> Ordering
Op -> Op -> Op
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 :: Op -> Op -> Ordering
compare :: Op -> Op -> Ordering
$c< :: Op -> Op -> Bool
< :: Op -> Op -> Bool
$c<= :: Op -> Op -> Bool
<= :: Op -> Op -> Bool
$c> :: Op -> Op -> Bool
> :: Op -> Op -> Bool
$c>= :: Op -> Op -> Bool
>= :: Op -> Op -> Bool
$cmax :: Op -> Op -> Op
max :: Op -> Op -> Op
$cmin :: Op -> Op -> Op
min :: Op -> Op -> Op
Ord, Int -> Op -> ShowS
[Op] -> ShowS
Op -> String
(Int -> Op -> ShowS)
-> (Op -> String) -> ([Op] -> ShowS) -> Show Op
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Op -> ShowS
showsPrec :: Int -> Op -> ShowS
$cshow :: Op -> String
show :: Op -> String
$cshowList :: [Op] -> ShowS
showList :: [Op] -> ShowS
Show, (forall x. Op -> Rep Op x)
-> (forall x. Rep Op x -> Op) -> Generic Op
forall x. Rep Op x -> Op
forall x. Op -> Rep Op x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Op -> Rep Op x
from :: forall x. Op -> Rep Op x
$cto :: forall x. Rep Op x -> Op
to :: forall x. Rep Op x -> Op
Generic, Typeable Op
Typeable Op
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Op -> c Op)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Op)
-> (Op -> Constr)
-> (Op -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Op))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Op))
-> ((forall b. Data b => b -> b) -> Op -> Op)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Op -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Op -> r)
-> (forall u. (forall d. Data d => d -> u) -> Op -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Op -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Op -> m Op)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Op -> m Op)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Op -> m Op)
-> Data Op
Op -> Constr
Op -> DataType
(forall b. Data b => b -> b) -> Op -> Op
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Op -> u
forall u. (forall d. Data d => d -> u) -> Op -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Op -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Op -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Op -> m Op
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Op -> m Op
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Op
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Op -> c Op
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Op)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Op)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Op -> c Op
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Op -> c Op
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Op
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Op
$ctoConstr :: Op -> Constr
toConstr :: Op -> Constr
$cdataTypeOf :: Op -> DataType
dataTypeOf :: Op -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Op)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Op)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Op)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Op)
$cgmapT :: (forall b. Data b => b -> b) -> Op -> Op
gmapT :: (forall b. Data b => b -> b) -> Op -> Op
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Op -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Op -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Op -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Op -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Op -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Op -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Op -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Op -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Op -> m Op
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Op -> m Op
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Op -> m Op
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Op -> m Op
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Op -> m Op
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Op -> m Op
Data, (forall (m :: * -> *). Quote m => Op -> m Exp)
-> (forall (m :: * -> *). Quote m => Op -> Code m Op) -> Lift Op
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Op -> m Exp
forall (m :: * -> *). Quote m => Op -> Code m Op
$clift :: forall (m :: * -> *). Quote m => Op -> m Exp
lift :: forall (m :: * -> *). Quote m => Op -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Op -> Code m Op
liftTyped :: forall (m :: * -> *). Quote m => Op -> Code m Op
Lift)
  deriving anyclass (Value -> Parser [Op]
Value -> Parser Op
(Value -> Parser Op) -> (Value -> Parser [Op]) -> FromJSON Op
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Op
parseJSON :: Value -> Parser Op
$cparseJSONList :: Value -> Parser [Op]
parseJSONList :: Value -> Parser [Op]
FromJSON, Eq Op
Eq Op -> (Int -> Op -> Int) -> (Op -> Int) -> Hashable Op
Int -> Op -> Int
Op -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Op -> Int
hashWithSalt :: Int -> Op -> Int
$chash :: Op -> Int
hash :: Op -> Int
Hashable, Op -> ()
(Op -> ()) -> NFData Op
forall a. (a -> ()) -> NFData a
$crnf :: Op -> ()
rnf :: Op -> ()
NFData, [Op] -> Value
[Op] -> Encoding
Op -> Value
Op -> Encoding
(Op -> Value)
-> (Op -> Encoding)
-> ([Op] -> Value)
-> ([Op] -> Encoding)
-> ToJSON Op
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Op -> Value
toJSON :: Op -> Value
$ctoEncoding :: Op -> Encoding
toEncoding :: Op -> Encoding
$ctoJSONList :: [Op] -> Value
toJSONList :: [Op] -> Value
$ctoEncodingList :: [Op] -> Encoding
toEncodingList :: [Op] -> Encoding
ToJSON)

-- | Source for this represenation type:
--
-- https://developers.google.com/protocol-buffers/docs/reference/google.protobuf#google.protobuf.Value
--
-- BigQuery results come in via the REST API as one of these simply types.
--
-- TODO: This omits StructValue -- do we need it?
data Value
  = NullValue
  | -- | 64-bit <https://cloud.google.com/bigquery/docs/reference/standard-sql/data-types#integer_type>
    IntegerValue Int64
  | -- | Fixed precision <https://cloud.google.com/bigquery/docs/reference/standard-sql/data-types#decimal_types>
    DecimalValue Decimal
  | -- | Fixed precision <https://cloud.google.com/bigquery/docs/reference/standard-sql/data-types#decimal_types>
    BigDecimalValue BigDecimal
  | -- | Floating point <https://cloud.google.com/bigquery/docs/reference/standard-sql/data-types#floating_point_types>
    FloatValue Float64
  | GeographyValue Geography
  | StringValue Text
  | BytesValue Base64
  | BoolValue Bool
  | ArrayValue (Vector Value)
  | TimestampValue Timestamp
  | DateValue Date
  | TimeValue Time
  | JsonValue J.Value
  | DatetimeValue Datetime
  deriving stock (Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
(Int -> Value -> ShowS)
-> (Value -> String) -> ([Value] -> ShowS) -> Show Value
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Value -> ShowS
showsPrec :: Int -> Value -> ShowS
$cshow :: Value -> String
show :: Value -> String
$cshowList :: [Value] -> ShowS
showList :: [Value] -> ShowS
Show, Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
/= :: Value -> Value -> Bool
Eq, Eq Value
Eq Value
-> (Value -> Value -> Ordering)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Value)
-> (Value -> Value -> Value)
-> Ord Value
Value -> Value -> Bool
Value -> Value -> Ordering
Value -> Value -> Value
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 :: Value -> Value -> Ordering
compare :: Value -> Value -> Ordering
$c< :: Value -> Value -> Bool
< :: Value -> Value -> Bool
$c<= :: Value -> Value -> Bool
<= :: Value -> Value -> Bool
$c> :: Value -> Value -> Bool
> :: Value -> Value -> Bool
$c>= :: Value -> Value -> Bool
>= :: Value -> Value -> Bool
$cmax :: Value -> Value -> Value
max :: Value -> Value -> Value
$cmin :: Value -> Value -> Value
min :: Value -> Value -> Value
Ord, (forall x. Value -> Rep Value x)
-> (forall x. Rep Value x -> Value) -> Generic Value
forall x. Rep Value x -> Value
forall x. Value -> Rep Value x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Value -> Rep Value x
from :: forall x. Value -> Rep Value x
$cto :: forall x. Rep Value x -> Value
to :: forall x. Rep Value x -> Value
Generic, Typeable Value
Typeable Value
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Value -> c Value)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Value)
-> (Value -> Constr)
-> (Value -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Value))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Value))
-> ((forall b. Data b => b -> b) -> Value -> Value)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r)
-> (forall u. (forall d. Data d => d -> u) -> Value -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Value -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Value -> m Value)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Value -> m Value)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Value -> m Value)
-> Data Value
Value -> Constr
Value -> DataType
(forall b. Data b => b -> b) -> Value -> Value
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Value -> u
forall u. (forall d. Data d => d -> u) -> Value -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Value -> m Value
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Value -> m Value
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Value
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Value -> c Value
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Value)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Value)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Value -> c Value
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Value -> c Value
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Value
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Value
$ctoConstr :: Value -> Constr
toConstr :: Value -> Constr
$cdataTypeOf :: Value -> DataType
dataTypeOf :: Value -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Value)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Value)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Value)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Value)
$cgmapT :: (forall b. Data b => b -> b) -> Value -> Value
gmapT :: (forall b. Data b => b -> b) -> Value -> Value
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Value -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Value -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Value -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Value -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Value -> m Value
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Value -> m Value
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Value -> m Value
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Value -> m Value
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Value -> m Value
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Value -> m Value
Data, (forall (m :: * -> *). Quote m => Value -> m Exp)
-> (forall (m :: * -> *). Quote m => Value -> Code m Value)
-> Lift Value
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Value -> m Exp
forall (m :: * -> *). Quote m => Value -> Code m Value
$clift :: forall (m :: * -> *). Quote m => Value -> m Exp
lift :: forall (m :: * -> *). Quote m => Value -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Value -> Code m Value
liftTyped :: forall (m :: * -> *). Quote m => Value -> Code m Value
Lift)
  deriving anyclass (Value -> Parser [Value]
Value -> Parser Value
(Value -> Parser Value)
-> (Value -> Parser [Value]) -> FromJSON Value
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Value
parseJSON :: Value -> Parser Value
$cparseJSONList :: Value -> Parser [Value]
parseJSONList :: Value -> Parser [Value]
FromJSON, Eq Value
Eq Value
-> (Int -> Value -> Int) -> (Value -> Int) -> Hashable Value
Int -> Value -> Int
Value -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Value -> Int
hashWithSalt :: Int -> Value -> Int
$chash :: Value -> Int
hash :: Value -> Int
Hashable, Value -> ()
(Value -> ()) -> NFData Value
forall a. (a -> ()) -> NFData a
$crnf :: Value -> ()
rnf :: Value -> ()
NFData, [Value] -> Value
[Value] -> Encoding
Value -> Value
Value -> Encoding
(Value -> Value)
-> (Value -> Encoding)
-> ([Value] -> Value)
-> ([Value] -> Encoding)
-> ToJSON Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Value -> Value
toJSON :: Value -> Value
$ctoEncoding :: Value -> Encoding
toEncoding :: Value -> Encoding
$ctoJSONList :: [Value] -> Value
toJSONList :: [Value] -> Value
$ctoEncodingList :: [Value] -> Encoding
toEncodingList :: [Value] -> Encoding
ToJSON)

-- | BigQuery's conception of a timestamp.
newtype Timestamp = Timestamp Text
  deriving stock (Int -> Timestamp -> ShowS
[Timestamp] -> ShowS
Timestamp -> String
(Int -> Timestamp -> ShowS)
-> (Timestamp -> String)
-> ([Timestamp] -> ShowS)
-> Show Timestamp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Timestamp -> ShowS
showsPrec :: Int -> Timestamp -> ShowS
$cshow :: Timestamp -> String
show :: Timestamp -> String
$cshowList :: [Timestamp] -> ShowS
showList :: [Timestamp] -> ShowS
Show, Timestamp -> Timestamp -> Bool
(Timestamp -> Timestamp -> Bool)
-> (Timestamp -> Timestamp -> Bool) -> Eq Timestamp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Timestamp -> Timestamp -> Bool
== :: Timestamp -> Timestamp -> Bool
$c/= :: Timestamp -> Timestamp -> Bool
/= :: Timestamp -> Timestamp -> Bool
Eq, Eq Timestamp
Eq Timestamp
-> (Timestamp -> Timestamp -> Ordering)
-> (Timestamp -> Timestamp -> Bool)
-> (Timestamp -> Timestamp -> Bool)
-> (Timestamp -> Timestamp -> Bool)
-> (Timestamp -> Timestamp -> Bool)
-> (Timestamp -> Timestamp -> Timestamp)
-> (Timestamp -> Timestamp -> Timestamp)
-> Ord Timestamp
Timestamp -> Timestamp -> Bool
Timestamp -> Timestamp -> Ordering
Timestamp -> Timestamp -> Timestamp
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 :: Timestamp -> Timestamp -> Ordering
compare :: Timestamp -> Timestamp -> Ordering
$c< :: Timestamp -> Timestamp -> Bool
< :: Timestamp -> Timestamp -> Bool
$c<= :: Timestamp -> Timestamp -> Bool
<= :: Timestamp -> Timestamp -> Bool
$c> :: Timestamp -> Timestamp -> Bool
> :: Timestamp -> Timestamp -> Bool
$c>= :: Timestamp -> Timestamp -> Bool
>= :: Timestamp -> Timestamp -> Bool
$cmax :: Timestamp -> Timestamp -> Timestamp
max :: Timestamp -> Timestamp -> Timestamp
$cmin :: Timestamp -> Timestamp -> Timestamp
min :: Timestamp -> Timestamp -> Timestamp
Ord, (forall x. Timestamp -> Rep Timestamp x)
-> (forall x. Rep Timestamp x -> Timestamp) -> Generic Timestamp
forall x. Rep Timestamp x -> Timestamp
forall x. Timestamp -> Rep Timestamp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Timestamp -> Rep Timestamp x
from :: forall x. Timestamp -> Rep Timestamp x
$cto :: forall x. Rep Timestamp x -> Timestamp
to :: forall x. Rep Timestamp x -> Timestamp
Generic, Typeable Timestamp
Typeable Timestamp
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Timestamp -> c Timestamp)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Timestamp)
-> (Timestamp -> Constr)
-> (Timestamp -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Timestamp))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Timestamp))
-> ((forall b. Data b => b -> b) -> Timestamp -> Timestamp)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Timestamp -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Timestamp -> r)
-> (forall u. (forall d. Data d => d -> u) -> Timestamp -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Timestamp -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Timestamp -> m Timestamp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Timestamp -> m Timestamp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Timestamp -> m Timestamp)
-> Data Timestamp
Timestamp -> Constr
Timestamp -> DataType
(forall b. Data b => b -> b) -> Timestamp -> Timestamp
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Timestamp -> u
forall u. (forall d. Data d => d -> u) -> Timestamp -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Timestamp -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Timestamp -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Timestamp -> m Timestamp
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Timestamp -> m Timestamp
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Timestamp
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Timestamp -> c Timestamp
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Timestamp)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Timestamp)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Timestamp -> c Timestamp
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Timestamp -> c Timestamp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Timestamp
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Timestamp
$ctoConstr :: Timestamp -> Constr
toConstr :: Timestamp -> Constr
$cdataTypeOf :: Timestamp -> DataType
dataTypeOf :: Timestamp -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Timestamp)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Timestamp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Timestamp)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Timestamp)
$cgmapT :: (forall b. Data b => b -> b) -> Timestamp -> Timestamp
gmapT :: (forall b. Data b => b -> b) -> Timestamp -> Timestamp
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Timestamp -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Timestamp -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Timestamp -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Timestamp -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Timestamp -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Timestamp -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Timestamp -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Timestamp -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Timestamp -> m Timestamp
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Timestamp -> m Timestamp
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Timestamp -> m Timestamp
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Timestamp -> m Timestamp
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Timestamp -> m Timestamp
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Timestamp -> m Timestamp
Data, (forall (m :: * -> *). Quote m => Timestamp -> m Exp)
-> (forall (m :: * -> *). Quote m => Timestamp -> Code m Timestamp)
-> Lift Timestamp
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Timestamp -> m Exp
forall (m :: * -> *). Quote m => Timestamp -> Code m Timestamp
$clift :: forall (m :: * -> *). Quote m => Timestamp -> m Exp
lift :: forall (m :: * -> *). Quote m => Timestamp -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Timestamp -> Code m Timestamp
liftTyped :: forall (m :: * -> *). Quote m => Timestamp -> Code m Timestamp
Lift)
  deriving newtype ([Timestamp] -> Value
[Timestamp] -> Encoding
Timestamp -> Value
Timestamp -> Encoding
(Timestamp -> Value)
-> (Timestamp -> Encoding)
-> ([Timestamp] -> Value)
-> ([Timestamp] -> Encoding)
-> ToJSON Timestamp
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Timestamp -> Value
toJSON :: Timestamp -> Value
$ctoEncoding :: Timestamp -> Encoding
toEncoding :: Timestamp -> Encoding
$ctoJSONList :: [Timestamp] -> Value
toJSONList :: [Timestamp] -> Value
$ctoEncodingList :: [Timestamp] -> Encoding
toEncodingList :: [Timestamp] -> Encoding
ToJSON, Value -> Parser [Timestamp]
Value -> Parser Timestamp
(Value -> Parser Timestamp)
-> (Value -> Parser [Timestamp]) -> FromJSON Timestamp
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Timestamp
parseJSON :: Value -> Parser Timestamp
$cparseJSONList :: Value -> Parser [Timestamp]
parseJSONList :: Value -> Parser [Timestamp]
FromJSON, Timestamp -> ()
(Timestamp -> ()) -> NFData Timestamp
forall a. (a -> ()) -> NFData a
$crnf :: Timestamp -> ()
rnf :: Timestamp -> ()
NFData, Eq Timestamp
Eq Timestamp
-> (Int -> Timestamp -> Int)
-> (Timestamp -> Int)
-> Hashable Timestamp
Int -> Timestamp -> Int
Timestamp -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Timestamp -> Int
hashWithSalt :: Int -> Timestamp -> Int
$chash :: Timestamp -> Int
hash :: Timestamp -> Int
Hashable)

-- | BigQuery's conception of a date.
newtype Date = Date Text
  deriving stock (Int -> Date -> ShowS
[Date] -> ShowS
Date -> String
(Int -> Date -> ShowS)
-> (Date -> String) -> ([Date] -> ShowS) -> Show Date
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Date -> ShowS
showsPrec :: Int -> Date -> ShowS
$cshow :: Date -> String
show :: Date -> String
$cshowList :: [Date] -> ShowS
showList :: [Date] -> ShowS
Show, Date -> Date -> Bool
(Date -> Date -> Bool) -> (Date -> Date -> Bool) -> Eq Date
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Date -> Date -> Bool
== :: Date -> Date -> Bool
$c/= :: Date -> Date -> Bool
/= :: Date -> Date -> Bool
Eq, Eq Date
Eq Date
-> (Date -> Date -> Ordering)
-> (Date -> Date -> Bool)
-> (Date -> Date -> Bool)
-> (Date -> Date -> Bool)
-> (Date -> Date -> Bool)
-> (Date -> Date -> Date)
-> (Date -> Date -> Date)
-> Ord Date
Date -> Date -> Bool
Date -> Date -> Ordering
Date -> Date -> Date
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 :: Date -> Date -> Ordering
compare :: Date -> Date -> Ordering
$c< :: Date -> Date -> Bool
< :: Date -> Date -> Bool
$c<= :: Date -> Date -> Bool
<= :: Date -> Date -> Bool
$c> :: Date -> Date -> Bool
> :: Date -> Date -> Bool
$c>= :: Date -> Date -> Bool
>= :: Date -> Date -> Bool
$cmax :: Date -> Date -> Date
max :: Date -> Date -> Date
$cmin :: Date -> Date -> Date
min :: Date -> Date -> Date
Ord, (forall x. Date -> Rep Date x)
-> (forall x. Rep Date x -> Date) -> Generic Date
forall x. Rep Date x -> Date
forall x. Date -> Rep Date x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Date -> Rep Date x
from :: forall x. Date -> Rep Date x
$cto :: forall x. Rep Date x -> Date
to :: forall x. Rep Date x -> Date
Generic, Typeable Date
Typeable Date
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Date -> c Date)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Date)
-> (Date -> Constr)
-> (Date -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Date))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Date))
-> ((forall b. Data b => b -> b) -> Date -> Date)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Date -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Date -> r)
-> (forall u. (forall d. Data d => d -> u) -> Date -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Date -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Date -> m Date)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Date -> m Date)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Date -> m Date)
-> Data Date
Date -> Constr
Date -> DataType
(forall b. Data b => b -> b) -> Date -> Date
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Date -> u
forall u. (forall d. Data d => d -> u) -> Date -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Date -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Date -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Date -> m Date
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Date -> m Date
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Date
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Date -> c Date
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Date)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Date)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Date -> c Date
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Date -> c Date
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Date
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Date
$ctoConstr :: Date -> Constr
toConstr :: Date -> Constr
$cdataTypeOf :: Date -> DataType
dataTypeOf :: Date -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Date)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Date)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Date)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Date)
$cgmapT :: (forall b. Data b => b -> b) -> Date -> Date
gmapT :: (forall b. Data b => b -> b) -> Date -> Date
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Date -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Date -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Date -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Date -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Date -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Date -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Date -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Date -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Date -> m Date
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Date -> m Date
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Date -> m Date
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Date -> m Date
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Date -> m Date
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Date -> m Date
Data, (forall (m :: * -> *). Quote m => Date -> m Exp)
-> (forall (m :: * -> *). Quote m => Date -> Code m Date)
-> Lift Date
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Date -> m Exp
forall (m :: * -> *). Quote m => Date -> Code m Date
$clift :: forall (m :: * -> *). Quote m => Date -> m Exp
lift :: forall (m :: * -> *). Quote m => Date -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Date -> Code m Date
liftTyped :: forall (m :: * -> *). Quote m => Date -> Code m Date
Lift)
  deriving newtype ([Date] -> Value
[Date] -> Encoding
Date -> Value
Date -> Encoding
(Date -> Value)
-> (Date -> Encoding)
-> ([Date] -> Value)
-> ([Date] -> Encoding)
-> ToJSON Date
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Date -> Value
toJSON :: Date -> Value
$ctoEncoding :: Date -> Encoding
toEncoding :: Date -> Encoding
$ctoJSONList :: [Date] -> Value
toJSONList :: [Date] -> Value
$ctoEncodingList :: [Date] -> Encoding
toEncodingList :: [Date] -> Encoding
ToJSON, Value -> Parser [Date]
Value -> Parser Date
(Value -> Parser Date) -> (Value -> Parser [Date]) -> FromJSON Date
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Date
parseJSON :: Value -> Parser Date
$cparseJSONList :: Value -> Parser [Date]
parseJSONList :: Value -> Parser [Date]
FromJSON, Date -> ()
(Date -> ()) -> NFData Date
forall a. (a -> ()) -> NFData a
$crnf :: Date -> ()
rnf :: Date -> ()
NFData, Eq Date
Eq Date -> (Int -> Date -> Int) -> (Date -> Int) -> Hashable Date
Int -> Date -> Int
Date -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Date -> Int
hashWithSalt :: Int -> Date -> Int
$chash :: Date -> Int
hash :: Date -> Int
Hashable)

-- | BigQuery's conception of a time.
newtype Time = Time Text
  deriving stock (Int -> Time -> ShowS
[Time] -> ShowS
Time -> String
(Int -> Time -> ShowS)
-> (Time -> String) -> ([Time] -> ShowS) -> Show Time
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Time -> ShowS
showsPrec :: Int -> Time -> ShowS
$cshow :: Time -> String
show :: Time -> String
$cshowList :: [Time] -> ShowS
showList :: [Time] -> ShowS
Show, Time -> Time -> Bool
(Time -> Time -> Bool) -> (Time -> Time -> Bool) -> Eq Time
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Time -> Time -> Bool
== :: Time -> Time -> Bool
$c/= :: Time -> Time -> Bool
/= :: Time -> Time -> Bool
Eq, Eq Time
Eq Time
-> (Time -> Time -> Ordering)
-> (Time -> Time -> Bool)
-> (Time -> Time -> Bool)
-> (Time -> Time -> Bool)
-> (Time -> Time -> Bool)
-> (Time -> Time -> Time)
-> (Time -> Time -> Time)
-> Ord Time
Time -> Time -> Bool
Time -> Time -> Ordering
Time -> Time -> Time
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 :: Time -> Time -> Ordering
compare :: Time -> Time -> Ordering
$c< :: Time -> Time -> Bool
< :: Time -> Time -> Bool
$c<= :: Time -> Time -> Bool
<= :: Time -> Time -> Bool
$c> :: Time -> Time -> Bool
> :: Time -> Time -> Bool
$c>= :: Time -> Time -> Bool
>= :: Time -> Time -> Bool
$cmax :: Time -> Time -> Time
max :: Time -> Time -> Time
$cmin :: Time -> Time -> Time
min :: Time -> Time -> Time
Ord, (forall x. Time -> Rep Time x)
-> (forall x. Rep Time x -> Time) -> Generic Time
forall x. Rep Time x -> Time
forall x. Time -> Rep Time x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Time -> Rep Time x
from :: forall x. Time -> Rep Time x
$cto :: forall x. Rep Time x -> Time
to :: forall x. Rep Time x -> Time
Generic, Typeable Time
Typeable Time
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Time -> c Time)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Time)
-> (Time -> Constr)
-> (Time -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Time))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Time))
-> ((forall b. Data b => b -> b) -> Time -> Time)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Time -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Time -> r)
-> (forall u. (forall d. Data d => d -> u) -> Time -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Time -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Time -> m Time)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Time -> m Time)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Time -> m Time)
-> Data Time
Time -> Constr
Time -> DataType
(forall b. Data b => b -> b) -> Time -> Time
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Time -> u
forall u. (forall d. Data d => d -> u) -> Time -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Time -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Time -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Time -> m Time
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Time -> m Time
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Time
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Time -> c Time
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Time)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Time)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Time -> c Time
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Time -> c Time
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Time
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Time
$ctoConstr :: Time -> Constr
toConstr :: Time -> Constr
$cdataTypeOf :: Time -> DataType
dataTypeOf :: Time -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Time)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Time)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Time)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Time)
$cgmapT :: (forall b. Data b => b -> b) -> Time -> Time
gmapT :: (forall b. Data b => b -> b) -> Time -> Time
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Time -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Time -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Time -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Time -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Time -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Time -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Time -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Time -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Time -> m Time
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Time -> m Time
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Time -> m Time
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Time -> m Time
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Time -> m Time
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Time -> m Time
Data, (forall (m :: * -> *). Quote m => Time -> m Exp)
-> (forall (m :: * -> *). Quote m => Time -> Code m Time)
-> Lift Time
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Time -> m Exp
forall (m :: * -> *). Quote m => Time -> Code m Time
$clift :: forall (m :: * -> *). Quote m => Time -> m Exp
lift :: forall (m :: * -> *). Quote m => Time -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Time -> Code m Time
liftTyped :: forall (m :: * -> *). Quote m => Time -> Code m Time
Lift)
  deriving newtype ([Time] -> Value
[Time] -> Encoding
Time -> Value
Time -> Encoding
(Time -> Value)
-> (Time -> Encoding)
-> ([Time] -> Value)
-> ([Time] -> Encoding)
-> ToJSON Time
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Time -> Value
toJSON :: Time -> Value
$ctoEncoding :: Time -> Encoding
toEncoding :: Time -> Encoding
$ctoJSONList :: [Time] -> Value
toJSONList :: [Time] -> Value
$ctoEncodingList :: [Time] -> Encoding
toEncodingList :: [Time] -> Encoding
ToJSON, Value -> Parser [Time]
Value -> Parser Time
(Value -> Parser Time) -> (Value -> Parser [Time]) -> FromJSON Time
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Time
parseJSON :: Value -> Parser Time
$cparseJSONList :: Value -> Parser [Time]
parseJSONList :: Value -> Parser [Time]
FromJSON, Time -> ()
(Time -> ()) -> NFData Time
forall a. (a -> ()) -> NFData a
$crnf :: Time -> ()
rnf :: Time -> ()
NFData, Eq Time
Eq Time -> (Int -> Time -> Int) -> (Time -> Int) -> Hashable Time
Int -> Time -> Int
Time -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Time -> Int
hashWithSalt :: Int -> Time -> Int
$chash :: Time -> Int
hash :: Time -> Int
Hashable)

-- | BigQuery's conception of a datetime.
newtype Datetime = Datetime Text
  deriving stock (Int -> Datetime -> ShowS
[Datetime] -> ShowS
Datetime -> String
(Int -> Datetime -> ShowS)
-> (Datetime -> String) -> ([Datetime] -> ShowS) -> Show Datetime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Datetime -> ShowS
showsPrec :: Int -> Datetime -> ShowS
$cshow :: Datetime -> String
show :: Datetime -> String
$cshowList :: [Datetime] -> ShowS
showList :: [Datetime] -> ShowS
Show, Datetime -> Datetime -> Bool
(Datetime -> Datetime -> Bool)
-> (Datetime -> Datetime -> Bool) -> Eq Datetime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Datetime -> Datetime -> Bool
== :: Datetime -> Datetime -> Bool
$c/= :: Datetime -> Datetime -> Bool
/= :: Datetime -> Datetime -> Bool
Eq, Eq Datetime
Eq Datetime
-> (Datetime -> Datetime -> Ordering)
-> (Datetime -> Datetime -> Bool)
-> (Datetime -> Datetime -> Bool)
-> (Datetime -> Datetime -> Bool)
-> (Datetime -> Datetime -> Bool)
-> (Datetime -> Datetime -> Datetime)
-> (Datetime -> Datetime -> Datetime)
-> Ord Datetime
Datetime -> Datetime -> Bool
Datetime -> Datetime -> Ordering
Datetime -> Datetime -> Datetime
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 :: Datetime -> Datetime -> Ordering
compare :: Datetime -> Datetime -> Ordering
$c< :: Datetime -> Datetime -> Bool
< :: Datetime -> Datetime -> Bool
$c<= :: Datetime -> Datetime -> Bool
<= :: Datetime -> Datetime -> Bool
$c> :: Datetime -> Datetime -> Bool
> :: Datetime -> Datetime -> Bool
$c>= :: Datetime -> Datetime -> Bool
>= :: Datetime -> Datetime -> Bool
$cmax :: Datetime -> Datetime -> Datetime
max :: Datetime -> Datetime -> Datetime
$cmin :: Datetime -> Datetime -> Datetime
min :: Datetime -> Datetime -> Datetime
Ord, (forall x. Datetime -> Rep Datetime x)
-> (forall x. Rep Datetime x -> Datetime) -> Generic Datetime
forall x. Rep Datetime x -> Datetime
forall x. Datetime -> Rep Datetime x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Datetime -> Rep Datetime x
from :: forall x. Datetime -> Rep Datetime x
$cto :: forall x. Rep Datetime x -> Datetime
to :: forall x. Rep Datetime x -> Datetime
Generic, Typeable Datetime
Typeable Datetime
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Datetime -> c Datetime)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Datetime)
-> (Datetime -> Constr)
-> (Datetime -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Datetime))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Datetime))
-> ((forall b. Data b => b -> b) -> Datetime -> Datetime)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Datetime -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Datetime -> r)
-> (forall u. (forall d. Data d => d -> u) -> Datetime -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Datetime -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Datetime -> m Datetime)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Datetime -> m Datetime)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Datetime -> m Datetime)
-> Data Datetime
Datetime -> Constr
Datetime -> DataType
(forall b. Data b => b -> b) -> Datetime -> Datetime
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Datetime -> u
forall u. (forall d. Data d => d -> u) -> Datetime -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Datetime -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Datetime -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Datetime -> m Datetime
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Datetime -> m Datetime
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Datetime
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Datetime -> c Datetime
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Datetime)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Datetime)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Datetime -> c Datetime
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Datetime -> c Datetime
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Datetime
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Datetime
$ctoConstr :: Datetime -> Constr
toConstr :: Datetime -> Constr
$cdataTypeOf :: Datetime -> DataType
dataTypeOf :: Datetime -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Datetime)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Datetime)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Datetime)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Datetime)
$cgmapT :: (forall b. Data b => b -> b) -> Datetime -> Datetime
gmapT :: (forall b. Data b => b -> b) -> Datetime -> Datetime
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Datetime -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Datetime -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Datetime -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Datetime -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Datetime -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Datetime -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Datetime -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Datetime -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Datetime -> m Datetime
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Datetime -> m Datetime
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Datetime -> m Datetime
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Datetime -> m Datetime
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Datetime -> m Datetime
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Datetime -> m Datetime
Data, (forall (m :: * -> *). Quote m => Datetime -> m Exp)
-> (forall (m :: * -> *). Quote m => Datetime -> Code m Datetime)
-> Lift Datetime
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Datetime -> m Exp
forall (m :: * -> *). Quote m => Datetime -> Code m Datetime
$clift :: forall (m :: * -> *). Quote m => Datetime -> m Exp
lift :: forall (m :: * -> *). Quote m => Datetime -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Datetime -> Code m Datetime
liftTyped :: forall (m :: * -> *). Quote m => Datetime -> Code m Datetime
Lift)
  deriving newtype ([Datetime] -> Value
[Datetime] -> Encoding
Datetime -> Value
Datetime -> Encoding
(Datetime -> Value)
-> (Datetime -> Encoding)
-> ([Datetime] -> Value)
-> ([Datetime] -> Encoding)
-> ToJSON Datetime
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Datetime -> Value
toJSON :: Datetime -> Value
$ctoEncoding :: Datetime -> Encoding
toEncoding :: Datetime -> Encoding
$ctoJSONList :: [Datetime] -> Value
toJSONList :: [Datetime] -> Value
$ctoEncodingList :: [Datetime] -> Encoding
toEncodingList :: [Datetime] -> Encoding
ToJSON, Value -> Parser [Datetime]
Value -> Parser Datetime
(Value -> Parser Datetime)
-> (Value -> Parser [Datetime]) -> FromJSON Datetime
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Datetime
parseJSON :: Value -> Parser Datetime
$cparseJSONList :: Value -> Parser [Datetime]
parseJSONList :: Value -> Parser [Datetime]
FromJSON, Datetime -> ()
(Datetime -> ()) -> NFData Datetime
forall a. (a -> ()) -> NFData a
$crnf :: Datetime -> ()
rnf :: Datetime -> ()
NFData, Eq Datetime
Eq Datetime
-> (Int -> Datetime -> Int)
-> (Datetime -> Int)
-> Hashable Datetime
Int -> Datetime -> Int
Datetime -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Datetime -> Int
hashWithSalt :: Int -> Datetime -> Int
$chash :: Datetime -> Int
hash :: Datetime -> Int
Hashable)

-- | BigQuery's conception of an INTEGER/INT64 (they are the same).
newtype Int64 = Int64 Text
  deriving stock (Int -> Int64 -> ShowS
[Int64] -> ShowS
Int64 -> String
(Int -> Int64 -> ShowS)
-> (Int64 -> String) -> ([Int64] -> ShowS) -> Show Int64
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Int64 -> ShowS
showsPrec :: Int -> Int64 -> ShowS
$cshow :: Int64 -> String
show :: Int64 -> String
$cshowList :: [Int64] -> ShowS
showList :: [Int64] -> ShowS
Show, Int64 -> Int64 -> Bool
(Int64 -> Int64 -> Bool) -> (Int64 -> Int64 -> Bool) -> Eq Int64
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Int64 -> Int64 -> Bool
== :: Int64 -> Int64 -> Bool
$c/= :: Int64 -> Int64 -> Bool
/= :: Int64 -> Int64 -> Bool
Eq, Eq Int64
Eq Int64
-> (Int64 -> Int64 -> Ordering)
-> (Int64 -> Int64 -> Bool)
-> (Int64 -> Int64 -> Bool)
-> (Int64 -> Int64 -> Bool)
-> (Int64 -> Int64 -> Bool)
-> (Int64 -> Int64 -> Int64)
-> (Int64 -> Int64 -> Int64)
-> Ord Int64
Int64 -> Int64 -> Bool
Int64 -> Int64 -> Ordering
Int64 -> Int64 -> Int64
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 :: Int64 -> Int64 -> Ordering
compare :: Int64 -> Int64 -> Ordering
$c< :: Int64 -> Int64 -> Bool
< :: Int64 -> Int64 -> Bool
$c<= :: Int64 -> Int64 -> Bool
<= :: Int64 -> Int64 -> Bool
$c> :: Int64 -> Int64 -> Bool
> :: Int64 -> Int64 -> Bool
$c>= :: Int64 -> Int64 -> Bool
>= :: Int64 -> Int64 -> Bool
$cmax :: Int64 -> Int64 -> Int64
max :: Int64 -> Int64 -> Int64
$cmin :: Int64 -> Int64 -> Int64
min :: Int64 -> Int64 -> Int64
Ord, (forall x. Int64 -> Rep Int64 x)
-> (forall x. Rep Int64 x -> Int64) -> Generic Int64
forall x. Rep Int64 x -> Int64
forall x. Int64 -> Rep Int64 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Int64 -> Rep Int64 x
from :: forall x. Int64 -> Rep Int64 x
$cto :: forall x. Rep Int64 x -> Int64
to :: forall x. Rep Int64 x -> Int64
Generic, Typeable Int64
Typeable Int64
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Int64 -> c Int64)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Int64)
-> (Int64 -> Constr)
-> (Int64 -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Int64))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Int64))
-> ((forall b. Data b => b -> b) -> Int64 -> Int64)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Int64 -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Int64 -> r)
-> (forall u. (forall d. Data d => d -> u) -> Int64 -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Int64 -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Int64 -> m Int64)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Int64 -> m Int64)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Int64 -> m Int64)
-> Data Int64
Int64 -> Constr
Int64 -> DataType
(forall b. Data b => b -> b) -> Int64 -> Int64
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Int64 -> u
forall u. (forall d. Data d => d -> u) -> Int64 -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Int64 -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Int64 -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Int64 -> m Int64
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Int64 -> m Int64
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Int64
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Int64 -> c Int64
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Int64)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Int64)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Int64 -> c Int64
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Int64 -> c Int64
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Int64
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Int64
$ctoConstr :: Int64 -> Constr
toConstr :: Int64 -> Constr
$cdataTypeOf :: Int64 -> DataType
dataTypeOf :: Int64 -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Int64)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Int64)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Int64)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Int64)
$cgmapT :: (forall b. Data b => b -> b) -> Int64 -> Int64
gmapT :: (forall b. Data b => b -> b) -> Int64 -> Int64
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Int64 -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Int64 -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Int64 -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Int64 -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Int64 -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Int64 -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Int64 -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Int64 -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Int64 -> m Int64
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Int64 -> m Int64
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Int64 -> m Int64
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Int64 -> m Int64
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Int64 -> m Int64
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Int64 -> m Int64
Data, (forall (m :: * -> *). Quote m => Int64 -> m Exp)
-> (forall (m :: * -> *). Quote m => Int64 -> Code m Int64)
-> Lift Int64
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Int64 -> m Exp
forall (m :: * -> *). Quote m => Int64 -> Code m Int64
$clift :: forall (m :: * -> *). Quote m => Int64 -> m Exp
lift :: forall (m :: * -> *). Quote m => Int64 -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Int64 -> Code m Int64
liftTyped :: forall (m :: * -> *). Quote m => Int64 -> Code m Int64
Lift)
  deriving newtype (Int64 -> ()
(Int64 -> ()) -> NFData Int64
forall a. (a -> ()) -> NFData a
$crnf :: Int64 -> ()
rnf :: Int64 -> ()
NFData, Eq Int64
Eq Int64
-> (Int -> Int64 -> Int) -> (Int64 -> Int) -> Hashable Int64
Int -> Int64 -> Int
Int64 -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Int64 -> Int
hashWithSalt :: Int -> Int64 -> Int
$chash :: Int64 -> Int
hash :: Int64 -> Int
Hashable)

instance FromJSON Int64 where parseJSON :: Value -> Parser Int64
parseJSON = (Text -> Int64) -> Value -> Parser Int64
forall a. (Text -> a) -> Value -> Parser a
liberalInt64Parser Text -> Int64
Int64

instance ToJSON Int64 where toJSON :: Int64 -> Value
toJSON = Int64 -> Value
forall a. Coercible Text a => a -> Value
liberalIntegralPrinter

data TypedValue = TypedValue
  { TypedValue -> ScalarType
tvType :: ScalarType,
    TypedValue -> Value
tvValue :: Value
  }
  deriving stock (TypedValue -> TypedValue -> Bool
(TypedValue -> TypedValue -> Bool)
-> (TypedValue -> TypedValue -> Bool) -> Eq TypedValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypedValue -> TypedValue -> Bool
== :: TypedValue -> TypedValue -> Bool
$c/= :: TypedValue -> TypedValue -> Bool
/= :: TypedValue -> TypedValue -> Bool
Eq, Eq TypedValue
Eq TypedValue
-> (TypedValue -> TypedValue -> Ordering)
-> (TypedValue -> TypedValue -> Bool)
-> (TypedValue -> TypedValue -> Bool)
-> (TypedValue -> TypedValue -> Bool)
-> (TypedValue -> TypedValue -> Bool)
-> (TypedValue -> TypedValue -> TypedValue)
-> (TypedValue -> TypedValue -> TypedValue)
-> Ord TypedValue
TypedValue -> TypedValue -> Bool
TypedValue -> TypedValue -> Ordering
TypedValue -> TypedValue -> TypedValue
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 :: TypedValue -> TypedValue -> Ordering
compare :: TypedValue -> TypedValue -> Ordering
$c< :: TypedValue -> TypedValue -> Bool
< :: TypedValue -> TypedValue -> Bool
$c<= :: TypedValue -> TypedValue -> Bool
<= :: TypedValue -> TypedValue -> Bool
$c> :: TypedValue -> TypedValue -> Bool
> :: TypedValue -> TypedValue -> Bool
$c>= :: TypedValue -> TypedValue -> Bool
>= :: TypedValue -> TypedValue -> Bool
$cmax :: TypedValue -> TypedValue -> TypedValue
max :: TypedValue -> TypedValue -> TypedValue
$cmin :: TypedValue -> TypedValue -> TypedValue
min :: TypedValue -> TypedValue -> TypedValue
Ord, Int -> TypedValue -> ShowS
[TypedValue] -> ShowS
TypedValue -> String
(Int -> TypedValue -> ShowS)
-> (TypedValue -> String)
-> ([TypedValue] -> ShowS)
-> Show TypedValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypedValue -> ShowS
showsPrec :: Int -> TypedValue -> ShowS
$cshow :: TypedValue -> String
show :: TypedValue -> String
$cshowList :: [TypedValue] -> ShowS
showList :: [TypedValue] -> ShowS
Show, (forall x. TypedValue -> Rep TypedValue x)
-> (forall x. Rep TypedValue x -> TypedValue) -> Generic TypedValue
forall x. Rep TypedValue x -> TypedValue
forall x. TypedValue -> Rep TypedValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TypedValue -> Rep TypedValue x
from :: forall x. TypedValue -> Rep TypedValue x
$cto :: forall x. Rep TypedValue x -> TypedValue
to :: forall x. Rep TypedValue x -> TypedValue
Generic, Typeable TypedValue
Typeable TypedValue
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> TypedValue -> c TypedValue)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c TypedValue)
-> (TypedValue -> Constr)
-> (TypedValue -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c TypedValue))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c TypedValue))
-> ((forall b. Data b => b -> b) -> TypedValue -> TypedValue)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> TypedValue -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> TypedValue -> r)
-> (forall u. (forall d. Data d => d -> u) -> TypedValue -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> TypedValue -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> TypedValue -> m TypedValue)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TypedValue -> m TypedValue)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TypedValue -> m TypedValue)
-> Data TypedValue
TypedValue -> Constr
TypedValue -> DataType
(forall b. Data b => b -> b) -> TypedValue -> TypedValue
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TypedValue -> u
forall u. (forall d. Data d => d -> u) -> TypedValue -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypedValue -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypedValue -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TypedValue -> m TypedValue
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypedValue -> m TypedValue
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypedValue
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypedValue -> c TypedValue
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypedValue)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TypedValue)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypedValue -> c TypedValue
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypedValue -> c TypedValue
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypedValue
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypedValue
$ctoConstr :: TypedValue -> Constr
toConstr :: TypedValue -> Constr
$cdataTypeOf :: TypedValue -> DataType
dataTypeOf :: TypedValue -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypedValue)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypedValue)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TypedValue)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TypedValue)
$cgmapT :: (forall b. Data b => b -> b) -> TypedValue -> TypedValue
gmapT :: (forall b. Data b => b -> b) -> TypedValue -> TypedValue
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypedValue -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypedValue -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypedValue -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypedValue -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TypedValue -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> TypedValue -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TypedValue -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TypedValue -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TypedValue -> m TypedValue
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TypedValue -> m TypedValue
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypedValue -> m TypedValue
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypedValue -> m TypedValue
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypedValue -> m TypedValue
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypedValue -> m TypedValue
Data, (forall (m :: * -> *). Quote m => TypedValue -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    TypedValue -> Code m TypedValue)
-> Lift TypedValue
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => TypedValue -> m Exp
forall (m :: * -> *). Quote m => TypedValue -> Code m TypedValue
$clift :: forall (m :: * -> *). Quote m => TypedValue -> m Exp
lift :: forall (m :: * -> *). Quote m => TypedValue -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => TypedValue -> Code m TypedValue
liftTyped :: forall (m :: * -> *). Quote m => TypedValue -> Code m TypedValue
Lift)
  deriving anyclass (Eq TypedValue
Eq TypedValue
-> (Int -> TypedValue -> Int)
-> (TypedValue -> Int)
-> Hashable TypedValue
Int -> TypedValue -> Int
TypedValue -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> TypedValue -> Int
hashWithSalt :: Int -> TypedValue -> Int
$chash :: TypedValue -> Int
hash :: TypedValue -> Int
Hashable, TypedValue -> ()
(TypedValue -> ()) -> NFData TypedValue
forall a. (a -> ()) -> NFData a
$crnf :: TypedValue -> ()
rnf :: TypedValue -> ()
NFData)

intToInt64 :: Int.Int64 -> Int64
intToInt64 :: Int64 -> Int64
intToInt64 = Text -> Int64
Int64 (Text -> Int64) -> (Int64 -> Text) -> Int64 -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Text
forall a. Show a => a -> Text
tshow

int64Expr :: Int.Int64 -> Expression
int64Expr :: Int64 -> Expression
int64Expr Int64
i = TypedValue -> Expression
ValueExpression (ScalarType -> Value -> TypedValue
TypedValue ScalarType
IntegerScalarType (Int64 -> Value
IntegerValue (Int64 -> Int64
intToInt64 Int64
i)))

-- | BigQuery's conception of a fixed precision decimal.
newtype Decimal = Decimal Text
  deriving stock (Int -> Decimal -> ShowS
[Decimal] -> ShowS
Decimal -> String
(Int -> Decimal -> ShowS)
-> (Decimal -> String) -> ([Decimal] -> ShowS) -> Show Decimal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Decimal -> ShowS
showsPrec :: Int -> Decimal -> ShowS
$cshow :: Decimal -> String
show :: Decimal -> String
$cshowList :: [Decimal] -> ShowS
showList :: [Decimal] -> ShowS
Show, Decimal -> Decimal -> Bool
(Decimal -> Decimal -> Bool)
-> (Decimal -> Decimal -> Bool) -> Eq Decimal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Decimal -> Decimal -> Bool
== :: Decimal -> Decimal -> Bool
$c/= :: Decimal -> Decimal -> Bool
/= :: Decimal -> Decimal -> Bool
Eq, Eq Decimal
Eq Decimal
-> (Decimal -> Decimal -> Ordering)
-> (Decimal -> Decimal -> Bool)
-> (Decimal -> Decimal -> Bool)
-> (Decimal -> Decimal -> Bool)
-> (Decimal -> Decimal -> Bool)
-> (Decimal -> Decimal -> Decimal)
-> (Decimal -> Decimal -> Decimal)
-> Ord Decimal
Decimal -> Decimal -> Bool
Decimal -> Decimal -> Ordering
Decimal -> Decimal -> Decimal
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 :: Decimal -> Decimal -> Ordering
compare :: Decimal -> Decimal -> Ordering
$c< :: Decimal -> Decimal -> Bool
< :: Decimal -> Decimal -> Bool
$c<= :: Decimal -> Decimal -> Bool
<= :: Decimal -> Decimal -> Bool
$c> :: Decimal -> Decimal -> Bool
> :: Decimal -> Decimal -> Bool
$c>= :: Decimal -> Decimal -> Bool
>= :: Decimal -> Decimal -> Bool
$cmax :: Decimal -> Decimal -> Decimal
max :: Decimal -> Decimal -> Decimal
$cmin :: Decimal -> Decimal -> Decimal
min :: Decimal -> Decimal -> Decimal
Ord, (forall x. Decimal -> Rep Decimal x)
-> (forall x. Rep Decimal x -> Decimal) -> Generic Decimal
forall x. Rep Decimal x -> Decimal
forall x. Decimal -> Rep Decimal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Decimal -> Rep Decimal x
from :: forall x. Decimal -> Rep Decimal x
$cto :: forall x. Rep Decimal x -> Decimal
to :: forall x. Rep Decimal x -> Decimal
Generic, Typeable Decimal
Typeable Decimal
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Decimal -> c Decimal)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Decimal)
-> (Decimal -> Constr)
-> (Decimal -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Decimal))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Decimal))
-> ((forall b. Data b => b -> b) -> Decimal -> Decimal)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Decimal -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Decimal -> r)
-> (forall u. (forall d. Data d => d -> u) -> Decimal -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Decimal -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Decimal -> m Decimal)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Decimal -> m Decimal)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Decimal -> m Decimal)
-> Data Decimal
Decimal -> Constr
Decimal -> DataType
(forall b. Data b => b -> b) -> Decimal -> Decimal
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Decimal -> u
forall u. (forall d. Data d => d -> u) -> Decimal -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Decimal -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Decimal -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Decimal -> m Decimal
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Decimal -> m Decimal
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Decimal
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Decimal -> c Decimal
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Decimal)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Decimal)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Decimal -> c Decimal
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Decimal -> c Decimal
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Decimal
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Decimal
$ctoConstr :: Decimal -> Constr
toConstr :: Decimal -> Constr
$cdataTypeOf :: Decimal -> DataType
dataTypeOf :: Decimal -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Decimal)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Decimal)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Decimal)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Decimal)
$cgmapT :: (forall b. Data b => b -> b) -> Decimal -> Decimal
gmapT :: (forall b. Data b => b -> b) -> Decimal -> Decimal
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Decimal -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Decimal -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Decimal -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Decimal -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Decimal -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Decimal -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Decimal -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Decimal -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Decimal -> m Decimal
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Decimal -> m Decimal
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Decimal -> m Decimal
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Decimal -> m Decimal
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Decimal -> m Decimal
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Decimal -> m Decimal
Data, (forall (m :: * -> *). Quote m => Decimal -> m Exp)
-> (forall (m :: * -> *). Quote m => Decimal -> Code m Decimal)
-> Lift Decimal
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Decimal -> m Exp
forall (m :: * -> *). Quote m => Decimal -> Code m Decimal
$clift :: forall (m :: * -> *). Quote m => Decimal -> m Exp
lift :: forall (m :: * -> *). Quote m => Decimal -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Decimal -> Code m Decimal
liftTyped :: forall (m :: * -> *). Quote m => Decimal -> Code m Decimal
Lift)
  deriving newtype (Decimal -> ()
(Decimal -> ()) -> NFData Decimal
forall a. (a -> ()) -> NFData a
$crnf :: Decimal -> ()
rnf :: Decimal -> ()
NFData, Eq Decimal
Eq Decimal
-> (Int -> Decimal -> Int) -> (Decimal -> Int) -> Hashable Decimal
Int -> Decimal -> Int
Decimal -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Decimal -> Int
hashWithSalt :: Int -> Decimal -> Int
$chash :: Decimal -> Int
hash :: Decimal -> Int
Hashable)

instance FromJSON Decimal where
  parseJSON :: Value -> Parser Decimal
parseJSON (J.Number Scientific
num) = Decimal -> Parser Decimal
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Decimal -> Parser Decimal) -> Decimal -> Parser Decimal
forall a b. (a -> b) -> a -> b
$ Text -> Decimal
Decimal (Text -> Decimal) -> Text -> Decimal
forall a b. (a -> b) -> a -> b
$ Scientific -> Text
scientificToText Scientific
num
  parseJSON (J.String Text
num) = Decimal -> Parser Decimal
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Decimal -> Parser Decimal) -> Decimal -> Parser Decimal
forall a b. (a -> b) -> a -> b
$ Text -> Decimal
Decimal Text
num
  parseJSON Value
_ = String -> Parser Decimal
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"parseJSON: FromJSON Decimal failure"

instance ToJSON Decimal where
  toJSON :: Decimal -> Value
toJSON (Decimal Text
x) = Text -> Value
forall a. ToJSON a => a -> Value
J.toJSON Text
x

-- | Convert 'Scientific' to 'Text'
scientificToText :: Scientific -> Text
scientificToText :: Scientific -> Text
scientificToText Scientific
num = Text -> Text
toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Builder -> Text
toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ FPFormat -> Maybe Int -> Scientific -> Builder
formatScientificBuilder FPFormat
Fixed Maybe Int
forall a. Maybe a
Nothing Scientific
num

-- | BigQuery's conception of a \"big\" fixed precision decimal.
newtype BigDecimal = BigDecimal Text
  deriving stock (Int -> BigDecimal -> ShowS
[BigDecimal] -> ShowS
BigDecimal -> String
(Int -> BigDecimal -> ShowS)
-> (BigDecimal -> String)
-> ([BigDecimal] -> ShowS)
-> Show BigDecimal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BigDecimal -> ShowS
showsPrec :: Int -> BigDecimal -> ShowS
$cshow :: BigDecimal -> String
show :: BigDecimal -> String
$cshowList :: [BigDecimal] -> ShowS
showList :: [BigDecimal] -> ShowS
Show, BigDecimal -> BigDecimal -> Bool
(BigDecimal -> BigDecimal -> Bool)
-> (BigDecimal -> BigDecimal -> Bool) -> Eq BigDecimal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BigDecimal -> BigDecimal -> Bool
== :: BigDecimal -> BigDecimal -> Bool
$c/= :: BigDecimal -> BigDecimal -> Bool
/= :: BigDecimal -> BigDecimal -> Bool
Eq, Eq BigDecimal
Eq BigDecimal
-> (BigDecimal -> BigDecimal -> Ordering)
-> (BigDecimal -> BigDecimal -> Bool)
-> (BigDecimal -> BigDecimal -> Bool)
-> (BigDecimal -> BigDecimal -> Bool)
-> (BigDecimal -> BigDecimal -> Bool)
-> (BigDecimal -> BigDecimal -> BigDecimal)
-> (BigDecimal -> BigDecimal -> BigDecimal)
-> Ord BigDecimal
BigDecimal -> BigDecimal -> Bool
BigDecimal -> BigDecimal -> Ordering
BigDecimal -> BigDecimal -> BigDecimal
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 :: BigDecimal -> BigDecimal -> Ordering
compare :: BigDecimal -> BigDecimal -> Ordering
$c< :: BigDecimal -> BigDecimal -> Bool
< :: BigDecimal -> BigDecimal -> Bool
$c<= :: BigDecimal -> BigDecimal -> Bool
<= :: BigDecimal -> BigDecimal -> Bool
$c> :: BigDecimal -> BigDecimal -> Bool
> :: BigDecimal -> BigDecimal -> Bool
$c>= :: BigDecimal -> BigDecimal -> Bool
>= :: BigDecimal -> BigDecimal -> Bool
$cmax :: BigDecimal -> BigDecimal -> BigDecimal
max :: BigDecimal -> BigDecimal -> BigDecimal
$cmin :: BigDecimal -> BigDecimal -> BigDecimal
min :: BigDecimal -> BigDecimal -> BigDecimal
Ord, (forall x. BigDecimal -> Rep BigDecimal x)
-> (forall x. Rep BigDecimal x -> BigDecimal) -> Generic BigDecimal
forall x. Rep BigDecimal x -> BigDecimal
forall x. BigDecimal -> Rep BigDecimal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BigDecimal -> Rep BigDecimal x
from :: forall x. BigDecimal -> Rep BigDecimal x
$cto :: forall x. Rep BigDecimal x -> BigDecimal
to :: forall x. Rep BigDecimal x -> BigDecimal
Generic, Typeable BigDecimal
Typeable BigDecimal
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> BigDecimal -> c BigDecimal)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c BigDecimal)
-> (BigDecimal -> Constr)
-> (BigDecimal -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c BigDecimal))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c BigDecimal))
-> ((forall b. Data b => b -> b) -> BigDecimal -> BigDecimal)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> BigDecimal -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> BigDecimal -> r)
-> (forall u. (forall d. Data d => d -> u) -> BigDecimal -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> BigDecimal -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> BigDecimal -> m BigDecimal)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> BigDecimal -> m BigDecimal)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> BigDecimal -> m BigDecimal)
-> Data BigDecimal
BigDecimal -> Constr
BigDecimal -> DataType
(forall b. Data b => b -> b) -> BigDecimal -> BigDecimal
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> BigDecimal -> u
forall u. (forall d. Data d => d -> u) -> BigDecimal -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BigDecimal -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BigDecimal -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BigDecimal -> m BigDecimal
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BigDecimal -> m BigDecimal
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BigDecimal
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BigDecimal -> c BigDecimal
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BigDecimal)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BigDecimal)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BigDecimal -> c BigDecimal
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BigDecimal -> c BigDecimal
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BigDecimal
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BigDecimal
$ctoConstr :: BigDecimal -> Constr
toConstr :: BigDecimal -> Constr
$cdataTypeOf :: BigDecimal -> DataType
dataTypeOf :: BigDecimal -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BigDecimal)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BigDecimal)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BigDecimal)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BigDecimal)
$cgmapT :: (forall b. Data b => b -> b) -> BigDecimal -> BigDecimal
gmapT :: (forall b. Data b => b -> b) -> BigDecimal -> BigDecimal
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BigDecimal -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BigDecimal -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BigDecimal -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BigDecimal -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> BigDecimal -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> BigDecimal -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BigDecimal -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BigDecimal -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BigDecimal -> m BigDecimal
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BigDecimal -> m BigDecimal
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BigDecimal -> m BigDecimal
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BigDecimal -> m BigDecimal
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BigDecimal -> m BigDecimal
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BigDecimal -> m BigDecimal
Data, (forall (m :: * -> *). Quote m => BigDecimal -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    BigDecimal -> Code m BigDecimal)
-> Lift BigDecimal
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => BigDecimal -> m Exp
forall (m :: * -> *). Quote m => BigDecimal -> Code m BigDecimal
$clift :: forall (m :: * -> *). Quote m => BigDecimal -> m Exp
lift :: forall (m :: * -> *). Quote m => BigDecimal -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => BigDecimal -> Code m BigDecimal
liftTyped :: forall (m :: * -> *). Quote m => BigDecimal -> Code m BigDecimal
Lift)
  deriving newtype (BigDecimal -> ()
(BigDecimal -> ()) -> NFData BigDecimal
forall a. (a -> ()) -> NFData a
$crnf :: BigDecimal -> ()
rnf :: BigDecimal -> ()
NFData, Eq BigDecimal
Eq BigDecimal
-> (Int -> BigDecimal -> Int)
-> (BigDecimal -> Int)
-> Hashable BigDecimal
Int -> BigDecimal -> Int
BigDecimal -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> BigDecimal -> Int
hashWithSalt :: Int -> BigDecimal -> Int
$chash :: BigDecimal -> Int
hash :: BigDecimal -> Int
Hashable)

instance FromJSON BigDecimal where
  parseJSON :: Value -> Parser BigDecimal
parseJSON (J.Number Scientific
num) = BigDecimal -> Parser BigDecimal
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BigDecimal -> Parser BigDecimal)
-> BigDecimal -> Parser BigDecimal
forall a b. (a -> b) -> a -> b
$ Text -> BigDecimal
BigDecimal (Text -> BigDecimal) -> Text -> BigDecimal
forall a b. (a -> b) -> a -> b
$ Scientific -> Text
scientificToText Scientific
num
  parseJSON (J.String Text
num) = BigDecimal -> Parser BigDecimal
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BigDecimal -> Parser BigDecimal)
-> BigDecimal -> Parser BigDecimal
forall a b. (a -> b) -> a -> b
$ Text -> BigDecimal
BigDecimal Text
num
  parseJSON Value
_ = String -> Parser BigDecimal
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"parseJSON: FromJSON BigDecimal failure"

instance ToJSON BigDecimal where
  toJSON :: BigDecimal -> Value
toJSON (BigDecimal Text
x) = Text -> Value
forall a. ToJSON a => a -> Value
J.toJSON Text
x

doubleToBigDecimal :: Double -> BigDecimal
doubleToBigDecimal :: Double -> BigDecimal
doubleToBigDecimal = Text -> BigDecimal
BigDecimal (Text -> BigDecimal) -> (Double -> Text) -> Double -> BigDecimal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> (Double -> ByteString) -> Double -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.toStrict (ByteString -> ByteString)
-> (Double -> ByteString) -> Double -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> ByteString
forall a. ToJSON a => a -> ByteString
J.encode

-- | BigQuery's conception of a fixed precision decimal.
newtype Float64 = Float64 Text
  deriving stock (Int -> Float64 -> ShowS
[Float64] -> ShowS
Float64 -> String
(Int -> Float64 -> ShowS)
-> (Float64 -> String) -> ([Float64] -> ShowS) -> Show Float64
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Float64 -> ShowS
showsPrec :: Int -> Float64 -> ShowS
$cshow :: Float64 -> String
show :: Float64 -> String
$cshowList :: [Float64] -> ShowS
showList :: [Float64] -> ShowS
Show, Float64 -> Float64 -> Bool
(Float64 -> Float64 -> Bool)
-> (Float64 -> Float64 -> Bool) -> Eq Float64
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Float64 -> Float64 -> Bool
== :: Float64 -> Float64 -> Bool
$c/= :: Float64 -> Float64 -> Bool
/= :: Float64 -> Float64 -> Bool
Eq, Eq Float64
Eq Float64
-> (Float64 -> Float64 -> Ordering)
-> (Float64 -> Float64 -> Bool)
-> (Float64 -> Float64 -> Bool)
-> (Float64 -> Float64 -> Bool)
-> (Float64 -> Float64 -> Bool)
-> (Float64 -> Float64 -> Float64)
-> (Float64 -> Float64 -> Float64)
-> Ord Float64
Float64 -> Float64 -> Bool
Float64 -> Float64 -> Ordering
Float64 -> Float64 -> Float64
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 :: Float64 -> Float64 -> Ordering
compare :: Float64 -> Float64 -> Ordering
$c< :: Float64 -> Float64 -> Bool
< :: Float64 -> Float64 -> Bool
$c<= :: Float64 -> Float64 -> Bool
<= :: Float64 -> Float64 -> Bool
$c> :: Float64 -> Float64 -> Bool
> :: Float64 -> Float64 -> Bool
$c>= :: Float64 -> Float64 -> Bool
>= :: Float64 -> Float64 -> Bool
$cmax :: Float64 -> Float64 -> Float64
max :: Float64 -> Float64 -> Float64
$cmin :: Float64 -> Float64 -> Float64
min :: Float64 -> Float64 -> Float64
Ord, (forall x. Float64 -> Rep Float64 x)
-> (forall x. Rep Float64 x -> Float64) -> Generic Float64
forall x. Rep Float64 x -> Float64
forall x. Float64 -> Rep Float64 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Float64 -> Rep Float64 x
from :: forall x. Float64 -> Rep Float64 x
$cto :: forall x. Rep Float64 x -> Float64
to :: forall x. Rep Float64 x -> Float64
Generic, Typeable Float64
Typeable Float64
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Float64 -> c Float64)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Float64)
-> (Float64 -> Constr)
-> (Float64 -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Float64))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Float64))
-> ((forall b. Data b => b -> b) -> Float64 -> Float64)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Float64 -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Float64 -> r)
-> (forall u. (forall d. Data d => d -> u) -> Float64 -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Float64 -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Float64 -> m Float64)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Float64 -> m Float64)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Float64 -> m Float64)
-> Data Float64
Float64 -> Constr
Float64 -> DataType
(forall b. Data b => b -> b) -> Float64 -> Float64
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Float64 -> u
forall u. (forall d. Data d => d -> u) -> Float64 -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Float64 -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Float64 -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Float64 -> m Float64
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Float64 -> m Float64
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Float64
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Float64 -> c Float64
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Float64)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Float64)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Float64 -> c Float64
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Float64 -> c Float64
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Float64
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Float64
$ctoConstr :: Float64 -> Constr
toConstr :: Float64 -> Constr
$cdataTypeOf :: Float64 -> DataType
dataTypeOf :: Float64 -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Float64)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Float64)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Float64)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Float64)
$cgmapT :: (forall b. Data b => b -> b) -> Float64 -> Float64
gmapT :: (forall b. Data b => b -> b) -> Float64 -> Float64
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Float64 -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Float64 -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Float64 -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Float64 -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Float64 -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Float64 -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Float64 -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Float64 -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Float64 -> m Float64
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Float64 -> m Float64
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Float64 -> m Float64
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Float64 -> m Float64
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Float64 -> m Float64
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Float64 -> m Float64
Data, (forall (m :: * -> *). Quote m => Float64 -> m Exp)
-> (forall (m :: * -> *). Quote m => Float64 -> Code m Float64)
-> Lift Float64
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Float64 -> m Exp
forall (m :: * -> *). Quote m => Float64 -> Code m Float64
$clift :: forall (m :: * -> *). Quote m => Float64 -> m Exp
lift :: forall (m :: * -> *). Quote m => Float64 -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Float64 -> Code m Float64
liftTyped :: forall (m :: * -> *). Quote m => Float64 -> Code m Float64
Lift)
  deriving newtype (Float64 -> ()
(Float64 -> ()) -> NFData Float64
forall a. (a -> ()) -> NFData a
$crnf :: Float64 -> ()
rnf :: Float64 -> ()
NFData, Eq Float64
Eq Float64
-> (Int -> Float64 -> Int) -> (Float64 -> Int) -> Hashable Float64
Int -> Float64 -> Int
Float64 -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Float64 -> Int
hashWithSalt :: Int -> Float64 -> Int
$chash :: Float64 -> Int
hash :: Float64 -> Int
Hashable)

instance FromJSON Float64 where parseJSON :: Value -> Parser Float64
parseJSON = (Text -> Float64) -> Value -> Parser Float64
forall a. (Text -> a) -> Value -> Parser a
liberalDecimalParser Text -> Float64
Float64

instance ToJSON Float64 where toJSON :: Float64 -> Value
toJSON = Float64 -> Value
forall a. Coercible a Text => a -> Value
liberalDecimalPrinter

doubleToFloat64 :: Double -> Float64
doubleToFloat64 :: Double -> Float64
doubleToFloat64 = Text -> Float64
Float64 (Text -> Float64) -> (Double -> Text) -> Double -> Float64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> (Double -> ByteString) -> Double -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.toStrict (ByteString -> ByteString)
-> (Double -> ByteString) -> Double -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> ByteString
forall a. ToJSON a => a -> ByteString
J.encode

-- | A base-64 encoded binary string.
newtype Base64 = Base64
  { Base64 -> ByteString
unBase64 :: ByteString
  }
  deriving (Int -> Base64 -> ShowS
[Base64] -> ShowS
Base64 -> String
(Int -> Base64 -> ShowS)
-> (Base64 -> String) -> ([Base64] -> ShowS) -> Show Base64
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Base64 -> ShowS
showsPrec :: Int -> Base64 -> ShowS
$cshow :: Base64 -> String
show :: Base64 -> String
$cshowList :: [Base64] -> ShowS
showList :: [Base64] -> ShowS
Show, Base64 -> Base64 -> Bool
(Base64 -> Base64 -> Bool)
-> (Base64 -> Base64 -> Bool) -> Eq Base64
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Base64 -> Base64 -> Bool
== :: Base64 -> Base64 -> Bool
$c/= :: Base64 -> Base64 -> Bool
/= :: Base64 -> Base64 -> Bool
Eq, Eq Base64
Eq Base64
-> (Base64 -> Base64 -> Ordering)
-> (Base64 -> Base64 -> Bool)
-> (Base64 -> Base64 -> Bool)
-> (Base64 -> Base64 -> Bool)
-> (Base64 -> Base64 -> Bool)
-> (Base64 -> Base64 -> Base64)
-> (Base64 -> Base64 -> Base64)
-> Ord Base64
Base64 -> Base64 -> Bool
Base64 -> Base64 -> Ordering
Base64 -> Base64 -> Base64
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 :: Base64 -> Base64 -> Ordering
compare :: Base64 -> Base64 -> Ordering
$c< :: Base64 -> Base64 -> Bool
< :: Base64 -> Base64 -> Bool
$c<= :: Base64 -> Base64 -> Bool
<= :: Base64 -> Base64 -> Bool
$c> :: Base64 -> Base64 -> Bool
> :: Base64 -> Base64 -> Bool
$c>= :: Base64 -> Base64 -> Bool
>= :: Base64 -> Base64 -> Bool
$cmax :: Base64 -> Base64 -> Base64
max :: Base64 -> Base64 -> Base64
$cmin :: Base64 -> Base64 -> Base64
min :: Base64 -> Base64 -> Base64
Ord, (forall x. Base64 -> Rep Base64 x)
-> (forall x. Rep Base64 x -> Base64) -> Generic Base64
forall x. Rep Base64 x -> Base64
forall x. Base64 -> Rep Base64 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Base64 -> Rep Base64 x
from :: forall x. Base64 -> Rep Base64 x
$cto :: forall x. Rep Base64 x -> Base64
to :: forall x. Rep Base64 x -> Base64
Generic, Typeable Base64
Typeable Base64
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Base64 -> c Base64)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Base64)
-> (Base64 -> Constr)
-> (Base64 -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Base64))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Base64))
-> ((forall b. Data b => b -> b) -> Base64 -> Base64)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Base64 -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Base64 -> r)
-> (forall u. (forall d. Data d => d -> u) -> Base64 -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Base64 -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Base64 -> m Base64)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Base64 -> m Base64)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Base64 -> m Base64)
-> Data Base64
Base64 -> Constr
Base64 -> DataType
(forall b. Data b => b -> b) -> Base64 -> Base64
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Base64 -> u
forall u. (forall d. Data d => d -> u) -> Base64 -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Base64 -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Base64 -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Base64 -> m Base64
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Base64 -> m Base64
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Base64
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Base64 -> c Base64
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Base64)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Base64)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Base64 -> c Base64
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Base64 -> c Base64
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Base64
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Base64
$ctoConstr :: Base64 -> Constr
toConstr :: Base64 -> Constr
$cdataTypeOf :: Base64 -> DataType
dataTypeOf :: Base64 -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Base64)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Base64)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Base64)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Base64)
$cgmapT :: (forall b. Data b => b -> b) -> Base64 -> Base64
gmapT :: (forall b. Data b => b -> b) -> Base64 -> Base64
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Base64 -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Base64 -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Base64 -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Base64 -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Base64 -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Base64 -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Base64 -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Base64 -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Base64 -> m Base64
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Base64 -> m Base64
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Base64 -> m Base64
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Base64 -> m Base64
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Base64 -> m Base64
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Base64 -> m Base64
Data, (forall (m :: * -> *). Quote m => Base64 -> m Exp)
-> (forall (m :: * -> *). Quote m => Base64 -> Code m Base64)
-> Lift Base64
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Base64 -> m Exp
forall (m :: * -> *). Quote m => Base64 -> Code m Base64
$clift :: forall (m :: * -> *). Quote m => Base64 -> m Exp
lift :: forall (m :: * -> *). Quote m => Base64 -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Base64 -> Code m Base64
liftTyped :: forall (m :: * -> *). Quote m => Base64 -> Code m Base64
Lift)

instance FromJSON Base64 where parseJSON :: Value -> Parser Base64
parseJSON = (Text -> Base64) -> Parser Text -> Parser Base64
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Base64
Base64 (ByteString -> Base64) -> (Text -> ByteString) -> Text -> Base64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.toStrict (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
base64Decode) (Parser Text -> Parser Base64)
-> (Value -> Parser Text) -> Value -> Parser Base64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
J.parseJSON

instance ToJSON Base64 where toJSON :: Base64 -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
J.toJSON (Text -> Value) -> (Base64 -> Text) -> Base64 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> (Base64 -> ByteString) -> Base64 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base64.encode (ByteString -> ByteString)
-> (Base64 -> ByteString) -> Base64 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base64 -> ByteString
unBase64

instance NFData Base64

instance Hashable Base64

newtype Geography = Geography
  { Geography -> Text
unGeography :: Text
  }
  deriving stock (Int -> Geography -> ShowS
[Geography] -> ShowS
Geography -> String
(Int -> Geography -> ShowS)
-> (Geography -> String)
-> ([Geography] -> ShowS)
-> Show Geography
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Geography -> ShowS
showsPrec :: Int -> Geography -> ShowS
$cshow :: Geography -> String
show :: Geography -> String
$cshowList :: [Geography] -> ShowS
showList :: [Geography] -> ShowS
Show, Geography -> Geography -> Bool
(Geography -> Geography -> Bool)
-> (Geography -> Geography -> Bool) -> Eq Geography
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Geography -> Geography -> Bool
== :: Geography -> Geography -> Bool
$c/= :: Geography -> Geography -> Bool
/= :: Geography -> Geography -> Bool
Eq, Eq Geography
Eq Geography
-> (Geography -> Geography -> Ordering)
-> (Geography -> Geography -> Bool)
-> (Geography -> Geography -> Bool)
-> (Geography -> Geography -> Bool)
-> (Geography -> Geography -> Bool)
-> (Geography -> Geography -> Geography)
-> (Geography -> Geography -> Geography)
-> Ord Geography
Geography -> Geography -> Bool
Geography -> Geography -> Ordering
Geography -> Geography -> Geography
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 :: Geography -> Geography -> Ordering
compare :: Geography -> Geography -> Ordering
$c< :: Geography -> Geography -> Bool
< :: Geography -> Geography -> Bool
$c<= :: Geography -> Geography -> Bool
<= :: Geography -> Geography -> Bool
$c> :: Geography -> Geography -> Bool
> :: Geography -> Geography -> Bool
$c>= :: Geography -> Geography -> Bool
>= :: Geography -> Geography -> Bool
$cmax :: Geography -> Geography -> Geography
max :: Geography -> Geography -> Geography
$cmin :: Geography -> Geography -> Geography
min :: Geography -> Geography -> Geography
Ord, (forall x. Geography -> Rep Geography x)
-> (forall x. Rep Geography x -> Geography) -> Generic Geography
forall x. Rep Geography x -> Geography
forall x. Geography -> Rep Geography x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Geography -> Rep Geography x
from :: forall x. Geography -> Rep Geography x
$cto :: forall x. Rep Geography x -> Geography
to :: forall x. Rep Geography x -> Geography
Generic, Typeable Geography
Typeable Geography
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Geography -> c Geography)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Geography)
-> (Geography -> Constr)
-> (Geography -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Geography))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Geography))
-> ((forall b. Data b => b -> b) -> Geography -> Geography)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Geography -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Geography -> r)
-> (forall u. (forall d. Data d => d -> u) -> Geography -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Geography -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Geography -> m Geography)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Geography -> m Geography)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Geography -> m Geography)
-> Data Geography
Geography -> Constr
Geography -> DataType
(forall b. Data b => b -> b) -> Geography -> Geography
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Geography -> u
forall u. (forall d. Data d => d -> u) -> Geography -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Geography -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Geography -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Geography -> m Geography
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Geography -> m Geography
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Geography
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Geography -> c Geography
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Geography)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Geography)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Geography -> c Geography
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Geography -> c Geography
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Geography
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Geography
$ctoConstr :: Geography -> Constr
toConstr :: Geography -> Constr
$cdataTypeOf :: Geography -> DataType
dataTypeOf :: Geography -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Geography)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Geography)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Geography)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Geography)
$cgmapT :: (forall b. Data b => b -> b) -> Geography -> Geography
gmapT :: (forall b. Data b => b -> b) -> Geography -> Geography
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Geography -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Geography -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Geography -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Geography -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Geography -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Geography -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Geography -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Geography -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Geography -> m Geography
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Geography -> m Geography
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Geography -> m Geography
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Geography -> m Geography
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Geography -> m Geography
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Geography -> m Geography
Data, (forall (m :: * -> *). Quote m => Geography -> m Exp)
-> (forall (m :: * -> *). Quote m => Geography -> Code m Geography)
-> Lift Geography
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Geography -> m Exp
forall (m :: * -> *). Quote m => Geography -> Code m Geography
$clift :: forall (m :: * -> *). Quote m => Geography -> m Exp
lift :: forall (m :: * -> *). Quote m => Geography -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Geography -> Code m Geography
liftTyped :: forall (m :: * -> *). Quote m => Geography -> Code m Geography
Lift)
  deriving newtype (Value -> Parser [Geography]
Value -> Parser Geography
(Value -> Parser Geography)
-> (Value -> Parser [Geography]) -> FromJSON Geography
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Geography
parseJSON :: Value -> Parser Geography
$cparseJSONList :: Value -> Parser [Geography]
parseJSONList :: Value -> Parser [Geography]
FromJSON, [Geography] -> Value
[Geography] -> Encoding
Geography -> Value
Geography -> Encoding
(Geography -> Value)
-> (Geography -> Encoding)
-> ([Geography] -> Value)
-> ([Geography] -> Encoding)
-> ToJSON Geography
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Geography -> Value
toJSON :: Geography -> Value
$ctoEncoding :: Geography -> Encoding
toEncoding :: Geography -> Encoding
$ctoJSONList :: [Geography] -> Value
toJSONList :: [Geography] -> Value
$ctoEncodingList :: [Geography] -> Encoding
toEncodingList :: [Geography] -> Encoding
ToJSON)
  deriving anyclass (Eq Geography
Eq Geography
-> (Int -> Geography -> Int)
-> (Geography -> Int)
-> Hashable Geography
Int -> Geography -> Int
Geography -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Geography -> Int
hashWithSalt :: Int -> Geography -> Int
$chash :: Geography -> Int
hash :: Geography -> Int
Hashable, Geography -> ()
(Geography -> ()) -> NFData Geography
forall a. (a -> ()) -> NFData a
$crnf :: Geography -> ()
rnf :: Geography -> ()
NFData)

data ScalarType
  = StringScalarType
  | BytesScalarType
  | IntegerScalarType
  | FloatScalarType
  | BoolScalarType
  | TimestampScalarType
  | DateScalarType
  | TimeScalarType
  | DatetimeScalarType
  | GeographyScalarType
  | DecimalScalarType
  | BigDecimalScalarType
  | JsonScalarType
  | StructScalarType
  deriving stock (Int -> ScalarType -> ShowS
[ScalarType] -> ShowS
ScalarType -> String
(Int -> ScalarType -> ShowS)
-> (ScalarType -> String)
-> ([ScalarType] -> ShowS)
-> Show ScalarType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScalarType -> ShowS
showsPrec :: Int -> ScalarType -> ShowS
$cshow :: ScalarType -> String
show :: ScalarType -> String
$cshowList :: [ScalarType] -> ShowS
showList :: [ScalarType] -> ShowS
Show, ScalarType -> ScalarType -> Bool
(ScalarType -> ScalarType -> Bool)
-> (ScalarType -> ScalarType -> Bool) -> Eq ScalarType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScalarType -> ScalarType -> Bool
== :: ScalarType -> ScalarType -> Bool
$c/= :: ScalarType -> ScalarType -> Bool
/= :: ScalarType -> ScalarType -> Bool
Eq, Eq ScalarType
Eq ScalarType
-> (ScalarType -> ScalarType -> Ordering)
-> (ScalarType -> ScalarType -> Bool)
-> (ScalarType -> ScalarType -> Bool)
-> (ScalarType -> ScalarType -> Bool)
-> (ScalarType -> ScalarType -> Bool)
-> (ScalarType -> ScalarType -> ScalarType)
-> (ScalarType -> ScalarType -> ScalarType)
-> Ord ScalarType
ScalarType -> ScalarType -> Bool
ScalarType -> ScalarType -> Ordering
ScalarType -> ScalarType -> ScalarType
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 :: ScalarType -> ScalarType -> Ordering
compare :: ScalarType -> ScalarType -> Ordering
$c< :: ScalarType -> ScalarType -> Bool
< :: ScalarType -> ScalarType -> Bool
$c<= :: ScalarType -> ScalarType -> Bool
<= :: ScalarType -> ScalarType -> Bool
$c> :: ScalarType -> ScalarType -> Bool
> :: ScalarType -> ScalarType -> Bool
$c>= :: ScalarType -> ScalarType -> Bool
>= :: ScalarType -> ScalarType -> Bool
$cmax :: ScalarType -> ScalarType -> ScalarType
max :: ScalarType -> ScalarType -> ScalarType
$cmin :: ScalarType -> ScalarType -> ScalarType
min :: ScalarType -> ScalarType -> ScalarType
Ord, ScalarType
ScalarType -> ScalarType -> Bounded ScalarType
forall a. a -> a -> Bounded a
$cminBound :: ScalarType
minBound :: ScalarType
$cmaxBound :: ScalarType
maxBound :: ScalarType
Bounded, Int -> ScalarType
ScalarType -> Int
ScalarType -> [ScalarType]
ScalarType -> ScalarType
ScalarType -> ScalarType -> [ScalarType]
ScalarType -> ScalarType -> ScalarType -> [ScalarType]
(ScalarType -> ScalarType)
-> (ScalarType -> ScalarType)
-> (Int -> ScalarType)
-> (ScalarType -> Int)
-> (ScalarType -> [ScalarType])
-> (ScalarType -> ScalarType -> [ScalarType])
-> (ScalarType -> ScalarType -> [ScalarType])
-> (ScalarType -> ScalarType -> ScalarType -> [ScalarType])
-> Enum ScalarType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ScalarType -> ScalarType
succ :: ScalarType -> ScalarType
$cpred :: ScalarType -> ScalarType
pred :: ScalarType -> ScalarType
$ctoEnum :: Int -> ScalarType
toEnum :: Int -> ScalarType
$cfromEnum :: ScalarType -> Int
fromEnum :: ScalarType -> Int
$cenumFrom :: ScalarType -> [ScalarType]
enumFrom :: ScalarType -> [ScalarType]
$cenumFromThen :: ScalarType -> ScalarType -> [ScalarType]
enumFromThen :: ScalarType -> ScalarType -> [ScalarType]
$cenumFromTo :: ScalarType -> ScalarType -> [ScalarType]
enumFromTo :: ScalarType -> ScalarType -> [ScalarType]
$cenumFromThenTo :: ScalarType -> ScalarType -> ScalarType -> [ScalarType]
enumFromThenTo :: ScalarType -> ScalarType -> ScalarType -> [ScalarType]
Enum, (forall x. ScalarType -> Rep ScalarType x)
-> (forall x. Rep ScalarType x -> ScalarType) -> Generic ScalarType
forall x. Rep ScalarType x -> ScalarType
forall x. ScalarType -> Rep ScalarType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ScalarType -> Rep ScalarType x
from :: forall x. ScalarType -> Rep ScalarType x
$cto :: forall x. Rep ScalarType x -> ScalarType
to :: forall x. Rep ScalarType x -> ScalarType
Generic, Typeable ScalarType
Typeable ScalarType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ScalarType -> c ScalarType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ScalarType)
-> (ScalarType -> Constr)
-> (ScalarType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ScalarType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ScalarType))
-> ((forall b. Data b => b -> b) -> ScalarType -> ScalarType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ScalarType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ScalarType -> r)
-> (forall u. (forall d. Data d => d -> u) -> ScalarType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ScalarType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ScalarType -> m ScalarType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ScalarType -> m ScalarType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ScalarType -> m ScalarType)
-> Data ScalarType
ScalarType -> Constr
ScalarType -> DataType
(forall b. Data b => b -> b) -> ScalarType -> ScalarType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ScalarType -> u
forall u. (forall d. Data d => d -> u) -> ScalarType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ScalarType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ScalarType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ScalarType -> m ScalarType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ScalarType -> m ScalarType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ScalarType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ScalarType -> c ScalarType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ScalarType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ScalarType)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ScalarType -> c ScalarType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ScalarType -> c ScalarType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ScalarType
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ScalarType
$ctoConstr :: ScalarType -> Constr
toConstr :: ScalarType -> Constr
$cdataTypeOf :: ScalarType -> DataType
dataTypeOf :: ScalarType -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ScalarType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ScalarType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ScalarType)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ScalarType)
$cgmapT :: (forall b. Data b => b -> b) -> ScalarType -> ScalarType
gmapT :: (forall b. Data b => b -> b) -> ScalarType -> ScalarType
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ScalarType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ScalarType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ScalarType -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ScalarType -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ScalarType -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ScalarType -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ScalarType -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ScalarType -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ScalarType -> m ScalarType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ScalarType -> m ScalarType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ScalarType -> m ScalarType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ScalarType -> m ScalarType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ScalarType -> m ScalarType
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ScalarType -> m ScalarType
Data, (forall (m :: * -> *). Quote m => ScalarType -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    ScalarType -> Code m ScalarType)
-> Lift ScalarType
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => ScalarType -> m Exp
forall (m :: * -> *). Quote m => ScalarType -> Code m ScalarType
$clift :: forall (m :: * -> *). Quote m => ScalarType -> m Exp
lift :: forall (m :: * -> *). Quote m => ScalarType -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => ScalarType -> Code m ScalarType
liftTyped :: forall (m :: * -> *). Quote m => ScalarType -> Code m ScalarType
Lift)
  deriving anyclass (Eq ScalarType
Eq ScalarType
-> (Int -> ScalarType -> Int)
-> (ScalarType -> Int)
-> Hashable ScalarType
Int -> ScalarType -> Int
ScalarType -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> ScalarType -> Int
hashWithSalt :: Int -> ScalarType -> Int
$chash :: ScalarType -> Int
hash :: ScalarType -> Int
Hashable, ScalarType -> ()
(ScalarType -> ()) -> NFData ScalarType
forall a. (a -> ()) -> NFData a
$crnf :: ScalarType -> ()
rnf :: ScalarType -> ()
NFData, ToJSONKeyFunction [ScalarType]
ToJSONKeyFunction ScalarType
ToJSONKeyFunction ScalarType
-> ToJSONKeyFunction [ScalarType] -> ToJSONKey ScalarType
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction ScalarType
toJSONKey :: ToJSONKeyFunction ScalarType
$ctoJSONKeyList :: ToJSONKeyFunction [ScalarType]
toJSONKeyList :: ToJSONKeyFunction [ScalarType]
ToJSONKey)

-- I do not know how to make Autodocodec case-insensitive or strip out the
-- length stuff, so here we are
instance HasCodec ScalarType where
  codec :: JSONCodec ScalarType
codec =
    Text -> JSONCodec ScalarType -> JSONCodec ScalarType
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
AC.CommentCodec
      (Text
"A scalar type for BigQuery")
      (JSONCodec ScalarType -> JSONCodec ScalarType)
-> JSONCodec ScalarType -> JSONCodec ScalarType
forall a b. (a -> b) -> a -> b
$ JSONCodec ScalarType
forall a. (FromJSON a, ToJSON a) => JSONCodec a
placeholderCodecViaJSON

-- https://hasura.io/docs/latest/schema/bigquery/bigquery-types/
instance FromJSON ScalarType where
  parseJSON :: Value -> Parser ScalarType
parseJSON (J.String Text
s) = Text -> Parser ScalarType
parseScalarType (Text -> Text
T.toLower Text
s)
    where
      parseScalarType :: Text -> Parser ScalarType
parseScalarType = \case
        Text
"string" -> ScalarType -> Parser ScalarType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScalarType
StringScalarType
        Text
"bytes" -> ScalarType -> Parser ScalarType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScalarType
BytesScalarType
        Text
"integer" -> ScalarType -> Parser ScalarType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScalarType
IntegerScalarType
        Text
"int64" -> ScalarType -> Parser ScalarType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScalarType
IntegerScalarType
        Text
"float" -> ScalarType -> Parser ScalarType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScalarType
FloatScalarType
        Text
"float64" -> ScalarType -> Parser ScalarType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScalarType
FloatScalarType
        Text
"bool" -> ScalarType -> Parser ScalarType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScalarType
BoolScalarType
        Text
"timestamp" -> ScalarType -> Parser ScalarType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScalarType
TimestampScalarType
        Text
"date" -> ScalarType -> Parser ScalarType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScalarType
DateScalarType
        Text
"time" -> ScalarType -> Parser ScalarType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScalarType
TimeScalarType
        Text
"datetime" -> ScalarType -> Parser ScalarType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScalarType
DatetimeScalarType
        Text
"geography" -> ScalarType -> Parser ScalarType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScalarType
GeographyScalarType
        Text
"decimal" -> ScalarType -> Parser ScalarType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScalarType
DecimalScalarType
        Text
"numeric" -> ScalarType -> Parser ScalarType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScalarType
DecimalScalarType
        Text
"bigdecimal" -> ScalarType -> Parser ScalarType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScalarType
BigDecimalScalarType
        Text
"bignumeric" -> ScalarType -> Parser ScalarType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScalarType
BigDecimalScalarType
        Text
"json" -> ScalarType -> Parser ScalarType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScalarType
JsonScalarType
        Text
"struct" -> ScalarType -> Parser ScalarType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScalarType
StructScalarType
        Text
t ->
          -- if the type is something like `varchar(127)`, try stripping off the data length
          if Text -> Text -> Bool
T.isInfixOf Text
"(" Text
t
            then Text -> Parser ScalarType
parseScalarType ((Char -> Bool) -> Text -> Text
T.takeWhile (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'(') Text
t)
            else String -> Parser ScalarType
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ScalarType) -> String -> Parser ScalarType
forall a b. (a -> b) -> a -> b
$ String
"Did not recognize scalar type '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
t String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"'"
  parseJSON Value
_ = String -> Parser ScalarType
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected a string"

instance ToJSON ScalarType where
  toJSON :: ScalarType -> Value
toJSON = \case
    ScalarType
StringScalarType -> Value
"STRING"
    ScalarType
BytesScalarType -> Value
"BYTES"
    ScalarType
IntegerScalarType -> Value
"INT64"
    ScalarType
FloatScalarType -> Value
"FLOAT64"
    ScalarType
BoolScalarType -> Value
"BOOL"
    ScalarType
TimestampScalarType -> Value
"TIMESTAMP"
    ScalarType
DateScalarType -> Value
"DATE"
    ScalarType
TimeScalarType -> Value
"TIME"
    ScalarType
DatetimeScalarType -> Value
"DATETIME"
    ScalarType
GeographyScalarType -> Value
"GEOGRAPHY"
    ScalarType
DecimalScalarType -> Value
"DECIMAL"
    ScalarType
BigDecimalScalarType -> Value
"BIGDECIMAL"
    ScalarType
JsonScalarType -> Value
"JSON"
    ScalarType
StructScalarType -> Value
"STRUCT"

instance ToTxt ScalarType where toTxt :: ScalarType -> Text
toTxt = ScalarType -> Text
forall a. Show a => a -> Text
tshow

instance ToErrorValue ScalarType where
  toErrorValue :: ScalarType -> ErrorMessage
toErrorValue = Text -> ErrorMessage
ErrorValue.squote (Text -> ErrorMessage)
-> (ScalarType -> Text) -> ScalarType -> ErrorMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScalarType -> Text
forall a. Show a => a -> Text
tshow

--------------------------------------------------------------------------------
-- Unified table metadata

data UnifiedMetadata = UnifiedMetadata
  { UnifiedMetadata -> [UnifiedTableMetadata]
tables :: [UnifiedTableMetadata]
  }
  deriving (UnifiedMetadata -> UnifiedMetadata -> Bool
(UnifiedMetadata -> UnifiedMetadata -> Bool)
-> (UnifiedMetadata -> UnifiedMetadata -> Bool)
-> Eq UnifiedMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnifiedMetadata -> UnifiedMetadata -> Bool
== :: UnifiedMetadata -> UnifiedMetadata -> Bool
$c/= :: UnifiedMetadata -> UnifiedMetadata -> Bool
/= :: UnifiedMetadata -> UnifiedMetadata -> Bool
Eq, Eq UnifiedMetadata
Eq UnifiedMetadata
-> (UnifiedMetadata -> UnifiedMetadata -> Ordering)
-> (UnifiedMetadata -> UnifiedMetadata -> Bool)
-> (UnifiedMetadata -> UnifiedMetadata -> Bool)
-> (UnifiedMetadata -> UnifiedMetadata -> Bool)
-> (UnifiedMetadata -> UnifiedMetadata -> Bool)
-> (UnifiedMetadata -> UnifiedMetadata -> UnifiedMetadata)
-> (UnifiedMetadata -> UnifiedMetadata -> UnifiedMetadata)
-> Ord UnifiedMetadata
UnifiedMetadata -> UnifiedMetadata -> Bool
UnifiedMetadata -> UnifiedMetadata -> Ordering
UnifiedMetadata -> UnifiedMetadata -> UnifiedMetadata
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 :: UnifiedMetadata -> UnifiedMetadata -> Ordering
compare :: UnifiedMetadata -> UnifiedMetadata -> Ordering
$c< :: UnifiedMetadata -> UnifiedMetadata -> Bool
< :: UnifiedMetadata -> UnifiedMetadata -> Bool
$c<= :: UnifiedMetadata -> UnifiedMetadata -> Bool
<= :: UnifiedMetadata -> UnifiedMetadata -> Bool
$c> :: UnifiedMetadata -> UnifiedMetadata -> Bool
> :: UnifiedMetadata -> UnifiedMetadata -> Bool
$c>= :: UnifiedMetadata -> UnifiedMetadata -> Bool
>= :: UnifiedMetadata -> UnifiedMetadata -> Bool
$cmax :: UnifiedMetadata -> UnifiedMetadata -> UnifiedMetadata
max :: UnifiedMetadata -> UnifiedMetadata -> UnifiedMetadata
$cmin :: UnifiedMetadata -> UnifiedMetadata -> UnifiedMetadata
min :: UnifiedMetadata -> UnifiedMetadata -> UnifiedMetadata
Ord, Int -> UnifiedMetadata -> ShowS
[UnifiedMetadata] -> ShowS
UnifiedMetadata -> String
(Int -> UnifiedMetadata -> ShowS)
-> (UnifiedMetadata -> String)
-> ([UnifiedMetadata] -> ShowS)
-> Show UnifiedMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnifiedMetadata -> ShowS
showsPrec :: Int -> UnifiedMetadata -> ShowS
$cshow :: UnifiedMetadata -> String
show :: UnifiedMetadata -> String
$cshowList :: [UnifiedMetadata] -> ShowS
showList :: [UnifiedMetadata] -> ShowS
Show)

data UnifiedTableMetadata = UnifiedTableMetadata
  { UnifiedTableMetadata -> UnifiedTableName
table :: UnifiedTableName,
    UnifiedTableMetadata -> [UnifiedObjectRelationship]
object_relationships :: [UnifiedObjectRelationship],
    UnifiedTableMetadata -> [UnifiedArrayRelationship]
array_relationships :: [UnifiedArrayRelationship],
    UnifiedTableMetadata -> [UnifiedColumn]
columns :: [UnifiedColumn]
  }
  deriving (UnifiedTableMetadata -> UnifiedTableMetadata -> Bool
(UnifiedTableMetadata -> UnifiedTableMetadata -> Bool)
-> (UnifiedTableMetadata -> UnifiedTableMetadata -> Bool)
-> Eq UnifiedTableMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnifiedTableMetadata -> UnifiedTableMetadata -> Bool
== :: UnifiedTableMetadata -> UnifiedTableMetadata -> Bool
$c/= :: UnifiedTableMetadata -> UnifiedTableMetadata -> Bool
/= :: UnifiedTableMetadata -> UnifiedTableMetadata -> Bool
Eq, Eq UnifiedTableMetadata
Eq UnifiedTableMetadata
-> (UnifiedTableMetadata -> UnifiedTableMetadata -> Ordering)
-> (UnifiedTableMetadata -> UnifiedTableMetadata -> Bool)
-> (UnifiedTableMetadata -> UnifiedTableMetadata -> Bool)
-> (UnifiedTableMetadata -> UnifiedTableMetadata -> Bool)
-> (UnifiedTableMetadata -> UnifiedTableMetadata -> Bool)
-> (UnifiedTableMetadata
    -> UnifiedTableMetadata -> UnifiedTableMetadata)
-> (UnifiedTableMetadata
    -> UnifiedTableMetadata -> UnifiedTableMetadata)
-> Ord UnifiedTableMetadata
UnifiedTableMetadata -> UnifiedTableMetadata -> Bool
UnifiedTableMetadata -> UnifiedTableMetadata -> Ordering
UnifiedTableMetadata
-> UnifiedTableMetadata -> UnifiedTableMetadata
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 :: UnifiedTableMetadata -> UnifiedTableMetadata -> Ordering
compare :: UnifiedTableMetadata -> UnifiedTableMetadata -> Ordering
$c< :: UnifiedTableMetadata -> UnifiedTableMetadata -> Bool
< :: UnifiedTableMetadata -> UnifiedTableMetadata -> Bool
$c<= :: UnifiedTableMetadata -> UnifiedTableMetadata -> Bool
<= :: UnifiedTableMetadata -> UnifiedTableMetadata -> Bool
$c> :: UnifiedTableMetadata -> UnifiedTableMetadata -> Bool
> :: UnifiedTableMetadata -> UnifiedTableMetadata -> Bool
$c>= :: UnifiedTableMetadata -> UnifiedTableMetadata -> Bool
>= :: UnifiedTableMetadata -> UnifiedTableMetadata -> Bool
$cmax :: UnifiedTableMetadata
-> UnifiedTableMetadata -> UnifiedTableMetadata
max :: UnifiedTableMetadata
-> UnifiedTableMetadata -> UnifiedTableMetadata
$cmin :: UnifiedTableMetadata
-> UnifiedTableMetadata -> UnifiedTableMetadata
min :: UnifiedTableMetadata
-> UnifiedTableMetadata -> UnifiedTableMetadata
Ord, Int -> UnifiedTableMetadata -> ShowS
[UnifiedTableMetadata] -> ShowS
UnifiedTableMetadata -> String
(Int -> UnifiedTableMetadata -> ShowS)
-> (UnifiedTableMetadata -> String)
-> ([UnifiedTableMetadata] -> ShowS)
-> Show UnifiedTableMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnifiedTableMetadata -> ShowS
showsPrec :: Int -> UnifiedTableMetadata -> ShowS
$cshow :: UnifiedTableMetadata -> String
show :: UnifiedTableMetadata -> String
$cshowList :: [UnifiedTableMetadata] -> ShowS
showList :: [UnifiedTableMetadata] -> ShowS
Show)

data UnifiedColumn = UnifiedColumn
  { UnifiedColumn -> Text
name :: Text,
    UnifiedColumn -> ScalarType
type' :: ScalarType
  }
  deriving (UnifiedColumn -> UnifiedColumn -> Bool
(UnifiedColumn -> UnifiedColumn -> Bool)
-> (UnifiedColumn -> UnifiedColumn -> Bool) -> Eq UnifiedColumn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnifiedColumn -> UnifiedColumn -> Bool
== :: UnifiedColumn -> UnifiedColumn -> Bool
$c/= :: UnifiedColumn -> UnifiedColumn -> Bool
/= :: UnifiedColumn -> UnifiedColumn -> Bool
Eq, Eq UnifiedColumn
Eq UnifiedColumn
-> (UnifiedColumn -> UnifiedColumn -> Ordering)
-> (UnifiedColumn -> UnifiedColumn -> Bool)
-> (UnifiedColumn -> UnifiedColumn -> Bool)
-> (UnifiedColumn -> UnifiedColumn -> Bool)
-> (UnifiedColumn -> UnifiedColumn -> Bool)
-> (UnifiedColumn -> UnifiedColumn -> UnifiedColumn)
-> (UnifiedColumn -> UnifiedColumn -> UnifiedColumn)
-> Ord UnifiedColumn
UnifiedColumn -> UnifiedColumn -> Bool
UnifiedColumn -> UnifiedColumn -> Ordering
UnifiedColumn -> UnifiedColumn -> UnifiedColumn
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 :: UnifiedColumn -> UnifiedColumn -> Ordering
compare :: UnifiedColumn -> UnifiedColumn -> Ordering
$c< :: UnifiedColumn -> UnifiedColumn -> Bool
< :: UnifiedColumn -> UnifiedColumn -> Bool
$c<= :: UnifiedColumn -> UnifiedColumn -> Bool
<= :: UnifiedColumn -> UnifiedColumn -> Bool
$c> :: UnifiedColumn -> UnifiedColumn -> Bool
> :: UnifiedColumn -> UnifiedColumn -> Bool
$c>= :: UnifiedColumn -> UnifiedColumn -> Bool
>= :: UnifiedColumn -> UnifiedColumn -> Bool
$cmax :: UnifiedColumn -> UnifiedColumn -> UnifiedColumn
max :: UnifiedColumn -> UnifiedColumn -> UnifiedColumn
$cmin :: UnifiedColumn -> UnifiedColumn -> UnifiedColumn
min :: UnifiedColumn -> UnifiedColumn -> UnifiedColumn
Ord, Int -> UnifiedColumn -> ShowS
[UnifiedColumn] -> ShowS
UnifiedColumn -> String
(Int -> UnifiedColumn -> ShowS)
-> (UnifiedColumn -> String)
-> ([UnifiedColumn] -> ShowS)
-> Show UnifiedColumn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnifiedColumn -> ShowS
showsPrec :: Int -> UnifiedColumn -> ShowS
$cshow :: UnifiedColumn -> String
show :: UnifiedColumn -> String
$cshowList :: [UnifiedColumn] -> ShowS
showList :: [UnifiedColumn] -> ShowS
Show)

data UnifiedTableName = UnifiedTableName
  { UnifiedTableName -> Text
schema :: Text,
    UnifiedTableName -> Text
name :: Text
  }
  deriving (UnifiedTableName -> UnifiedTableName -> Bool
(UnifiedTableName -> UnifiedTableName -> Bool)
-> (UnifiedTableName -> UnifiedTableName -> Bool)
-> Eq UnifiedTableName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnifiedTableName -> UnifiedTableName -> Bool
== :: UnifiedTableName -> UnifiedTableName -> Bool
$c/= :: UnifiedTableName -> UnifiedTableName -> Bool
/= :: UnifiedTableName -> UnifiedTableName -> Bool
Eq, Eq UnifiedTableName
Eq UnifiedTableName
-> (UnifiedTableName -> UnifiedTableName -> Ordering)
-> (UnifiedTableName -> UnifiedTableName -> Bool)
-> (UnifiedTableName -> UnifiedTableName -> Bool)
-> (UnifiedTableName -> UnifiedTableName -> Bool)
-> (UnifiedTableName -> UnifiedTableName -> Bool)
-> (UnifiedTableName -> UnifiedTableName -> UnifiedTableName)
-> (UnifiedTableName -> UnifiedTableName -> UnifiedTableName)
-> Ord UnifiedTableName
UnifiedTableName -> UnifiedTableName -> Bool
UnifiedTableName -> UnifiedTableName -> Ordering
UnifiedTableName -> UnifiedTableName -> UnifiedTableName
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 :: UnifiedTableName -> UnifiedTableName -> Ordering
compare :: UnifiedTableName -> UnifiedTableName -> Ordering
$c< :: UnifiedTableName -> UnifiedTableName -> Bool
< :: UnifiedTableName -> UnifiedTableName -> Bool
$c<= :: UnifiedTableName -> UnifiedTableName -> Bool
<= :: UnifiedTableName -> UnifiedTableName -> Bool
$c> :: UnifiedTableName -> UnifiedTableName -> Bool
> :: UnifiedTableName -> UnifiedTableName -> Bool
$c>= :: UnifiedTableName -> UnifiedTableName -> Bool
>= :: UnifiedTableName -> UnifiedTableName -> Bool
$cmax :: UnifiedTableName -> UnifiedTableName -> UnifiedTableName
max :: UnifiedTableName -> UnifiedTableName -> UnifiedTableName
$cmin :: UnifiedTableName -> UnifiedTableName -> UnifiedTableName
min :: UnifiedTableName -> UnifiedTableName -> UnifiedTableName
Ord, Int -> UnifiedTableName -> ShowS
[UnifiedTableName] -> ShowS
UnifiedTableName -> String
(Int -> UnifiedTableName -> ShowS)
-> (UnifiedTableName -> String)
-> ([UnifiedTableName] -> ShowS)
-> Show UnifiedTableName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnifiedTableName -> ShowS
showsPrec :: Int -> UnifiedTableName -> ShowS
$cshow :: UnifiedTableName -> String
show :: UnifiedTableName -> String
$cshowList :: [UnifiedTableName] -> ShowS
showList :: [UnifiedTableName] -> ShowS
Show)

data UnifiedObjectRelationship = UnifiedObjectRelationship
  { UnifiedObjectRelationship -> UnifiedUsing
using :: UnifiedUsing,
    UnifiedObjectRelationship -> Text
name :: Text
  }
  deriving (UnifiedObjectRelationship -> UnifiedObjectRelationship -> Bool
(UnifiedObjectRelationship -> UnifiedObjectRelationship -> Bool)
-> (UnifiedObjectRelationship -> UnifiedObjectRelationship -> Bool)
-> Eq UnifiedObjectRelationship
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnifiedObjectRelationship -> UnifiedObjectRelationship -> Bool
== :: UnifiedObjectRelationship -> UnifiedObjectRelationship -> Bool
$c/= :: UnifiedObjectRelationship -> UnifiedObjectRelationship -> Bool
/= :: UnifiedObjectRelationship -> UnifiedObjectRelationship -> Bool
Eq, Eq UnifiedObjectRelationship
Eq UnifiedObjectRelationship
-> (UnifiedObjectRelationship
    -> UnifiedObjectRelationship -> Ordering)
-> (UnifiedObjectRelationship -> UnifiedObjectRelationship -> Bool)
-> (UnifiedObjectRelationship -> UnifiedObjectRelationship -> Bool)
-> (UnifiedObjectRelationship -> UnifiedObjectRelationship -> Bool)
-> (UnifiedObjectRelationship -> UnifiedObjectRelationship -> Bool)
-> (UnifiedObjectRelationship
    -> UnifiedObjectRelationship -> UnifiedObjectRelationship)
-> (UnifiedObjectRelationship
    -> UnifiedObjectRelationship -> UnifiedObjectRelationship)
-> Ord UnifiedObjectRelationship
UnifiedObjectRelationship -> UnifiedObjectRelationship -> Bool
UnifiedObjectRelationship -> UnifiedObjectRelationship -> Ordering
UnifiedObjectRelationship
-> UnifiedObjectRelationship -> UnifiedObjectRelationship
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 :: UnifiedObjectRelationship -> UnifiedObjectRelationship -> Ordering
compare :: UnifiedObjectRelationship -> UnifiedObjectRelationship -> Ordering
$c< :: UnifiedObjectRelationship -> UnifiedObjectRelationship -> Bool
< :: UnifiedObjectRelationship -> UnifiedObjectRelationship -> Bool
$c<= :: UnifiedObjectRelationship -> UnifiedObjectRelationship -> Bool
<= :: UnifiedObjectRelationship -> UnifiedObjectRelationship -> Bool
$c> :: UnifiedObjectRelationship -> UnifiedObjectRelationship -> Bool
> :: UnifiedObjectRelationship -> UnifiedObjectRelationship -> Bool
$c>= :: UnifiedObjectRelationship -> UnifiedObjectRelationship -> Bool
>= :: UnifiedObjectRelationship -> UnifiedObjectRelationship -> Bool
$cmax :: UnifiedObjectRelationship
-> UnifiedObjectRelationship -> UnifiedObjectRelationship
max :: UnifiedObjectRelationship
-> UnifiedObjectRelationship -> UnifiedObjectRelationship
$cmin :: UnifiedObjectRelationship
-> UnifiedObjectRelationship -> UnifiedObjectRelationship
min :: UnifiedObjectRelationship
-> UnifiedObjectRelationship -> UnifiedObjectRelationship
Ord, Int -> UnifiedObjectRelationship -> ShowS
[UnifiedObjectRelationship] -> ShowS
UnifiedObjectRelationship -> String
(Int -> UnifiedObjectRelationship -> ShowS)
-> (UnifiedObjectRelationship -> String)
-> ([UnifiedObjectRelationship] -> ShowS)
-> Show UnifiedObjectRelationship
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnifiedObjectRelationship -> ShowS
showsPrec :: Int -> UnifiedObjectRelationship -> ShowS
$cshow :: UnifiedObjectRelationship -> String
show :: UnifiedObjectRelationship -> String
$cshowList :: [UnifiedObjectRelationship] -> ShowS
showList :: [UnifiedObjectRelationship] -> ShowS
Show)

data UnifiedArrayRelationship = UnifiedArrayRelationship
  { UnifiedArrayRelationship -> UnifiedUsing
using :: UnifiedUsing,
    UnifiedArrayRelationship -> Text
name :: Text
  }
  deriving (UnifiedArrayRelationship -> UnifiedArrayRelationship -> Bool
(UnifiedArrayRelationship -> UnifiedArrayRelationship -> Bool)
-> (UnifiedArrayRelationship -> UnifiedArrayRelationship -> Bool)
-> Eq UnifiedArrayRelationship
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnifiedArrayRelationship -> UnifiedArrayRelationship -> Bool
== :: UnifiedArrayRelationship -> UnifiedArrayRelationship -> Bool
$c/= :: UnifiedArrayRelationship -> UnifiedArrayRelationship -> Bool
/= :: UnifiedArrayRelationship -> UnifiedArrayRelationship -> Bool
Eq, Eq UnifiedArrayRelationship
Eq UnifiedArrayRelationship
-> (UnifiedArrayRelationship
    -> UnifiedArrayRelationship -> Ordering)
-> (UnifiedArrayRelationship -> UnifiedArrayRelationship -> Bool)
-> (UnifiedArrayRelationship -> UnifiedArrayRelationship -> Bool)
-> (UnifiedArrayRelationship -> UnifiedArrayRelationship -> Bool)
-> (UnifiedArrayRelationship -> UnifiedArrayRelationship -> Bool)
-> (UnifiedArrayRelationship
    -> UnifiedArrayRelationship -> UnifiedArrayRelationship)
-> (UnifiedArrayRelationship
    -> UnifiedArrayRelationship -> UnifiedArrayRelationship)
-> Ord UnifiedArrayRelationship
UnifiedArrayRelationship -> UnifiedArrayRelationship -> Bool
UnifiedArrayRelationship -> UnifiedArrayRelationship -> Ordering
UnifiedArrayRelationship
-> UnifiedArrayRelationship -> UnifiedArrayRelationship
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 :: UnifiedArrayRelationship -> UnifiedArrayRelationship -> Ordering
compare :: UnifiedArrayRelationship -> UnifiedArrayRelationship -> Ordering
$c< :: UnifiedArrayRelationship -> UnifiedArrayRelationship -> Bool
< :: UnifiedArrayRelationship -> UnifiedArrayRelationship -> Bool
$c<= :: UnifiedArrayRelationship -> UnifiedArrayRelationship -> Bool
<= :: UnifiedArrayRelationship -> UnifiedArrayRelationship -> Bool
$c> :: UnifiedArrayRelationship -> UnifiedArrayRelationship -> Bool
> :: UnifiedArrayRelationship -> UnifiedArrayRelationship -> Bool
$c>= :: UnifiedArrayRelationship -> UnifiedArrayRelationship -> Bool
>= :: UnifiedArrayRelationship -> UnifiedArrayRelationship -> Bool
$cmax :: UnifiedArrayRelationship
-> UnifiedArrayRelationship -> UnifiedArrayRelationship
max :: UnifiedArrayRelationship
-> UnifiedArrayRelationship -> UnifiedArrayRelationship
$cmin :: UnifiedArrayRelationship
-> UnifiedArrayRelationship -> UnifiedArrayRelationship
min :: UnifiedArrayRelationship
-> UnifiedArrayRelationship -> UnifiedArrayRelationship
Ord, Int -> UnifiedArrayRelationship -> ShowS
[UnifiedArrayRelationship] -> ShowS
UnifiedArrayRelationship -> String
(Int -> UnifiedArrayRelationship -> ShowS)
-> (UnifiedArrayRelationship -> String)
-> ([UnifiedArrayRelationship] -> ShowS)
-> Show UnifiedArrayRelationship
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnifiedArrayRelationship -> ShowS
showsPrec :: Int -> UnifiedArrayRelationship -> ShowS
$cshow :: UnifiedArrayRelationship -> String
show :: UnifiedArrayRelationship -> String
$cshowList :: [UnifiedArrayRelationship] -> ShowS
showList :: [UnifiedArrayRelationship] -> ShowS
Show)

data UnifiedUsing = UnifiedUsing
  { UnifiedUsing -> UnifiedOn
foreign_key_constraint_on :: UnifiedOn
  }
  deriving (UnifiedUsing -> UnifiedUsing -> Bool
(UnifiedUsing -> UnifiedUsing -> Bool)
-> (UnifiedUsing -> UnifiedUsing -> Bool) -> Eq UnifiedUsing
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnifiedUsing -> UnifiedUsing -> Bool
== :: UnifiedUsing -> UnifiedUsing -> Bool
$c/= :: UnifiedUsing -> UnifiedUsing -> Bool
/= :: UnifiedUsing -> UnifiedUsing -> Bool
Eq, Eq UnifiedUsing
Eq UnifiedUsing
-> (UnifiedUsing -> UnifiedUsing -> Ordering)
-> (UnifiedUsing -> UnifiedUsing -> Bool)
-> (UnifiedUsing -> UnifiedUsing -> Bool)
-> (UnifiedUsing -> UnifiedUsing -> Bool)
-> (UnifiedUsing -> UnifiedUsing -> Bool)
-> (UnifiedUsing -> UnifiedUsing -> UnifiedUsing)
-> (UnifiedUsing -> UnifiedUsing -> UnifiedUsing)
-> Ord UnifiedUsing
UnifiedUsing -> UnifiedUsing -> Bool
UnifiedUsing -> UnifiedUsing -> Ordering
UnifiedUsing -> UnifiedUsing -> UnifiedUsing
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 :: UnifiedUsing -> UnifiedUsing -> Ordering
compare :: UnifiedUsing -> UnifiedUsing -> Ordering
$c< :: UnifiedUsing -> UnifiedUsing -> Bool
< :: UnifiedUsing -> UnifiedUsing -> Bool
$c<= :: UnifiedUsing -> UnifiedUsing -> Bool
<= :: UnifiedUsing -> UnifiedUsing -> Bool
$c> :: UnifiedUsing -> UnifiedUsing -> Bool
> :: UnifiedUsing -> UnifiedUsing -> Bool
$c>= :: UnifiedUsing -> UnifiedUsing -> Bool
>= :: UnifiedUsing -> UnifiedUsing -> Bool
$cmax :: UnifiedUsing -> UnifiedUsing -> UnifiedUsing
max :: UnifiedUsing -> UnifiedUsing -> UnifiedUsing
$cmin :: UnifiedUsing -> UnifiedUsing -> UnifiedUsing
min :: UnifiedUsing -> UnifiedUsing -> UnifiedUsing
Ord, Int -> UnifiedUsing -> ShowS
[UnifiedUsing] -> ShowS
UnifiedUsing -> String
(Int -> UnifiedUsing -> ShowS)
-> (UnifiedUsing -> String)
-> ([UnifiedUsing] -> ShowS)
-> Show UnifiedUsing
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnifiedUsing -> ShowS
showsPrec :: Int -> UnifiedUsing -> ShowS
$cshow :: UnifiedUsing -> String
show :: UnifiedUsing -> String
$cshowList :: [UnifiedUsing] -> ShowS
showList :: [UnifiedUsing] -> ShowS
Show)

data UnifiedOn = UnifiedOn
  { UnifiedOn -> UnifiedTableName
table :: UnifiedTableName,
    UnifiedOn -> Text
column :: Text
  }
  deriving (UnifiedOn -> UnifiedOn -> Bool
(UnifiedOn -> UnifiedOn -> Bool)
-> (UnifiedOn -> UnifiedOn -> Bool) -> Eq UnifiedOn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnifiedOn -> UnifiedOn -> Bool
== :: UnifiedOn -> UnifiedOn -> Bool
$c/= :: UnifiedOn -> UnifiedOn -> Bool
/= :: UnifiedOn -> UnifiedOn -> Bool
Eq, Eq UnifiedOn
Eq UnifiedOn
-> (UnifiedOn -> UnifiedOn -> Ordering)
-> (UnifiedOn -> UnifiedOn -> Bool)
-> (UnifiedOn -> UnifiedOn -> Bool)
-> (UnifiedOn -> UnifiedOn -> Bool)
-> (UnifiedOn -> UnifiedOn -> Bool)
-> (UnifiedOn -> UnifiedOn -> UnifiedOn)
-> (UnifiedOn -> UnifiedOn -> UnifiedOn)
-> Ord UnifiedOn
UnifiedOn -> UnifiedOn -> Bool
UnifiedOn -> UnifiedOn -> Ordering
UnifiedOn -> UnifiedOn -> UnifiedOn
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 :: UnifiedOn -> UnifiedOn -> Ordering
compare :: UnifiedOn -> UnifiedOn -> Ordering
$c< :: UnifiedOn -> UnifiedOn -> Bool
< :: UnifiedOn -> UnifiedOn -> Bool
$c<= :: UnifiedOn -> UnifiedOn -> Bool
<= :: UnifiedOn -> UnifiedOn -> Bool
$c> :: UnifiedOn -> UnifiedOn -> Bool
> :: UnifiedOn -> UnifiedOn -> Bool
$c>= :: UnifiedOn -> UnifiedOn -> Bool
>= :: UnifiedOn -> UnifiedOn -> Bool
$cmax :: UnifiedOn -> UnifiedOn -> UnifiedOn
max :: UnifiedOn -> UnifiedOn -> UnifiedOn
$cmin :: UnifiedOn -> UnifiedOn -> UnifiedOn
min :: UnifiedOn -> UnifiedOn -> UnifiedOn
Ord, Int -> UnifiedOn -> ShowS
[UnifiedOn] -> ShowS
UnifiedOn -> String
(Int -> UnifiedOn -> ShowS)
-> (UnifiedOn -> String)
-> ([UnifiedOn] -> ShowS)
-> Show UnifiedOn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnifiedOn -> ShowS
showsPrec :: Int -> UnifiedOn -> ShowS
$cshow :: UnifiedOn -> String
show :: UnifiedOn -> String
$cshowList :: [UnifiedOn] -> ShowS
showList :: [UnifiedOn] -> ShowS
Show)

data BooleanOperators a
  = ASTContains a
  | ASTEquals a
  | ASTTouches a
  | ASTWithin a
  | ASTIntersects a
  | ASTDWithin (DWithinGeogOp a)
  deriving stock (BooleanOperators a -> BooleanOperators a -> Bool
(BooleanOperators a -> BooleanOperators a -> Bool)
-> (BooleanOperators a -> BooleanOperators a -> Bool)
-> Eq (BooleanOperators a)
forall a. Eq a => BooleanOperators a -> BooleanOperators a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => BooleanOperators a -> BooleanOperators a -> Bool
== :: BooleanOperators a -> BooleanOperators a -> Bool
$c/= :: forall a. Eq a => BooleanOperators a -> BooleanOperators a -> Bool
/= :: BooleanOperators a -> BooleanOperators a -> Bool
Eq, (forall x. BooleanOperators a -> Rep (BooleanOperators a) x)
-> (forall x. Rep (BooleanOperators a) x -> BooleanOperators a)
-> Generic (BooleanOperators a)
forall x. Rep (BooleanOperators a) x -> BooleanOperators a
forall x. BooleanOperators a -> Rep (BooleanOperators a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (BooleanOperators a) x -> BooleanOperators a
forall a x. BooleanOperators a -> Rep (BooleanOperators a) x
$cfrom :: forall a x. BooleanOperators a -> Rep (BooleanOperators a) x
from :: forall x. BooleanOperators a -> Rep (BooleanOperators a) x
$cto :: forall a x. Rep (BooleanOperators a) x -> BooleanOperators a
to :: forall x. Rep (BooleanOperators a) x -> BooleanOperators a
Generic, (forall m. Monoid m => BooleanOperators m -> m)
-> (forall m a. Monoid m => (a -> m) -> BooleanOperators a -> m)
-> (forall m a. Monoid m => (a -> m) -> BooleanOperators a -> m)
-> (forall a b. (a -> b -> b) -> b -> BooleanOperators a -> b)
-> (forall a b. (a -> b -> b) -> b -> BooleanOperators a -> b)
-> (forall b a. (b -> a -> b) -> b -> BooleanOperators a -> b)
-> (forall b a. (b -> a -> b) -> b -> BooleanOperators a -> b)
-> (forall a. (a -> a -> a) -> BooleanOperators a -> a)
-> (forall a. (a -> a -> a) -> BooleanOperators a -> a)
-> (forall a. BooleanOperators a -> [a])
-> (forall a. BooleanOperators a -> Bool)
-> (forall a. BooleanOperators a -> Int)
-> (forall a. Eq a => a -> BooleanOperators a -> Bool)
-> (forall a. Ord a => BooleanOperators a -> a)
-> (forall a. Ord a => BooleanOperators a -> a)
-> (forall a. Num a => BooleanOperators a -> a)
-> (forall a. Num a => BooleanOperators a -> a)
-> Foldable BooleanOperators
forall a. Eq a => a -> BooleanOperators a -> Bool
forall a. Num a => BooleanOperators a -> a
forall a. Ord a => BooleanOperators a -> a
forall m. Monoid m => BooleanOperators m -> m
forall a. BooleanOperators a -> Bool
forall a. BooleanOperators a -> Int
forall a. BooleanOperators a -> [a]
forall a. (a -> a -> a) -> BooleanOperators a -> a
forall m a. Monoid m => (a -> m) -> BooleanOperators a -> m
forall b a. (b -> a -> b) -> b -> BooleanOperators a -> b
forall a b. (a -> b -> b) -> b -> BooleanOperators a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => BooleanOperators m -> m
fold :: forall m. Monoid m => BooleanOperators m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> BooleanOperators a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> BooleanOperators a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> BooleanOperators a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> BooleanOperators a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> BooleanOperators a -> b
foldr :: forall a b. (a -> b -> b) -> b -> BooleanOperators a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> BooleanOperators a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> BooleanOperators a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> BooleanOperators a -> b
foldl :: forall b a. (b -> a -> b) -> b -> BooleanOperators a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> BooleanOperators a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> BooleanOperators a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> BooleanOperators a -> a
foldr1 :: forall a. (a -> a -> a) -> BooleanOperators a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> BooleanOperators a -> a
foldl1 :: forall a. (a -> a -> a) -> BooleanOperators a -> a
$ctoList :: forall a. BooleanOperators a -> [a]
toList :: forall a. BooleanOperators a -> [a]
$cnull :: forall a. BooleanOperators a -> Bool
null :: forall a. BooleanOperators a -> Bool
$clength :: forall a. BooleanOperators a -> Int
length :: forall a. BooleanOperators a -> Int
$celem :: forall a. Eq a => a -> BooleanOperators a -> Bool
elem :: forall a. Eq a => a -> BooleanOperators a -> Bool
$cmaximum :: forall a. Ord a => BooleanOperators a -> a
maximum :: forall a. Ord a => BooleanOperators a -> a
$cminimum :: forall a. Ord a => BooleanOperators a -> a
minimum :: forall a. Ord a => BooleanOperators a -> a
$csum :: forall a. Num a => BooleanOperators a -> a
sum :: forall a. Num a => BooleanOperators a -> a
$cproduct :: forall a. Num a => BooleanOperators a -> a
product :: forall a. Num a => BooleanOperators a -> a
Foldable, (forall a b. (a -> b) -> BooleanOperators a -> BooleanOperators b)
-> (forall a b. a -> BooleanOperators b -> BooleanOperators a)
-> Functor BooleanOperators
forall a b. a -> BooleanOperators b -> BooleanOperators a
forall a b. (a -> b) -> BooleanOperators a -> BooleanOperators 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) -> BooleanOperators a -> BooleanOperators b
fmap :: forall a b. (a -> b) -> BooleanOperators a -> BooleanOperators b
$c<$ :: forall a b. a -> BooleanOperators b -> BooleanOperators a
<$ :: forall a b. a -> BooleanOperators b -> BooleanOperators a
Functor, Functor BooleanOperators
Foldable BooleanOperators
Functor BooleanOperators
-> Foldable BooleanOperators
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> BooleanOperators a -> f (BooleanOperators b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    BooleanOperators (f a) -> f (BooleanOperators a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> BooleanOperators a -> m (BooleanOperators b))
-> (forall (m :: * -> *) a.
    Monad m =>
    BooleanOperators (m a) -> m (BooleanOperators a))
-> Traversable BooleanOperators
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
BooleanOperators (m a) -> m (BooleanOperators a)
forall (f :: * -> *) a.
Applicative f =>
BooleanOperators (f a) -> f (BooleanOperators a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> BooleanOperators a -> m (BooleanOperators b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> BooleanOperators a -> f (BooleanOperators b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> BooleanOperators a -> f (BooleanOperators b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> BooleanOperators a -> f (BooleanOperators b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
BooleanOperators (f a) -> f (BooleanOperators a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
BooleanOperators (f a) -> f (BooleanOperators a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> BooleanOperators a -> m (BooleanOperators b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> BooleanOperators a -> m (BooleanOperators b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
BooleanOperators (m a) -> m (BooleanOperators a)
sequence :: forall (m :: * -> *) a.
Monad m =>
BooleanOperators (m a) -> m (BooleanOperators a)
Traversable, Int -> BooleanOperators a -> ShowS
[BooleanOperators a] -> ShowS
BooleanOperators a -> String
(Int -> BooleanOperators a -> ShowS)
-> (BooleanOperators a -> String)
-> ([BooleanOperators a] -> ShowS)
-> Show (BooleanOperators a)
forall a. Show a => Int -> BooleanOperators a -> ShowS
forall a. Show a => [BooleanOperators a] -> ShowS
forall a. Show a => BooleanOperators a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> BooleanOperators a -> ShowS
showsPrec :: Int -> BooleanOperators a -> ShowS
$cshow :: forall a. Show a => BooleanOperators a -> String
show :: BooleanOperators a -> String
$cshowList :: forall a. Show a => [BooleanOperators a] -> ShowS
showList :: [BooleanOperators a] -> ShowS
Show)

instance (NFData a) => NFData (BooleanOperators a)

instance (Hashable a) => Hashable (BooleanOperators a)

instance (ToJSON a) => J.ToJSONKeyValue (BooleanOperators a) where
  toJSONKeyValue :: BooleanOperators a -> Pair
toJSONKeyValue = \case
    ASTContains a
a -> (Key
"_st_contains", a -> Value
forall a. ToJSON a => a -> Value
J.toJSON a
a)
    ASTEquals a
a -> (Key
"_st_equals", a -> Value
forall a. ToJSON a => a -> Value
J.toJSON a
a)
    ASTIntersects a
a -> (Key
"_st_intersects", a -> Value
forall a. ToJSON a => a -> Value
J.toJSON a
a)
    ASTTouches a
a -> (Key
"_st_touches", a -> Value
forall a. ToJSON a => a -> Value
J.toJSON a
a)
    ASTWithin a
a -> (Key
"_st_within", a -> Value
forall a. ToJSON a => a -> Value
J.toJSON a
a)
    ASTDWithin DWithinGeogOp a
a -> (Key
"_st_dwithin", DWithinGeogOp a -> Value
forall a. ToJSON a => a -> Value
J.toJSON DWithinGeogOp a
a)

data FunctionName = FunctionName
  { FunctionName -> Text
functionName :: Text,
    -- | System functions like "unnest" don't have schema/dataset
    FunctionName -> Maybe Text
functionNameSchema :: Maybe Text
  }
  deriving stock (FunctionName -> FunctionName -> Bool
(FunctionName -> FunctionName -> Bool)
-> (FunctionName -> FunctionName -> Bool) -> Eq FunctionName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FunctionName -> FunctionName -> Bool
== :: FunctionName -> FunctionName -> Bool
$c/= :: FunctionName -> FunctionName -> Bool
/= :: FunctionName -> FunctionName -> Bool
Eq, Int -> FunctionName -> ShowS
[FunctionName] -> ShowS
FunctionName -> String
(Int -> FunctionName -> ShowS)
-> (FunctionName -> String)
-> ([FunctionName] -> ShowS)
-> Show FunctionName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FunctionName -> ShowS
showsPrec :: Int -> FunctionName -> ShowS
$cshow :: FunctionName -> String
show :: FunctionName -> String
$cshowList :: [FunctionName] -> ShowS
showList :: [FunctionName] -> ShowS
Show, (forall x. FunctionName -> Rep FunctionName x)
-> (forall x. Rep FunctionName x -> FunctionName)
-> Generic FunctionName
forall x. Rep FunctionName x -> FunctionName
forall x. FunctionName -> Rep FunctionName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FunctionName -> Rep FunctionName x
from :: forall x. FunctionName -> Rep FunctionName x
$cto :: forall x. Rep FunctionName x -> FunctionName
to :: forall x. Rep FunctionName x -> FunctionName
Generic, Typeable FunctionName
Typeable FunctionName
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> FunctionName -> c FunctionName)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c FunctionName)
-> (FunctionName -> Constr)
-> (FunctionName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c FunctionName))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c FunctionName))
-> ((forall b. Data b => b -> b) -> FunctionName -> FunctionName)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> FunctionName -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> FunctionName -> r)
-> (forall u. (forall d. Data d => d -> u) -> FunctionName -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> FunctionName -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> FunctionName -> m FunctionName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FunctionName -> m FunctionName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FunctionName -> m FunctionName)
-> Data FunctionName
FunctionName -> Constr
FunctionName -> DataType
(forall b. Data b => b -> b) -> FunctionName -> FunctionName
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> FunctionName -> u
forall u. (forall d. Data d => d -> u) -> FunctionName -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionName -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FunctionName -> m FunctionName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FunctionName -> m FunctionName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FunctionName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FunctionName -> c FunctionName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FunctionName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FunctionName)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FunctionName -> c FunctionName
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FunctionName -> c FunctionName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FunctionName
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FunctionName
$ctoConstr :: FunctionName -> Constr
toConstr :: FunctionName -> Constr
$cdataTypeOf :: FunctionName -> DataType
dataTypeOf :: FunctionName -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FunctionName)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FunctionName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FunctionName)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FunctionName)
$cgmapT :: (forall b. Data b => b -> b) -> FunctionName -> FunctionName
gmapT :: (forall b. Data b => b -> b) -> FunctionName -> FunctionName
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionName -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionName -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionName -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FunctionName -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> FunctionName -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FunctionName -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FunctionName -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FunctionName -> m FunctionName
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FunctionName -> m FunctionName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FunctionName -> m FunctionName
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FunctionName -> m FunctionName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FunctionName -> m FunctionName
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FunctionName -> m FunctionName
Data, (forall (m :: * -> *). Quote m => FunctionName -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    FunctionName -> Code m FunctionName)
-> Lift FunctionName
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => FunctionName -> m Exp
forall (m :: * -> *).
Quote m =>
FunctionName -> Code m FunctionName
$clift :: forall (m :: * -> *). Quote m => FunctionName -> m Exp
lift :: forall (m :: * -> *). Quote m => FunctionName -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
FunctionName -> Code m FunctionName
liftTyped :: forall (m :: * -> *).
Quote m =>
FunctionName -> Code m FunctionName
Lift, Eq FunctionName
Eq FunctionName
-> (FunctionName -> FunctionName -> Ordering)
-> (FunctionName -> FunctionName -> Bool)
-> (FunctionName -> FunctionName -> Bool)
-> (FunctionName -> FunctionName -> Bool)
-> (FunctionName -> FunctionName -> Bool)
-> (FunctionName -> FunctionName -> FunctionName)
-> (FunctionName -> FunctionName -> FunctionName)
-> Ord FunctionName
FunctionName -> FunctionName -> Bool
FunctionName -> FunctionName -> Ordering
FunctionName -> FunctionName -> FunctionName
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 :: FunctionName -> FunctionName -> Ordering
compare :: FunctionName -> FunctionName -> Ordering
$c< :: FunctionName -> FunctionName -> Bool
< :: FunctionName -> FunctionName -> Bool
$c<= :: FunctionName -> FunctionName -> Bool
<= :: FunctionName -> FunctionName -> Bool
$c> :: FunctionName -> FunctionName -> Bool
> :: FunctionName -> FunctionName -> Bool
$c>= :: FunctionName -> FunctionName -> Bool
>= :: FunctionName -> FunctionName -> Bool
$cmax :: FunctionName -> FunctionName -> FunctionName
max :: FunctionName -> FunctionName -> FunctionName
$cmin :: FunctionName -> FunctionName -> FunctionName
min :: FunctionName -> FunctionName -> FunctionName
Ord)
  deriving anyclass (Eq FunctionName
Eq FunctionName
-> (Int -> FunctionName -> Int)
-> (FunctionName -> Int)
-> Hashable FunctionName
Int -> FunctionName -> Int
FunctionName -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> FunctionName -> Int
hashWithSalt :: Int -> FunctionName -> Int
$chash :: FunctionName -> Int
hash :: FunctionName -> Int
Hashable, FunctionName -> ()
(FunctionName -> ()) -> NFData FunctionName
forall a. (a -> ()) -> NFData a
$crnf :: FunctionName -> ()
rnf :: FunctionName -> ()
NFData, ToJSONKeyFunction [FunctionName]
ToJSONKeyFunction FunctionName
ToJSONKeyFunction FunctionName
-> ToJSONKeyFunction [FunctionName] -> ToJSONKey FunctionName
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction FunctionName
toJSONKey :: ToJSONKeyFunction FunctionName
$ctoJSONKeyList :: ToJSONKeyFunction [FunctionName]
toJSONKeyList :: ToJSONKeyFunction [FunctionName]
ToJSONKey)

instance HasCodec FunctionName where
  codec :: JSONCodec FunctionName
codec =
    Text
-> ObjectCodec FunctionName FunctionName -> JSONCodec FunctionName
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"BigQueryFunctionName"
      (ObjectCodec FunctionName FunctionName -> JSONCodec FunctionName)
-> ObjectCodec FunctionName FunctionName -> JSONCodec FunctionName
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> FunctionName
FunctionName
      (Text -> Maybe Text -> FunctionName)
-> Codec Object FunctionName Text
-> Codec Object FunctionName (Maybe Text -> FunctionName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec Text Text
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"name"
      ObjectCodec Text Text
-> (FunctionName -> Text) -> Codec Object FunctionName Text
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= FunctionName -> Text
functionName
        Codec Object FunctionName (Maybe Text -> FunctionName)
-> Codec Object FunctionName (Maybe Text)
-> ObjectCodec FunctionName FunctionName
forall a b.
Codec Object FunctionName (a -> b)
-> Codec Object FunctionName a -> Codec Object FunctionName b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec (Maybe Text) (Maybe Text)
forall output.
HasCodec output =>
Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField' Text
"dataset"
      ObjectCodec (Maybe Text) (Maybe Text)
-> (FunctionName -> Maybe Text)
-> Codec Object FunctionName (Maybe Text)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= FunctionName -> Maybe Text
functionNameSchema

instance FromJSON FunctionName where
  parseJSON :: Value -> Parser FunctionName
parseJSON =
    String
-> (Object -> Parser FunctionName) -> Value -> Parser FunctionName
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject
      String
"FunctionName"
      (\Object
o -> Text -> Maybe Text -> FunctionName
FunctionName (Text -> Maybe Text -> FunctionName)
-> Parser Text -> Parser (Maybe Text -> FunctionName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
J..: Key
"name" Parser (Maybe Text -> FunctionName)
-> Parser (Maybe Text) -> Parser FunctionName
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
J..:? Key
"dataset")

instance ToJSON FunctionName where
  toJSON :: FunctionName -> Value
toJSON FunctionName {Maybe Text
Text
$sel:functionName:FunctionName :: FunctionName -> Text
$sel:functionNameSchema:FunctionName :: FunctionName -> Maybe Text
functionName :: Text
functionNameSchema :: Maybe Text
..} = [Pair] -> Value
J.object [Key
"name" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= Text
functionName, Key
"dataset" Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= Maybe Text
functionNameSchema]

instance ToTxt FunctionName where
  toTxt :: FunctionName -> Text
toTxt FunctionName {Maybe Text
Text
$sel:functionName:FunctionName :: FunctionName -> Text
$sel:functionNameSchema:FunctionName :: FunctionName -> Maybe Text
functionName :: Text
functionNameSchema :: Maybe Text
..} =
    case Maybe Text
functionNameSchema of
      Maybe Text
Nothing -> Text
functionName
      Just Text
schemaName -> Text
schemaName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
functionName

instance ToErrorValue FunctionName where
  toErrorValue :: FunctionName -> ErrorMessage
toErrorValue = Text -> ErrorMessage
ErrorValue.squote (Text -> ErrorMessage)
-> (FunctionName -> Text) -> FunctionName -> ErrorMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionName -> Text
forall a. ToTxt a => a -> Text
toTxt

-- | The metadata required to define a computed field for a BigQuery table
data ComputedFieldDefinition = ComputedFieldDefinition
  { -- | Name of the user defined routine
    ComputedFieldDefinition -> FunctionName
_bqcfdFunction :: FunctionName,
    -- | Name of the table which the function returns. If not provided
    -- the return table schema is inferred from the routine API metadata.
    ComputedFieldDefinition -> Maybe TableName
_bqcfdReturnTable :: Maybe TableName,
    -- | A mapping context to determine argument value from table column
    ComputedFieldDefinition -> HashMap FunctionArgName ColumnName
_bqcfdArgumentMapping :: HashMap FunctionArgName ColumnName
  }
  deriving stock (ComputedFieldDefinition -> ComputedFieldDefinition -> Bool
(ComputedFieldDefinition -> ComputedFieldDefinition -> Bool)
-> (ComputedFieldDefinition -> ComputedFieldDefinition -> Bool)
-> Eq ComputedFieldDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ComputedFieldDefinition -> ComputedFieldDefinition -> Bool
== :: ComputedFieldDefinition -> ComputedFieldDefinition -> Bool
$c/= :: ComputedFieldDefinition -> ComputedFieldDefinition -> Bool
/= :: ComputedFieldDefinition -> ComputedFieldDefinition -> Bool
Eq, Int -> ComputedFieldDefinition -> ShowS
[ComputedFieldDefinition] -> ShowS
ComputedFieldDefinition -> String
(Int -> ComputedFieldDefinition -> ShowS)
-> (ComputedFieldDefinition -> String)
-> ([ComputedFieldDefinition] -> ShowS)
-> Show ComputedFieldDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ComputedFieldDefinition -> ShowS
showsPrec :: Int -> ComputedFieldDefinition -> ShowS
$cshow :: ComputedFieldDefinition -> String
show :: ComputedFieldDefinition -> String
$cshowList :: [ComputedFieldDefinition] -> ShowS
showList :: [ComputedFieldDefinition] -> ShowS
Show, (forall x.
 ComputedFieldDefinition -> Rep ComputedFieldDefinition x)
-> (forall x.
    Rep ComputedFieldDefinition x -> ComputedFieldDefinition)
-> Generic ComputedFieldDefinition
forall x. Rep ComputedFieldDefinition x -> ComputedFieldDefinition
forall x. ComputedFieldDefinition -> Rep ComputedFieldDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ComputedFieldDefinition -> Rep ComputedFieldDefinition x
from :: forall x. ComputedFieldDefinition -> Rep ComputedFieldDefinition x
$cto :: forall x. Rep ComputedFieldDefinition x -> ComputedFieldDefinition
to :: forall x. Rep ComputedFieldDefinition x -> ComputedFieldDefinition
Generic, Typeable ComputedFieldDefinition
Typeable ComputedFieldDefinition
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> ComputedFieldDefinition
    -> c ComputedFieldDefinition)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ComputedFieldDefinition)
-> (ComputedFieldDefinition -> Constr)
-> (ComputedFieldDefinition -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ComputedFieldDefinition))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ComputedFieldDefinition))
-> ((forall b. Data b => b -> b)
    -> ComputedFieldDefinition -> ComputedFieldDefinition)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ComputedFieldDefinition
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ComputedFieldDefinition
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ComputedFieldDefinition -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> ComputedFieldDefinition -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ComputedFieldDefinition -> m ComputedFieldDefinition)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ComputedFieldDefinition -> m ComputedFieldDefinition)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ComputedFieldDefinition -> m ComputedFieldDefinition)
-> Data ComputedFieldDefinition
ComputedFieldDefinition -> Constr
ComputedFieldDefinition -> DataType
(forall b. Data b => b -> b)
-> ComputedFieldDefinition -> ComputedFieldDefinition
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ComputedFieldDefinition -> u
forall u.
(forall d. Data d => d -> u) -> ComputedFieldDefinition -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ComputedFieldDefinition
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ComputedFieldDefinition
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ComputedFieldDefinition -> m ComputedFieldDefinition
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ComputedFieldDefinition -> m ComputedFieldDefinition
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ComputedFieldDefinition
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ComputedFieldDefinition
-> c ComputedFieldDefinition
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ComputedFieldDefinition)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ComputedFieldDefinition)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ComputedFieldDefinition
-> c ComputedFieldDefinition
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ComputedFieldDefinition
-> c ComputedFieldDefinition
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ComputedFieldDefinition
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ComputedFieldDefinition
$ctoConstr :: ComputedFieldDefinition -> Constr
toConstr :: ComputedFieldDefinition -> Constr
$cdataTypeOf :: ComputedFieldDefinition -> DataType
dataTypeOf :: ComputedFieldDefinition -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ComputedFieldDefinition)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ComputedFieldDefinition)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ComputedFieldDefinition)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ComputedFieldDefinition)
$cgmapT :: (forall b. Data b => b -> b)
-> ComputedFieldDefinition -> ComputedFieldDefinition
gmapT :: (forall b. Data b => b -> b)
-> ComputedFieldDefinition -> ComputedFieldDefinition
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ComputedFieldDefinition
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ComputedFieldDefinition
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ComputedFieldDefinition
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ComputedFieldDefinition
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> ComputedFieldDefinition -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> ComputedFieldDefinition -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ComputedFieldDefinition -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ComputedFieldDefinition -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ComputedFieldDefinition -> m ComputedFieldDefinition
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ComputedFieldDefinition -> m ComputedFieldDefinition
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ComputedFieldDefinition -> m ComputedFieldDefinition
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ComputedFieldDefinition -> m ComputedFieldDefinition
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ComputedFieldDefinition -> m ComputedFieldDefinition
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ComputedFieldDefinition -> m ComputedFieldDefinition
Data, Eq ComputedFieldDefinition
Eq ComputedFieldDefinition
-> (ComputedFieldDefinition -> ComputedFieldDefinition -> Ordering)
-> (ComputedFieldDefinition -> ComputedFieldDefinition -> Bool)
-> (ComputedFieldDefinition -> ComputedFieldDefinition -> Bool)
-> (ComputedFieldDefinition -> ComputedFieldDefinition -> Bool)
-> (ComputedFieldDefinition -> ComputedFieldDefinition -> Bool)
-> (ComputedFieldDefinition
    -> ComputedFieldDefinition -> ComputedFieldDefinition)
-> (ComputedFieldDefinition
    -> ComputedFieldDefinition -> ComputedFieldDefinition)
-> Ord ComputedFieldDefinition
ComputedFieldDefinition -> ComputedFieldDefinition -> Bool
ComputedFieldDefinition -> ComputedFieldDefinition -> Ordering
ComputedFieldDefinition
-> ComputedFieldDefinition -> ComputedFieldDefinition
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 :: ComputedFieldDefinition -> ComputedFieldDefinition -> Ordering
compare :: ComputedFieldDefinition -> ComputedFieldDefinition -> Ordering
$c< :: ComputedFieldDefinition -> ComputedFieldDefinition -> Bool
< :: ComputedFieldDefinition -> ComputedFieldDefinition -> Bool
$c<= :: ComputedFieldDefinition -> ComputedFieldDefinition -> Bool
<= :: ComputedFieldDefinition -> ComputedFieldDefinition -> Bool
$c> :: ComputedFieldDefinition -> ComputedFieldDefinition -> Bool
> :: ComputedFieldDefinition -> ComputedFieldDefinition -> Bool
$c>= :: ComputedFieldDefinition -> ComputedFieldDefinition -> Bool
>= :: ComputedFieldDefinition -> ComputedFieldDefinition -> Bool
$cmax :: ComputedFieldDefinition
-> ComputedFieldDefinition -> ComputedFieldDefinition
max :: ComputedFieldDefinition
-> ComputedFieldDefinition -> ComputedFieldDefinition
$cmin :: ComputedFieldDefinition
-> ComputedFieldDefinition -> ComputedFieldDefinition
min :: ComputedFieldDefinition
-> ComputedFieldDefinition -> ComputedFieldDefinition
Ord)
  deriving anyclass (Eq ComputedFieldDefinition
Eq ComputedFieldDefinition
-> (Int -> ComputedFieldDefinition -> Int)
-> (ComputedFieldDefinition -> Int)
-> Hashable ComputedFieldDefinition
Int -> ComputedFieldDefinition -> Int
ComputedFieldDefinition -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> ComputedFieldDefinition -> Int
hashWithSalt :: Int -> ComputedFieldDefinition -> Int
$chash :: ComputedFieldDefinition -> Int
hash :: ComputedFieldDefinition -> Int
Hashable, ComputedFieldDefinition -> ()
(ComputedFieldDefinition -> ()) -> NFData ComputedFieldDefinition
forall a. (a -> ()) -> NFData a
$crnf :: ComputedFieldDefinition -> ()
rnf :: ComputedFieldDefinition -> ()
NFData)

instance HasCodec ComputedFieldDefinition where
  codec :: JSONCodec ComputedFieldDefinition
codec =
    Text
-> ObjectCodec ComputedFieldDefinition ComputedFieldDefinition
-> JSONCodec ComputedFieldDefinition
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"BigQueryComputedFieldDefinition"
      (ObjectCodec ComputedFieldDefinition ComputedFieldDefinition
 -> JSONCodec ComputedFieldDefinition)
-> ObjectCodec ComputedFieldDefinition ComputedFieldDefinition
-> JSONCodec ComputedFieldDefinition
forall a b. (a -> b) -> a -> b
$ FunctionName
-> Maybe TableName
-> HashMap FunctionArgName ColumnName
-> ComputedFieldDefinition
ComputedFieldDefinition
      (FunctionName
 -> Maybe TableName
 -> HashMap FunctionArgName ColumnName
 -> ComputedFieldDefinition)
-> Codec Object ComputedFieldDefinition FunctionName
-> Codec
     Object
     ComputedFieldDefinition
     (Maybe TableName
      -> HashMap FunctionArgName ColumnName -> ComputedFieldDefinition)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec FunctionName FunctionName
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"function"
      ObjectCodec FunctionName FunctionName
-> (ComputedFieldDefinition -> FunctionName)
-> Codec Object ComputedFieldDefinition FunctionName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= ComputedFieldDefinition -> FunctionName
_bqcfdFunction
        Codec
  Object
  ComputedFieldDefinition
  (Maybe TableName
   -> HashMap FunctionArgName ColumnName -> ComputedFieldDefinition)
-> Codec Object ComputedFieldDefinition (Maybe TableName)
-> Codec
     Object
     ComputedFieldDefinition
     (HashMap FunctionArgName ColumnName -> ComputedFieldDefinition)
forall a b.
Codec Object ComputedFieldDefinition (a -> b)
-> Codec Object ComputedFieldDefinition a
-> Codec Object ComputedFieldDefinition b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec (Maybe TableName) (Maybe TableName)
forall output.
HasCodec output =>
Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField' Text
"return_table"
      ObjectCodec (Maybe TableName) (Maybe TableName)
-> (ComputedFieldDefinition -> Maybe TableName)
-> Codec Object ComputedFieldDefinition (Maybe TableName)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= ComputedFieldDefinition -> Maybe TableName
_bqcfdReturnTable
        Codec
  Object
  ComputedFieldDefinition
  (HashMap FunctionArgName ColumnName -> ComputedFieldDefinition)
-> Codec
     Object ComputedFieldDefinition (HashMap FunctionArgName ColumnName)
-> ObjectCodec ComputedFieldDefinition ComputedFieldDefinition
forall a b.
Codec Object ComputedFieldDefinition (a -> b)
-> Codec Object ComputedFieldDefinition a
-> Codec Object ComputedFieldDefinition b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ObjectCodec
     (HashMap FunctionArgName ColumnName)
     (HashMap FunctionArgName ColumnName)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"argument_mapping"
      ObjectCodec
  (HashMap FunctionArgName ColumnName)
  (HashMap FunctionArgName ColumnName)
-> (ComputedFieldDefinition -> HashMap FunctionArgName ColumnName)
-> Codec
     Object ComputedFieldDefinition (HashMap FunctionArgName ColumnName)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= ComputedFieldDefinition -> HashMap FunctionArgName ColumnName
_bqcfdArgumentMapping

instance ToJSON ComputedFieldDefinition where
  toJSON :: ComputedFieldDefinition -> Value
toJSON = Options -> ComputedFieldDefinition -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON Options
hasuraJSON {omitNothingFields :: Bool
J.omitNothingFields = Bool
True}

instance FromJSON ComputedFieldDefinition where
  parseJSON :: Value -> Parser ComputedFieldDefinition
parseJSON = Options -> Value -> Parser ComputedFieldDefinition
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
J.genericParseJSON Options
hasuraJSON

-- | A argument expression for SQL functions
data ArgumentExp v
  = -- | Value coming from user's input through GraphQL query
    AEInput v
  | -- | For computed fields, value of column from the table
    AETableColumn ColumnName
  deriving stock (ArgumentExp v -> ArgumentExp v -> Bool
(ArgumentExp v -> ArgumentExp v -> Bool)
-> (ArgumentExp v -> ArgumentExp v -> Bool) -> Eq (ArgumentExp v)
forall v. Eq v => ArgumentExp v -> ArgumentExp v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall v. Eq v => ArgumentExp v -> ArgumentExp v -> Bool
== :: ArgumentExp v -> ArgumentExp v -> Bool
$c/= :: forall v. Eq v => ArgumentExp v -> ArgumentExp v -> Bool
/= :: ArgumentExp v -> ArgumentExp v -> Bool
Eq, Int -> ArgumentExp v -> ShowS
[ArgumentExp v] -> ShowS
ArgumentExp v -> String
(Int -> ArgumentExp v -> ShowS)
-> (ArgumentExp v -> String)
-> ([ArgumentExp v] -> ShowS)
-> Show (ArgumentExp v)
forall v. Show v => Int -> ArgumentExp v -> ShowS
forall v. Show v => [ArgumentExp v] -> ShowS
forall v. Show v => ArgumentExp v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall v. Show v => Int -> ArgumentExp v -> ShowS
showsPrec :: Int -> ArgumentExp v -> ShowS
$cshow :: forall v. Show v => ArgumentExp v -> String
show :: ArgumentExp v -> String
$cshowList :: forall v. Show v => [ArgumentExp v] -> ShowS
showList :: [ArgumentExp v] -> ShowS
Show, (forall a b. (a -> b) -> ArgumentExp a -> ArgumentExp b)
-> (forall a b. a -> ArgumentExp b -> ArgumentExp a)
-> Functor ArgumentExp
forall a b. a -> ArgumentExp b -> ArgumentExp a
forall a b. (a -> b) -> ArgumentExp a -> ArgumentExp 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) -> ArgumentExp a -> ArgumentExp b
fmap :: forall a b. (a -> b) -> ArgumentExp a -> ArgumentExp b
$c<$ :: forall a b. a -> ArgumentExp b -> ArgumentExp a
<$ :: forall a b. a -> ArgumentExp b -> ArgumentExp a
Functor, (forall m. Monoid m => ArgumentExp m -> m)
-> (forall m a. Monoid m => (a -> m) -> ArgumentExp a -> m)
-> (forall m a. Monoid m => (a -> m) -> ArgumentExp a -> m)
-> (forall a b. (a -> b -> b) -> b -> ArgumentExp a -> b)
-> (forall a b. (a -> b -> b) -> b -> ArgumentExp a -> b)
-> (forall b a. (b -> a -> b) -> b -> ArgumentExp a -> b)
-> (forall b a. (b -> a -> b) -> b -> ArgumentExp a -> b)
-> (forall a. (a -> a -> a) -> ArgumentExp a -> a)
-> (forall a. (a -> a -> a) -> ArgumentExp a -> a)
-> (forall a. ArgumentExp a -> [a])
-> (forall a. ArgumentExp a -> Bool)
-> (forall a. ArgumentExp a -> Int)
-> (forall a. Eq a => a -> ArgumentExp a -> Bool)
-> (forall a. Ord a => ArgumentExp a -> a)
-> (forall a. Ord a => ArgumentExp a -> a)
-> (forall a. Num a => ArgumentExp a -> a)
-> (forall a. Num a => ArgumentExp a -> a)
-> Foldable ArgumentExp
forall a. Eq a => a -> ArgumentExp a -> Bool
forall a. Num a => ArgumentExp a -> a
forall a. Ord a => ArgumentExp a -> a
forall m. Monoid m => ArgumentExp m -> m
forall a. ArgumentExp a -> Bool
forall a. ArgumentExp a -> Int
forall a. ArgumentExp a -> [a]
forall a. (a -> a -> a) -> ArgumentExp a -> a
forall m a. Monoid m => (a -> m) -> ArgumentExp a -> m
forall b a. (b -> a -> b) -> b -> ArgumentExp a -> b
forall a b. (a -> b -> b) -> b -> ArgumentExp a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => ArgumentExp m -> m
fold :: forall m. Monoid m => ArgumentExp m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> ArgumentExp a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> ArgumentExp a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> ArgumentExp a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> ArgumentExp a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> ArgumentExp a -> b
foldr :: forall a b. (a -> b -> b) -> b -> ArgumentExp a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> ArgumentExp a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> ArgumentExp a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> ArgumentExp a -> b
foldl :: forall b a. (b -> a -> b) -> b -> ArgumentExp a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> ArgumentExp a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> ArgumentExp a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> ArgumentExp a -> a
foldr1 :: forall a. (a -> a -> a) -> ArgumentExp a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> ArgumentExp a -> a
foldl1 :: forall a. (a -> a -> a) -> ArgumentExp a -> a
$ctoList :: forall a. ArgumentExp a -> [a]
toList :: forall a. ArgumentExp a -> [a]
$cnull :: forall a. ArgumentExp a -> Bool
null :: forall a. ArgumentExp a -> Bool
$clength :: forall a. ArgumentExp a -> Int
length :: forall a. ArgumentExp a -> Int
$celem :: forall a. Eq a => a -> ArgumentExp a -> Bool
elem :: forall a. Eq a => a -> ArgumentExp a -> Bool
$cmaximum :: forall a. Ord a => ArgumentExp a -> a
maximum :: forall a. Ord a => ArgumentExp a -> a
$cminimum :: forall a. Ord a => ArgumentExp a -> a
minimum :: forall a. Ord a => ArgumentExp a -> a
$csum :: forall a. Num a => ArgumentExp a -> a
sum :: forall a. Num a => ArgumentExp a -> a
$cproduct :: forall a. Num a => ArgumentExp a -> a
product :: forall a. Num a => ArgumentExp a -> a
Foldable, Functor ArgumentExp
Foldable ArgumentExp
Functor ArgumentExp
-> Foldable ArgumentExp
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> ArgumentExp a -> f (ArgumentExp b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    ArgumentExp (f a) -> f (ArgumentExp a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> ArgumentExp a -> m (ArgumentExp b))
-> (forall (m :: * -> *) a.
    Monad m =>
    ArgumentExp (m a) -> m (ArgumentExp a))
-> Traversable ArgumentExp
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
ArgumentExp (m a) -> m (ArgumentExp a)
forall (f :: * -> *) a.
Applicative f =>
ArgumentExp (f a) -> f (ArgumentExp a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ArgumentExp a -> m (ArgumentExp b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ArgumentExp a -> f (ArgumentExp b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ArgumentExp a -> f (ArgumentExp b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ArgumentExp a -> f (ArgumentExp b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
ArgumentExp (f a) -> f (ArgumentExp a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
ArgumentExp (f a) -> f (ArgumentExp a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ArgumentExp a -> m (ArgumentExp b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ArgumentExp a -> m (ArgumentExp b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
ArgumentExp (m a) -> m (ArgumentExp a)
sequence :: forall (m :: * -> *) a.
Monad m =>
ArgumentExp (m a) -> m (ArgumentExp a)
Traversable, (forall x. ArgumentExp v -> Rep (ArgumentExp v) x)
-> (forall x. Rep (ArgumentExp v) x -> ArgumentExp v)
-> Generic (ArgumentExp v)
forall x. Rep (ArgumentExp v) x -> ArgumentExp v
forall x. ArgumentExp v -> Rep (ArgumentExp v) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v x. Rep (ArgumentExp v) x -> ArgumentExp v
forall v x. ArgumentExp v -> Rep (ArgumentExp v) x
$cfrom :: forall v x. ArgumentExp v -> Rep (ArgumentExp v) x
from :: forall x. ArgumentExp v -> Rep (ArgumentExp v) x
$cto :: forall v x. Rep (ArgumentExp v) x -> ArgumentExp v
to :: forall x. Rep (ArgumentExp v) x -> ArgumentExp v
Generic)

instance (Hashable v) => Hashable (ArgumentExp v)

type ComputedFieldImplicitArguments = HashMap FunctionArgName ColumnName

-- | Returning type of the function underlying a computed field
data ComputedFieldReturn
  = -- | Returns existing table, needs to be present in the metadata
    ReturnExistingTable TableName
  | -- | An arbitrary table schema specified by column name and type pairs
    ReturnTableSchema [(ColumnName, G.Name, ScalarType)]
  deriving stock (Int -> ComputedFieldReturn -> ShowS
[ComputedFieldReturn] -> ShowS
ComputedFieldReturn -> String
(Int -> ComputedFieldReturn -> ShowS)
-> (ComputedFieldReturn -> String)
-> ([ComputedFieldReturn] -> ShowS)
-> Show ComputedFieldReturn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ComputedFieldReturn -> ShowS
showsPrec :: Int -> ComputedFieldReturn -> ShowS
$cshow :: ComputedFieldReturn -> String
show :: ComputedFieldReturn -> String
$cshowList :: [ComputedFieldReturn] -> ShowS
showList :: [ComputedFieldReturn] -> ShowS
Show, ComputedFieldReturn -> ComputedFieldReturn -> Bool
(ComputedFieldReturn -> ComputedFieldReturn -> Bool)
-> (ComputedFieldReturn -> ComputedFieldReturn -> Bool)
-> Eq ComputedFieldReturn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ComputedFieldReturn -> ComputedFieldReturn -> Bool
== :: ComputedFieldReturn -> ComputedFieldReturn -> Bool
$c/= :: ComputedFieldReturn -> ComputedFieldReturn -> Bool
/= :: ComputedFieldReturn -> ComputedFieldReturn -> Bool
Eq, Eq ComputedFieldReturn
Eq ComputedFieldReturn
-> (ComputedFieldReturn -> ComputedFieldReturn -> Ordering)
-> (ComputedFieldReturn -> ComputedFieldReturn -> Bool)
-> (ComputedFieldReturn -> ComputedFieldReturn -> Bool)
-> (ComputedFieldReturn -> ComputedFieldReturn -> Bool)
-> (ComputedFieldReturn -> ComputedFieldReturn -> Bool)
-> (ComputedFieldReturn
    -> ComputedFieldReturn -> ComputedFieldReturn)
-> (ComputedFieldReturn
    -> ComputedFieldReturn -> ComputedFieldReturn)
-> Ord ComputedFieldReturn
ComputedFieldReturn -> ComputedFieldReturn -> Bool
ComputedFieldReturn -> ComputedFieldReturn -> Ordering
ComputedFieldReturn -> ComputedFieldReturn -> ComputedFieldReturn
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 :: ComputedFieldReturn -> ComputedFieldReturn -> Ordering
compare :: ComputedFieldReturn -> ComputedFieldReturn -> Ordering
$c< :: ComputedFieldReturn -> ComputedFieldReturn -> Bool
< :: ComputedFieldReturn -> ComputedFieldReturn -> Bool
$c<= :: ComputedFieldReturn -> ComputedFieldReturn -> Bool
<= :: ComputedFieldReturn -> ComputedFieldReturn -> Bool
$c> :: ComputedFieldReturn -> ComputedFieldReturn -> Bool
> :: ComputedFieldReturn -> ComputedFieldReturn -> Bool
$c>= :: ComputedFieldReturn -> ComputedFieldReturn -> Bool
>= :: ComputedFieldReturn -> ComputedFieldReturn -> Bool
$cmax :: ComputedFieldReturn -> ComputedFieldReturn -> ComputedFieldReturn
max :: ComputedFieldReturn -> ComputedFieldReturn -> ComputedFieldReturn
$cmin :: ComputedFieldReturn -> ComputedFieldReturn -> ComputedFieldReturn
min :: ComputedFieldReturn -> ComputedFieldReturn -> ComputedFieldReturn
Ord, (forall x. ComputedFieldReturn -> Rep ComputedFieldReturn x)
-> (forall x. Rep ComputedFieldReturn x -> ComputedFieldReturn)
-> Generic ComputedFieldReturn
forall x. Rep ComputedFieldReturn x -> ComputedFieldReturn
forall x. ComputedFieldReturn -> Rep ComputedFieldReturn x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ComputedFieldReturn -> Rep ComputedFieldReturn x
from :: forall x. ComputedFieldReturn -> Rep ComputedFieldReturn x
$cto :: forall x. Rep ComputedFieldReturn x -> ComputedFieldReturn
to :: forall x. Rep ComputedFieldReturn x -> ComputedFieldReturn
Generic)
  deriving anyclass (Eq ComputedFieldReturn
Eq ComputedFieldReturn
-> (Int -> ComputedFieldReturn -> Int)
-> (ComputedFieldReturn -> Int)
-> Hashable ComputedFieldReturn
Int -> ComputedFieldReturn -> Int
ComputedFieldReturn -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> ComputedFieldReturn -> Int
hashWithSalt :: Int -> ComputedFieldReturn -> Int
$chash :: ComputedFieldReturn -> Int
hash :: ComputedFieldReturn -> Int
Hashable, ComputedFieldReturn -> ()
(ComputedFieldReturn -> ()) -> NFData ComputedFieldReturn
forall a. (a -> ()) -> NFData a
$crnf :: ComputedFieldReturn -> ()
rnf :: ComputedFieldReturn -> ()
NFData)

instance ToJSON ComputedFieldReturn where
  toJSON :: ComputedFieldReturn -> Value
toJSON =
    Options -> ComputedFieldReturn -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON
      (Options -> ComputedFieldReturn -> Value)
-> Options -> ComputedFieldReturn -> Value
forall a b. (a -> b) -> a -> b
$ Options
J.defaultOptions
        { constructorTagModifier :: ShowS
J.constructorTagModifier = ShowS
J.snakeCase,
          sumEncoding :: SumEncoding
J.sumEncoding = String -> String -> SumEncoding
J.TaggedObject String
"type" String
"info"
        }

-- | Function input argument specification
data FunctionArgument = FunctionArgument
  { -- | Argument name of a table valued function is required
    -- Ref: https://cloud.google.com/bigquery/docs/reference/standard-sql/data-definition-language#create_table_function_statement
    FunctionArgument -> FunctionArgName
_faName :: FunctionArgName,
    -- | The data type of the argument
    FunctionArgument -> ScalarType
_faType :: ScalarType
  }
  deriving stock (Int -> FunctionArgument -> ShowS
[FunctionArgument] -> ShowS
FunctionArgument -> String
(Int -> FunctionArgument -> ShowS)
-> (FunctionArgument -> String)
-> ([FunctionArgument] -> ShowS)
-> Show FunctionArgument
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FunctionArgument -> ShowS
showsPrec :: Int -> FunctionArgument -> ShowS
$cshow :: FunctionArgument -> String
show :: FunctionArgument -> String
$cshowList :: [FunctionArgument] -> ShowS
showList :: [FunctionArgument] -> ShowS
Show, FunctionArgument -> FunctionArgument -> Bool
(FunctionArgument -> FunctionArgument -> Bool)
-> (FunctionArgument -> FunctionArgument -> Bool)
-> Eq FunctionArgument
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FunctionArgument -> FunctionArgument -> Bool
== :: FunctionArgument -> FunctionArgument -> Bool
$c/= :: FunctionArgument -> FunctionArgument -> Bool
/= :: FunctionArgument -> FunctionArgument -> Bool
Eq, Eq FunctionArgument
Eq FunctionArgument
-> (FunctionArgument -> FunctionArgument -> Ordering)
-> (FunctionArgument -> FunctionArgument -> Bool)
-> (FunctionArgument -> FunctionArgument -> Bool)
-> (FunctionArgument -> FunctionArgument -> Bool)
-> (FunctionArgument -> FunctionArgument -> Bool)
-> (FunctionArgument -> FunctionArgument -> FunctionArgument)
-> (FunctionArgument -> FunctionArgument -> FunctionArgument)
-> Ord FunctionArgument
FunctionArgument -> FunctionArgument -> Bool
FunctionArgument -> FunctionArgument -> Ordering
FunctionArgument -> FunctionArgument -> FunctionArgument
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 :: FunctionArgument -> FunctionArgument -> Ordering
compare :: FunctionArgument -> FunctionArgument -> Ordering
$c< :: FunctionArgument -> FunctionArgument -> Bool
< :: FunctionArgument -> FunctionArgument -> Bool
$c<= :: FunctionArgument -> FunctionArgument -> Bool
<= :: FunctionArgument -> FunctionArgument -> Bool
$c> :: FunctionArgument -> FunctionArgument -> Bool
> :: FunctionArgument -> FunctionArgument -> Bool
$c>= :: FunctionArgument -> FunctionArgument -> Bool
>= :: FunctionArgument -> FunctionArgument -> Bool
$cmax :: FunctionArgument -> FunctionArgument -> FunctionArgument
max :: FunctionArgument -> FunctionArgument -> FunctionArgument
$cmin :: FunctionArgument -> FunctionArgument -> FunctionArgument
min :: FunctionArgument -> FunctionArgument -> FunctionArgument
Ord, (forall x. FunctionArgument -> Rep FunctionArgument x)
-> (forall x. Rep FunctionArgument x -> FunctionArgument)
-> Generic FunctionArgument
forall x. Rep FunctionArgument x -> FunctionArgument
forall x. FunctionArgument -> Rep FunctionArgument x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FunctionArgument -> Rep FunctionArgument x
from :: forall x. FunctionArgument -> Rep FunctionArgument x
$cto :: forall x. Rep FunctionArgument x -> FunctionArgument
to :: forall x. Rep FunctionArgument x -> FunctionArgument
Generic)
  deriving anyclass (Eq FunctionArgument
Eq FunctionArgument
-> (Int -> FunctionArgument -> Int)
-> (FunctionArgument -> Int)
-> Hashable FunctionArgument
Int -> FunctionArgument -> Int
FunctionArgument -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> FunctionArgument -> Int
hashWithSalt :: Int -> FunctionArgument -> Int
$chash :: FunctionArgument -> Int
hash :: FunctionArgument -> Int
Hashable, FunctionArgument -> ()
(FunctionArgument -> ()) -> NFData FunctionArgument
forall a. (a -> ()) -> NFData a
$crnf :: FunctionArgument -> ()
rnf :: FunctionArgument -> ()
NFData)

instance ToJSON FunctionArgument where
  toJSON :: FunctionArgument -> Value
toJSON = Options -> FunctionArgument -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON Options
hasuraJSON

--------------------------------------------------------------------------------
-- Backend-related stuff
--

parseScalarValue :: ScalarType -> J.Value -> Either QErr Value
parseScalarValue :: ScalarType -> Value -> Either QErr Value
parseScalarValue ScalarType
scalarType Value
jValue = case ScalarType
scalarType of
  ScalarType
StringScalarType -> Text -> Value
StringValue (Text -> Value) -> Either QErr Text -> Either QErr Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either QErr Text
forall a. FromJSON a => Value -> Either QErr a
parseJValue Value
jValue
  ScalarType
BytesScalarType -> Text -> Value
StringValue (Text -> Value) -> Either QErr Text -> Either QErr Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either QErr Text
forall a. FromJSON a => Value -> Either QErr a
parseJValue Value
jValue
  ScalarType
IntegerScalarType -> Int64 -> Value
IntegerValue (Int64 -> Value) -> Either QErr Int64 -> Either QErr Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either QErr Int64
forall a. FromJSON a => Value -> Either QErr a
parseJValue Value
jValue
  ScalarType
FloatScalarType -> Float64 -> Value
FloatValue (Float64 -> Value) -> Either QErr Float64 -> Either QErr Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either QErr Float64
forall a. FromJSON a => Value -> Either QErr a
parseJValue Value
jValue
  ScalarType
BoolScalarType -> Bool -> Value
BoolValue (Bool -> Value) -> Either QErr Bool -> Either QErr Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either QErr Bool
forall a. FromJSON a => Value -> Either QErr a
parseJValue Value
jValue
  ScalarType
DecimalScalarType -> Decimal -> Value
DecimalValue (Decimal -> Value) -> Either QErr Decimal -> Either QErr Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either QErr Decimal
forall a. FromJSON a => Value -> Either QErr a
parseJValue Value
jValue
  ScalarType
BigDecimalScalarType -> BigDecimal -> Value
BigDecimalValue (BigDecimal -> Value)
-> Either QErr BigDecimal -> Either QErr Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either QErr BigDecimal
forall a. FromJSON a => Value -> Either QErr a
parseJValue Value
jValue
  ScalarType
TimestampScalarType -> Timestamp -> Value
TimestampValue (Timestamp -> Value) -> Either QErr Timestamp -> Either QErr Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either QErr Timestamp
forall a. FromJSON a => Value -> Either QErr a
parseJValue Value
jValue
  ScalarType
DateScalarType -> Date -> Value
DateValue (Date -> Value) -> Either QErr Date -> Either QErr Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either QErr Date
forall a. FromJSON a => Value -> Either QErr a
parseJValue Value
jValue
  ScalarType
TimeScalarType -> Time -> Value
TimeValue (Time -> Value) -> Either QErr Time -> Either QErr Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either QErr Time
forall a. FromJSON a => Value -> Either QErr a
parseJValue Value
jValue
  ScalarType
DatetimeScalarType -> Datetime -> Value
DatetimeValue (Datetime -> Value) -> Either QErr Datetime -> Either QErr Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either QErr Datetime
forall a. FromJSON a => Value -> Either QErr a
parseJValue Value
jValue
  ScalarType
GeographyScalarType -> Geography -> Value
GeographyValue (Geography -> Value) -> Either QErr Geography -> Either QErr Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either QErr Geography
forall a. FromJSON a => Value -> Either QErr a
parseJValue Value
jValue
  ScalarType
JsonScalarType -> Value -> Either QErr Value
forall a. a -> Either QErr a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Value
JsonValue Value
jValue)
  ScalarType
_ -> QErr -> Either QErr Value
forall a b. a -> Either a b
Left (Text -> QErr
internalError (String -> Text
T.pack (String
"Unsupported scalar type: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ScalarType -> String
forall a. Show a => a -> String
show ScalarType
scalarType String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
jValue)))
  -- TODO: These types:
  -- RecordScalarType -> RecordValue <$> parseJValue jValue
  -- StructScalarType -> StructValue <$> parseJValue jValue
  where
    parseJValue :: (J.FromJSON a) => J.Value -> Either QErr a
    parseJValue :: forall a. FromJSON a => Value -> Either QErr a
parseJValue = (Value -> Parser a) -> Value -> Either QErr a
forall (m :: * -> *) v a. QErrM m => (v -> Parser a) -> v -> m a
runAesonParser Value -> Parser a
forall a. FromJSON a => Value -> Parser a
J.parseJSON

-- see comparable BigQuery data types in
-- https://cloud.google.com/bigquery/docs/reference/standard-sql/data-types
-- in practice only Geography data type is not comparable
-- as ARRAY isn't a scalar type in the backend
isComparableType, isNumType :: ScalarType -> Bool
isComparableType :: ScalarType -> Bool
isComparableType = \case
  ScalarType
StringScalarType -> Bool
True
  ScalarType
BytesScalarType -> Bool
True
  ScalarType
IntegerScalarType -> Bool
True
  ScalarType
FloatScalarType -> Bool
True
  ScalarType
BoolScalarType -> Bool
True
  ScalarType
TimestampScalarType -> Bool
True
  ScalarType
DateScalarType -> Bool
True
  ScalarType
TimeScalarType -> Bool
True
  ScalarType
DatetimeScalarType -> Bool
True
  ScalarType
GeographyScalarType -> Bool
False
  ScalarType
DecimalScalarType -> Bool
True
  ScalarType
BigDecimalScalarType -> Bool
True
  ScalarType
JsonScalarType -> Bool
False
  ScalarType
StructScalarType -> Bool
True
isNumType :: ScalarType -> Bool
isNumType =
  \case
    ScalarType
StringScalarType -> Bool
False
    ScalarType
BytesScalarType -> Bool
False
    ScalarType
IntegerScalarType -> Bool
True
    ScalarType
FloatScalarType -> Bool
True
    ScalarType
BoolScalarType -> Bool
False
    ScalarType
TimestampScalarType -> Bool
False
    ScalarType
DateScalarType -> Bool
False
    ScalarType
TimeScalarType -> Bool
False
    ScalarType
DatetimeScalarType -> Bool
False
    ScalarType
GeographyScalarType -> Bool
False
    ScalarType
DecimalScalarType -> Bool
True
    ScalarType
BigDecimalScalarType -> Bool
True
    ScalarType
JsonScalarType -> Bool
False
    ScalarType
StructScalarType -> Bool
False

getGQLTableName :: TableName -> Either QErr G.Name
getGQLTableName :: TableName -> Either QErr Name
getGQLTableName (TableName Text
table Text
schema) = do
  let textName :: Text
textName = Text
schema Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
table
  Maybe Name -> Either QErr Name -> Either QErr Name
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (Text -> Maybe Name
G.mkName Text
textName)
    (Either QErr Name -> Either QErr Name)
-> Either QErr Name -> Either QErr Name
forall a b. (a -> b) -> a -> b
$ Code -> Text -> Either QErr Name
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
ValidationFailed
    (Text -> Either QErr Name) -> Text -> Either QErr Name
forall a b. (a -> b) -> a -> b
$ Text
"cannot include "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
textName
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in the GraphQL schema because it is not a valid GraphQL identifier"

--------------------------------------------------------------------------------
-- Liberal numeric parsers/printers (via JSON)
--
-- These are parsers/printers that go via text predominantly, except
-- where in simple cases they go via raw number representations in
-- JSON.

-- These printers may do something more clever later. See PG backend's
-- equivalent functions.
liberalIntegralPrinter :: (Coercible Text a) => a -> J.Value
liberalIntegralPrinter :: forall a. Coercible Text a => a -> Value
liberalIntegralPrinter a
a = Text -> Value
forall a. ToJSON a => a -> Value
J.toJSON (a -> Text
forall a b. Coercible a b => a -> b
coerce a
a :: Text)

liberalDecimalPrinter :: (Coercible a Text) => a -> J.Value
liberalDecimalPrinter :: forall a. Coercible a Text => a -> Value
liberalDecimalPrinter a
a = Text -> Value
forall a. ToJSON a => a -> Value
J.toJSON (a -> Text
forall a b. Coercible a b => a -> b
coerce a
a :: Text)

-- | Parse from text by simply validating it contains digits;
-- otherwise, require a JSON integer.
liberalInt64Parser :: (Text -> a) -> J.Value -> J.Parser a
liberalInt64Parser :: forall a. (Text -> a) -> Value -> Parser a
liberalInt64Parser Text -> a
fromText Value
json = Parser a
viaText Parser a -> Parser a -> Parser a
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser a
viaNumber
  where
    viaText :: Parser a
viaText = do
      Text
text <- Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
J.parseJSON Value
json
      -- Parsing scientific is safe; it doesn't normalise until we ask
      -- it to.
      case ReadP Scientific -> ReadS Scientific
forall a. ReadP a -> ReadS a
readP_to_S ReadP Scientific
scientificP (Text -> String
T.unpack Text
text) of
        [(Scientific
sci, String
"")] | Scientific -> Bool
isInteger Scientific
sci -> a -> Parser a
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> a
fromText Text
text)
        [(Scientific, String)]
_ -> String -> Parser a
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"String containing integral number is invalid: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
text)
    viaNumber :: Parser a
viaNumber = do
      Int
int <- Value -> Parser Int
forall a. FromJSON a => Value -> Parser a
J.parseJSON Value
json
      a -> Parser a
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> a
fromText (Int -> Text
forall a. Show a => a -> Text
tshow (Int
int :: Int)))

-- | Parse either a JSON native double number, or a text string
-- containing something vaguely in scientific notation. In either
-- case, producing a wrapped Text as the final result.
liberalDecimalParser :: (Text -> a) -> J.Value -> J.Parser a
liberalDecimalParser :: forall a. (Text -> a) -> Value -> Parser a
liberalDecimalParser Text -> a
fromText Value
json = Parser a
viaText Parser a -> Parser a -> Parser a
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser a
viaNumber
  where
    viaText :: Parser a
viaText = do
      Text
text <- Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
J.parseJSON Value
json
      -- Parsing scientific is safe; it doesn't normalise until we ask
      -- it to.
      let -- See https://cloud.google.com/bigquery/docs/reference/standard-sql/conversion_functions#cast_as_floating_point
          isNonFinite :: Bool
isNonFinite =
            let noSign :: Text
noSign = case Text -> Maybe (Char, Text)
T.uncons Text
text of
                  Just (Char
'+', Text
rest) -> Text
rest
                  Just (Char
'-', Text
rest) -> Text
rest
                  Maybe (Char, Text)
_ -> Text
text
             in Text -> Text
T.toLower Text
noSign Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"nan", Text
"infinity", Text
"inf"]
      case ReadP Scientific -> ReadS Scientific
forall a. ReadP a -> ReadS a
readP_to_S (ReadP Scientific
scientificP ReadP Scientific -> ReadP () -> ReadP Scientific
forall a b. ReadP a -> ReadP b -> ReadP a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReadP ()
eof) (Text -> String
T.unpack Text
text) of
        [(Scientific, String)
_] -> a -> Parser a
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> a
fromText Text
text)
        [] | Bool
isNonFinite -> a -> Parser a
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> a
fromText Text
text)
        [(Scientific, String)]
_ -> String -> Parser a
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"String containing decimal places is invalid: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
text)
    viaNumber :: Parser a
viaNumber = do
      Double
d <- Value -> Parser Double
forall a. FromJSON a => Value -> Parser a
J.parseJSON Value
json
      -- Converting a scientific to an unbounded number is unsafe, but
      -- to a double is bounded and therefore OK. JSON only supports
      -- doubles, so that's fine.
      a -> Parser a
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> a
fromText (Double -> Text
forall a. Show a => a -> Text
tshow (Double
d :: Double)))

projectionAlias :: Projection -> Maybe Text
projectionAlias :: Projection -> Maybe Text
projectionAlias =
  \case
    ExpressionProjection Aliased Expression
a -> Text -> Maybe Text
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Aliased Expression -> Text
forall a. Aliased a -> Text
aliasedAlias Aliased Expression
a)
    FieldNameProjection Aliased FieldName
a -> Text -> Maybe Text
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Aliased FieldName -> Text
forall a. Aliased a -> Text
aliasedAlias Aliased FieldName
a)
    AggregateProjections Aliased (NonEmpty (Aliased Aggregate))
a -> Text -> Maybe Text
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Aliased (NonEmpty (Aliased Aggregate)) -> Text
forall a. Aliased a -> Text
aliasedAlias Aliased (NonEmpty (Aliased Aggregate))
a)
    AggregateProjection Aliased Aggregate
a -> Text -> Maybe Text
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Aliased Aggregate -> Text
forall a. Aliased a -> Text
aliasedAlias Aliased Aggregate
a)
    Projection
StarProjection -> Maybe Text
forall a. Maybe a
Nothing
    ArrayAggProjection Aliased ArrayAgg
a -> Text -> Maybe Text
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Aliased ArrayAgg -> Text
forall a. Aliased a -> Text
aliasedAlias Aliased ArrayAgg
a)
    EntityProjection Aliased [(FieldName, FieldOrigin)]
a -> Text -> Maybe Text
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Aliased [(FieldName, FieldOrigin)] -> Text
forall a. Aliased a -> Text
aliasedAlias Aliased [(FieldName, FieldOrigin)]
a)
    ArrayEntityProjection EntityAlias
_ Aliased [FieldName]
a -> Text -> Maybe Text
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Aliased [FieldName] -> Text
forall a. Aliased a -> Text
aliasedAlias Aliased [FieldName]
a)
    WindowProjection Aliased WindowFunction
a -> Text -> Maybe Text
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Aliased WindowFunction -> Text
forall a. Aliased a -> Text
aliasedAlias Aliased WindowFunction
a)

data Job = Job
  { Job -> Text
state :: Text,
    Job -> Text
jobId :: Text,
    Job -> Text
location :: Text
  }
  deriving (Int -> Job -> ShowS
[Job] -> ShowS
Job -> String
(Int -> Job -> ShowS)
-> (Job -> String) -> ([Job] -> ShowS) -> Show Job
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Job -> ShowS
showsPrec :: Int -> Job -> ShowS
$cshow :: Job -> String
show :: Job -> String
$cshowList :: [Job] -> ShowS
showList :: [Job] -> ShowS
Show)

instance FromJSON Job where
  parseJSON :: Value -> Parser Job
parseJSON = String -> (Object -> Parser Job) -> Value -> Parser Job
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"Job" \Object
o -> do
    Text
kind <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
J..: Key
"kind"
    if Text
kind Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"bigquery#job" :: Text)
      then do
        Text
state <- do
          Object
status <- Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
J..: Key
"status"
          Object
status Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
J..: Key
"state"
        (Text
jobId, Text
location) <- do
          Object
ref <- Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
J..: Key
"jobReference"
          -- 'location' is needed in addition to 'jobId' to query a job's
          -- status
          (,) (Text -> Text -> (Text, Text))
-> Parser Text -> Parser (Text -> (Text, Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
ref Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
J..: Key
"jobId" Parser (Text -> (Text, Text)) -> Parser Text -> Parser (Text, Text)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
ref Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
J..: Key
"location"
        Job -> Parser Job
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Job {Text
$sel:state:Job :: Text
state :: Text
state, Text
$sel:jobId:Job :: Text
jobId :: Text
jobId, Text
$sel:location:Job :: Text
location :: Text
location}
      else String -> Parser Job
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)

instance ToJSON Job where
  toJSON :: Job -> Value
toJSON Job {Text
$sel:state:Job :: Job -> Text
$sel:jobId:Job :: Job -> Text
$sel:location:Job :: Job -> Text
state :: Text
jobId :: Text
location :: Text
..} =
    [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
J..= Text
jobId,
        Key
"location" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= Text
location,
        Key
"state" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= Text
state
      ]

data ExecutionStatistics = ExecutionStatistics
  { ExecutionStatistics -> Job
_esJob :: Job
  }
  deriving stock ((forall x. ExecutionStatistics -> Rep ExecutionStatistics x)
-> (forall x. Rep ExecutionStatistics x -> ExecutionStatistics)
-> Generic ExecutionStatistics
forall x. Rep ExecutionStatistics x -> ExecutionStatistics
forall x. ExecutionStatistics -> Rep ExecutionStatistics x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExecutionStatistics -> Rep ExecutionStatistics x
from :: forall x. ExecutionStatistics -> Rep ExecutionStatistics x
$cto :: forall x. Rep ExecutionStatistics x -> ExecutionStatistics
to :: forall x. Rep ExecutionStatistics x -> ExecutionStatistics
Generic)

instance ToJSON ExecutionStatistics where
  toJSON :: ExecutionStatistics -> Value
toJSON = Options -> ExecutionStatistics -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON Options
hasuraJSON