module Hasura.RQL.DML.Types
  ( OrderByExp (..),
    DMLQuery (..),
    getSourceDMLQuery,
    SelectG (..),
    Wildcard (..),
    SelCol (..),
    SelectQ,
    SelectQT,
    SelectQuery,
    SelectQueryT,
    InsObj,
    InsertQuery (..),
    OnConflict (..),
    ConflictAction (..),
    ConstraintOn (..),
    UpdVals,
    UpdateQuery (..),
    DeleteQuery (..),
    CountQuery (..),
    QueryT (..),
  )
where

import Data.Aeson
import Data.Aeson.Casing
import Data.Attoparsec.Text qualified as AT
import Data.HashMap.Strict qualified as HashMap
import Hasura.Backends.Postgres.Instances.Types ()
import Hasura.Backends.Postgres.SQL.DML qualified as Postgres
import Hasura.Backends.Postgres.SQL.Types
import Hasura.Prelude
import Hasura.RQL.IR.BoolExp
import Hasura.RQL.IR.OrderBy
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common

newtype OrderByExp = OrderByExp {OrderByExp -> [OrderByItem ('Postgres 'Vanilla)]
getOrderByItems :: [OrderByItem ('Postgres 'Vanilla)]}
  deriving (Int -> OrderByExp -> ShowS
[OrderByExp] -> ShowS
OrderByExp -> String
(Int -> OrderByExp -> ShowS)
-> (OrderByExp -> String)
-> ([OrderByExp] -> ShowS)
-> Show OrderByExp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OrderByExp -> ShowS
showsPrec :: Int -> OrderByExp -> ShowS
$cshow :: OrderByExp -> String
show :: OrderByExp -> String
$cshowList :: [OrderByExp] -> ShowS
showList :: [OrderByExp] -> ShowS
Show, OrderByExp -> OrderByExp -> Bool
(OrderByExp -> OrderByExp -> Bool)
-> (OrderByExp -> OrderByExp -> Bool) -> Eq OrderByExp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OrderByExp -> OrderByExp -> Bool
== :: OrderByExp -> OrderByExp -> Bool
$c/= :: OrderByExp -> OrderByExp -> Bool
/= :: OrderByExp -> OrderByExp -> Bool
Eq)

instance FromJSON OrderByExp where
  parseJSON :: Value -> Parser OrderByExp
parseJSON = \case
    String Text
s -> [OrderByItem ('Postgres 'Vanilla)] -> OrderByExp
OrderByExp ([OrderByItem ('Postgres 'Vanilla)] -> OrderByExp)
-> (OrderByItem ('Postgres 'Vanilla)
    -> [OrderByItem ('Postgres 'Vanilla)])
-> OrderByItem ('Postgres 'Vanilla)
-> OrderByExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrderByItem ('Postgres 'Vanilla)
-> [OrderByItem ('Postgres 'Vanilla)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OrderByItem ('Postgres 'Vanilla) -> OrderByExp)
-> Parser (OrderByItem ('Postgres 'Vanilla)) -> Parser OrderByExp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parser (OrderByItem ('Postgres 'Vanilla))
parseString Text
s
    Object Object
o -> [OrderByItem ('Postgres 'Vanilla)] -> OrderByExp
OrderByExp ([OrderByItem ('Postgres 'Vanilla)] -> OrderByExp)
-> (OrderByItem ('Postgres 'Vanilla)
    -> [OrderByItem ('Postgres 'Vanilla)])
-> OrderByItem ('Postgres 'Vanilla)
-> OrderByExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrderByItem ('Postgres 'Vanilla)
-> [OrderByItem ('Postgres 'Vanilla)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OrderByItem ('Postgres 'Vanilla) -> OrderByExp)
-> Parser (OrderByItem ('Postgres 'Vanilla)) -> Parser OrderByExp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser (OrderByItem ('Postgres 'Vanilla))
forall {a} {b :: BackendType}.
(FromJSON a, FromJSON (BasicOrderType b),
 FromJSON (NullsOrderType b)) =>
Object -> Parser (OrderByItemG b a)
parseObject Object
o
    Array Array
a ->
      [OrderByItem ('Postgres 'Vanilla)] -> OrderByExp
OrderByExp ([OrderByItem ('Postgres 'Vanilla)] -> OrderByExp)
-> Parser [OrderByItem ('Postgres 'Vanilla)] -> Parser OrderByExp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value]
-> (Value -> Parser (OrderByItem ('Postgres 'Vanilla)))
-> Parser [OrderByItem ('Postgres 'Vanilla)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Array -> [Value]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
a) \case
        String Text
s -> Text -> Parser (OrderByItem ('Postgres 'Vanilla))
parseString Text
s
        Object Object
o -> Object -> Parser (OrderByItem ('Postgres 'Vanilla))
forall {a} {b :: BackendType}.
(FromJSON a, FromJSON (BasicOrderType b),
 FromJSON (NullsOrderType b)) =>
Object -> Parser (OrderByItemG b a)
parseObject Object
o
        Value
_ -> String -> Parser (OrderByItem ('Postgres 'Vanilla))
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expecting an object or string for order by"
    Value
_ -> String -> Parser OrderByExp
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expecting : array/string/object"
    where
      parseString :: Text -> Parser (OrderByItem ('Postgres 'Vanilla))
parseString Text
s =
        Parser (OrderByItem ('Postgres 'Vanilla))
-> Text -> Either String (OrderByItem ('Postgres 'Vanilla))
forall a. Parser a -> Text -> Either String a
AT.parseOnly Parser (OrderByItem ('Postgres 'Vanilla))
orderByParser Text
s
          Either String (OrderByItem ('Postgres 'Vanilla))
-> (String -> Parser (OrderByItem ('Postgres 'Vanilla)))
-> Parser (OrderByItem ('Postgres 'Vanilla))
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
`onLeft` Parser (OrderByItem ('Postgres 'Vanilla))
-> String -> Parser (OrderByItem ('Postgres 'Vanilla))
forall a b. a -> b -> a
const (String -> Parser (OrderByItem ('Postgres 'Vanilla))
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"string format for 'order_by' entry : {+/-}column Eg : +posted")
      parseObject :: Object -> Parser (OrderByItemG b a)
parseObject Object
o =
        Maybe (BasicOrderType b)
-> a -> Maybe (NullsOrderType b) -> OrderByItemG b a
forall (b :: BackendType) a.
Maybe (BasicOrderType b)
-> a -> Maybe (NullsOrderType b) -> OrderByItemG b a
OrderByItemG
          (Maybe (BasicOrderType b)
 -> a -> Maybe (NullsOrderType b) -> OrderByItemG b a)
-> Parser (Maybe (BasicOrderType b))
-> Parser (a -> Maybe (NullsOrderType b) -> OrderByItemG b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o
          Object -> Key -> Parser (Maybe (BasicOrderType b))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"type"
          Parser (a -> Maybe (NullsOrderType b) -> OrderByItemG b a)
-> Parser a
-> Parser (Maybe (NullsOrderType b) -> OrderByItemG b a)
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 a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"column"
          Parser (Maybe (NullsOrderType b) -> OrderByItemG b a)
-> Parser (Maybe (NullsOrderType b)) -> Parser (OrderByItemG b a)
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 (NullsOrderType b))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"nulls"
      orderByParser :: Parser (OrderByItem ('Postgres 'Vanilla))
orderByParser =
        Maybe (BasicOrderType ('Postgres 'Vanilla))
-> OrderByCol
-> Maybe (NullsOrderType ('Postgres 'Vanilla))
-> OrderByItem ('Postgres 'Vanilla)
Maybe OrderType
-> OrderByCol
-> Maybe NullsOrder
-> OrderByItem ('Postgres 'Vanilla)
forall (b :: BackendType) a.
Maybe (BasicOrderType b)
-> a -> Maybe (NullsOrderType b) -> OrderByItemG b a
OrderByItemG
          (Maybe OrderType
 -> OrderByCol
 -> Maybe NullsOrder
 -> OrderByItem ('Postgres 'Vanilla))
-> Parser Text (Maybe OrderType)
-> Parser
     Text
     (OrderByCol
      -> Maybe NullsOrder -> OrderByItem ('Postgres 'Vanilla))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text (Maybe OrderType)
orderTypeParser
          Parser
  Text
  (OrderByCol
   -> Maybe NullsOrder -> OrderByItem ('Postgres 'Vanilla))
-> Parser Text OrderByCol
-> Parser
     Text (Maybe NullsOrder -> OrderByItem ('Postgres 'Vanilla))
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text OrderByCol
orderColumnParser
          Parser Text (Maybe NullsOrder -> OrderByItem ('Postgres 'Vanilla))
-> Parser Text (Maybe NullsOrder)
-> Parser (OrderByItem ('Postgres 'Vanilla))
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe NullsOrder -> Parser Text (Maybe NullsOrder)
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe NullsOrder
forall a. Maybe a
Nothing
      orderTypeParser :: Parser Text (Maybe OrderType)
orderTypeParser =
        [Parser Text (Maybe OrderType)] -> Parser Text (Maybe OrderType)
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice
          [ Parser Text Text
"+" Parser Text Text
-> Parser Text (Maybe OrderType) -> Parser Text (Maybe OrderType)
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe OrderType -> Parser Text (Maybe OrderType)
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OrderType -> Maybe OrderType
forall a. a -> Maybe a
Just OrderType
Postgres.OTAsc),
            Parser Text Text
"-" Parser Text Text
-> Parser Text (Maybe OrderType) -> Parser Text (Maybe OrderType)
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe OrderType -> Parser Text (Maybe OrderType)
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OrderType -> Maybe OrderType
forall a. a -> Maybe a
Just OrderType
Postgres.OTDesc),
            Maybe OrderType -> Parser Text (Maybe OrderType)
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe OrderType
forall a. Maybe a
Nothing
          ]
      orderColumnParser :: Parser Text OrderByCol
orderColumnParser = Parser Text Text
AT.takeText Parser Text Text
-> (Text -> Parser Text OrderByCol) -> Parser Text OrderByCol
forall a b. Parser Text a -> (a -> Parser Text b) -> Parser Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Parser Text OrderByCol
forall (m :: * -> *). MonadFail m => Text -> m OrderByCol
orderByColFromTxt

data DMLQuery a
  = DMLQuery SourceName QualifiedTable a
  deriving (Int -> DMLQuery a -> ShowS
[DMLQuery a] -> ShowS
DMLQuery a -> String
(Int -> DMLQuery a -> ShowS)
-> (DMLQuery a -> String)
-> ([DMLQuery a] -> ShowS)
-> Show (DMLQuery a)
forall a. Show a => Int -> DMLQuery a -> ShowS
forall a. Show a => [DMLQuery a] -> ShowS
forall a. Show a => DMLQuery a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> DMLQuery a -> ShowS
showsPrec :: Int -> DMLQuery a -> ShowS
$cshow :: forall a. Show a => DMLQuery a -> String
show :: DMLQuery a -> String
$cshowList :: forall a. Show a => [DMLQuery a] -> ShowS
showList :: [DMLQuery a] -> ShowS
Show, DMLQuery a -> DMLQuery a -> Bool
(DMLQuery a -> DMLQuery a -> Bool)
-> (DMLQuery a -> DMLQuery a -> Bool) -> Eq (DMLQuery a)
forall a. Eq a => DMLQuery a -> DMLQuery a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => DMLQuery a -> DMLQuery a -> Bool
== :: DMLQuery a -> DMLQuery a -> Bool
$c/= :: forall a. Eq a => DMLQuery a -> DMLQuery a -> Bool
/= :: DMLQuery a -> DMLQuery a -> Bool
Eq)

instance (FromJSON a) => FromJSON (DMLQuery a) where
  parseJSON :: Value -> Parser (DMLQuery a)
parseJSON = String
-> (Object -> Parser (DMLQuery a)) -> Value -> Parser (DMLQuery a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"query" \Object
o ->
    SourceName -> QualifiedTable -> a -> DMLQuery a
forall a. SourceName -> QualifiedTable -> a -> DMLQuery a
DMLQuery
      (SourceName -> QualifiedTable -> a -> DMLQuery a)
-> Parser SourceName -> Parser (QualifiedTable -> a -> DMLQuery a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o
      Object -> Key -> Parser (Maybe SourceName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"source"
      Parser (Maybe SourceName) -> SourceName -> Parser SourceName
forall a. Parser (Maybe a) -> a -> Parser a
.!= SourceName
defaultSource
      Parser (QualifiedTable -> a -> DMLQuery a)
-> Parser QualifiedTable -> Parser (a -> DMLQuery a)
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 QualifiedTable
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"table"
      Parser (a -> DMLQuery a) -> Parser a -> Parser (DMLQuery a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)

getSourceDMLQuery :: forall a. DMLQuery a -> SourceName
getSourceDMLQuery :: forall a. DMLQuery a -> SourceName
getSourceDMLQuery (DMLQuery SourceName
source QualifiedTable
_ a
_) = SourceName
source

data SelectG a b c = SelectG
  { forall a b c. SelectG a b c -> [a]
sqColumns :: [a], -- Postgres columns and relationships
    forall a b c. SelectG a b c -> Maybe b
sqWhere :: Maybe b, -- Filter
    forall a b c. SelectG a b c -> Maybe OrderByExp
sqOrderBy :: Maybe OrderByExp, -- Ordering
    forall a b c. SelectG a b c -> Maybe c
sqLimit :: Maybe c, -- Limit
    forall a b c. SelectG a b c -> Maybe c
sqOffset :: Maybe c -- Offset
  }
  deriving (Int -> SelectG a b c -> ShowS
[SelectG a b c] -> ShowS
SelectG a b c -> String
(Int -> SelectG a b c -> ShowS)
-> (SelectG a b c -> String)
-> ([SelectG a b c] -> ShowS)
-> Show (SelectG a b c)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b c.
(Show a, Show b, Show c) =>
Int -> SelectG a b c -> ShowS
forall a b c. (Show a, Show b, Show c) => [SelectG a b c] -> ShowS
forall a b c. (Show a, Show b, Show c) => SelectG a b c -> String
$cshowsPrec :: forall a b c.
(Show a, Show b, Show c) =>
Int -> SelectG a b c -> ShowS
showsPrec :: Int -> SelectG a b c -> ShowS
$cshow :: forall a b c. (Show a, Show b, Show c) => SelectG a b c -> String
show :: SelectG a b c -> String
$cshowList :: forall a b c. (Show a, Show b, Show c) => [SelectG a b c] -> ShowS
showList :: [SelectG a b c] -> ShowS
Show, (forall x. SelectG a b c -> Rep (SelectG a b c) x)
-> (forall x. Rep (SelectG a b c) x -> SelectG a b c)
-> Generic (SelectG a b c)
forall x. Rep (SelectG a b c) x -> SelectG a b c
forall x. SelectG a b c -> Rep (SelectG a b c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b c x. Rep (SelectG a b c) x -> SelectG a b c
forall a b c x. SelectG a b c -> Rep (SelectG a b c) x
$cfrom :: forall a b c x. SelectG a b c -> Rep (SelectG a b c) x
from :: forall x. SelectG a b c -> Rep (SelectG a b c) x
$cto :: forall a b c x. Rep (SelectG a b c) x -> SelectG a b c
to :: forall x. Rep (SelectG a b c) x -> SelectG a b c
Generic, SelectG a b c -> SelectG a b c -> Bool
(SelectG a b c -> SelectG a b c -> Bool)
-> (SelectG a b c -> SelectG a b c -> Bool) -> Eq (SelectG a b c)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b c.
(Eq a, Eq b, Eq c) =>
SelectG a b c -> SelectG a b c -> Bool
$c== :: forall a b c.
(Eq a, Eq b, Eq c) =>
SelectG a b c -> SelectG a b c -> Bool
== :: SelectG a b c -> SelectG a b c -> Bool
$c/= :: forall a b c.
(Eq a, Eq b, Eq c) =>
SelectG a b c -> SelectG a b c -> Bool
/= :: SelectG a b c -> SelectG a b c -> Bool
Eq)

instance (FromJSON a, FromJSON b, FromJSON c) => FromJSON (SelectG a b c) where
  parseJSON :: Value -> Parser (SelectG a b c)
parseJSON = Options -> Value -> Parser (SelectG a b c)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
hasuraJSON {omitNothingFields :: Bool
omitNothingFields = Bool
True}

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

parseWildcard :: AT.Parser Wildcard
parseWildcard :: Parser Wildcard
parseWildcard =
  [Wildcard] -> Wildcard
fromList ([Wildcard] -> Wildcard)
-> Parser Text [Wildcard] -> Parser Wildcard
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Parser Wildcard
starParser Parser Wildcard -> Parser Text Char -> Parser Text [Wildcard]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`AT.sepBy1` Char -> Parser Text Char
AT.char Char
'.') Parser Text [Wildcard] -> Parser Text () -> Parser Text [Wildcard]
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
AT.endOfInput)
  where
    starParser :: Parser Wildcard
starParser = Char -> Parser Text Char
AT.char Char
'*' Parser Text Char -> Parser Wildcard -> Parser Wildcard
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Wildcard -> Parser Wildcard
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Wildcard
Star
    fromList :: [Wildcard] -> Wildcard
fromList = (Wildcard -> Wildcard -> Wildcard) -> [Wildcard] -> Wildcard
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\Wildcard
_ Wildcard
x -> Wildcard -> Wildcard
StarDot Wildcard
x)

-- Columns in RQL
data SelCol
  = SCStar Wildcard
  | SCExtSimple PGCol
  | SCExtRel RelName (Maybe RelName) SelectQ
  deriving (Int -> SelCol -> ShowS
[SelCol] -> ShowS
SelCol -> String
(Int -> SelCol -> ShowS)
-> (SelCol -> String) -> ([SelCol] -> ShowS) -> Show SelCol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SelCol -> ShowS
showsPrec :: Int -> SelCol -> ShowS
$cshow :: SelCol -> String
show :: SelCol -> String
$cshowList :: [SelCol] -> ShowS
showList :: [SelCol] -> ShowS
Show, SelCol -> SelCol -> Bool
(SelCol -> SelCol -> Bool)
-> (SelCol -> SelCol -> Bool) -> Eq SelCol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SelCol -> SelCol -> Bool
== :: SelCol -> SelCol -> Bool
$c/= :: SelCol -> SelCol -> Bool
/= :: SelCol -> SelCol -> Bool
Eq)

instance FromJSON SelCol where
  parseJSON :: Value -> Parser SelCol
parseJSON (String Text
s) =
    case Parser Wildcard -> Text -> Either String Wildcard
forall a. Parser a -> Text -> Either String a
AT.parseOnly Parser Wildcard
parseWildcard Text
s of
      Left String
_ -> PGCol -> SelCol
SCExtSimple (PGCol -> SelCol) -> Parser PGCol -> Parser SelCol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser PGCol
forall a. FromJSON a => Value -> Parser a
parseJSON (Text -> Value
String Text
s)
      Right Wildcard
x -> SelCol -> Parser SelCol
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (SelCol -> Parser SelCol) -> SelCol -> Parser SelCol
forall a b. (a -> b) -> a -> b
$ Wildcard -> SelCol
SCStar Wildcard
x
  parseJSON v :: Value
v@(Object Object
o) =
    RelName -> Maybe RelName -> SelectQ -> SelCol
SCExtRel
      (RelName -> Maybe RelName -> SelectQ -> SelCol)
-> Parser RelName -> Parser (Maybe RelName -> SelectQ -> SelCol)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o
      Object -> Key -> Parser RelName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      Parser (Maybe RelName -> SelectQ -> SelCol)
-> Parser (Maybe RelName) -> Parser (SelectQ -> SelCol)
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 RelName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"alias"
      Parser (SelectQ -> SelCol) -> Parser SelectQ -> Parser SelCol
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser SelectQ
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
  parseJSON Value
_ =
    String -> Parser SelCol
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
      (String -> Parser SelCol) -> String -> Parser SelCol
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat
        [ String
"A column should either be a string or an ",
          String
"object (relationship)"
        ]

type SelectQ = SelectG SelCol (BoolExp ('Postgres 'Vanilla)) Int

type SelectQT = SelectG SelCol (BoolExp ('Postgres 'Vanilla)) Value

type SelectQuery = DMLQuery SelectQ

type SelectQueryT = DMLQuery SelectQT

type InsObj b = ColumnValues b Value

data ConflictAction
  = CAIgnore
  | CAUpdate
  deriving (Int -> ConflictAction -> ShowS
[ConflictAction] -> ShowS
ConflictAction -> String
(Int -> ConflictAction -> ShowS)
-> (ConflictAction -> String)
-> ([ConflictAction] -> ShowS)
-> Show ConflictAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConflictAction -> ShowS
showsPrec :: Int -> ConflictAction -> ShowS
$cshow :: ConflictAction -> String
show :: ConflictAction -> String
$cshowList :: [ConflictAction] -> ShowS
showList :: [ConflictAction] -> ShowS
Show, ConflictAction -> ConflictAction -> Bool
(ConflictAction -> ConflictAction -> Bool)
-> (ConflictAction -> ConflictAction -> Bool) -> Eq ConflictAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConflictAction -> ConflictAction -> Bool
== :: ConflictAction -> ConflictAction -> Bool
$c/= :: ConflictAction -> ConflictAction -> Bool
/= :: ConflictAction -> ConflictAction -> Bool
Eq)

instance FromJSON ConflictAction where
  parseJSON :: Value -> Parser ConflictAction
parseJSON (String Text
"ignore") = ConflictAction -> Parser ConflictAction
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ConflictAction
CAIgnore
  parseJSON (String Text
"update") = ConflictAction -> Parser ConflictAction
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ConflictAction
CAUpdate
  parseJSON Value
_ = String -> Parser ConflictAction
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expecting 'ignore' or 'update'"

newtype ConstraintOn = ConstraintOn {ConstraintOn -> [PGCol]
getPGCols :: [PGCol]}
  deriving (Int -> ConstraintOn -> ShowS
[ConstraintOn] -> ShowS
ConstraintOn -> String
(Int -> ConstraintOn -> ShowS)
-> (ConstraintOn -> String)
-> ([ConstraintOn] -> ShowS)
-> Show ConstraintOn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConstraintOn -> ShowS
showsPrec :: Int -> ConstraintOn -> ShowS
$cshow :: ConstraintOn -> String
show :: ConstraintOn -> String
$cshowList :: [ConstraintOn] -> ShowS
showList :: [ConstraintOn] -> ShowS
Show, ConstraintOn -> ConstraintOn -> Bool
(ConstraintOn -> ConstraintOn -> Bool)
-> (ConstraintOn -> ConstraintOn -> Bool) -> Eq ConstraintOn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConstraintOn -> ConstraintOn -> Bool
== :: ConstraintOn -> ConstraintOn -> Bool
$c/= :: ConstraintOn -> ConstraintOn -> Bool
/= :: ConstraintOn -> ConstraintOn -> Bool
Eq)

instance FromJSON ConstraintOn where
  parseJSON :: Value -> Parser ConstraintOn
parseJSON v :: Value
v@(String Text
_) =
    [PGCol] -> ConstraintOn
ConstraintOn ([PGCol] -> ConstraintOn)
-> (PGCol -> [PGCol]) -> PGCol -> ConstraintOn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PGCol -> [PGCol] -> [PGCol]
forall a. a -> [a] -> [a]
: []) (PGCol -> ConstraintOn) -> Parser PGCol -> Parser ConstraintOn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser PGCol
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
  parseJSON v :: Value
v@(Array Array
_) =
    [PGCol] -> ConstraintOn
ConstraintOn ([PGCol] -> ConstraintOn) -> Parser [PGCol] -> Parser ConstraintOn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser [PGCol]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
  parseJSON Value
_ =
    String -> Parser ConstraintOn
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
      String
"Expecting String or Array"

data OnConflict = OnConflict
  { OnConflict -> Maybe ConstraintOn
ocConstraintOn :: Maybe ConstraintOn,
    OnConflict -> Maybe ConstraintName
ocConstraint :: Maybe ConstraintName,
    OnConflict -> ConflictAction
ocAction :: ConflictAction
  }
  deriving (Int -> OnConflict -> ShowS
[OnConflict] -> ShowS
OnConflict -> String
(Int -> OnConflict -> ShowS)
-> (OnConflict -> String)
-> ([OnConflict] -> ShowS)
-> Show OnConflict
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OnConflict -> ShowS
showsPrec :: Int -> OnConflict -> ShowS
$cshow :: OnConflict -> String
show :: OnConflict -> String
$cshowList :: [OnConflict] -> ShowS
showList :: [OnConflict] -> ShowS
Show, (forall x. OnConflict -> Rep OnConflict x)
-> (forall x. Rep OnConflict x -> OnConflict) -> Generic OnConflict
forall x. Rep OnConflict x -> OnConflict
forall x. OnConflict -> Rep OnConflict x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OnConflict -> Rep OnConflict x
from :: forall x. OnConflict -> Rep OnConflict x
$cto :: forall x. Rep OnConflict x -> OnConflict
to :: forall x. Rep OnConflict x -> OnConflict
Generic, OnConflict -> OnConflict -> Bool
(OnConflict -> OnConflict -> Bool)
-> (OnConflict -> OnConflict -> Bool) -> Eq OnConflict
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OnConflict -> OnConflict -> Bool
== :: OnConflict -> OnConflict -> Bool
$c/= :: OnConflict -> OnConflict -> Bool
/= :: OnConflict -> OnConflict -> Bool
Eq)

instance FromJSON OnConflict where
  parseJSON :: Value -> Parser OnConflict
parseJSON = Options -> Value -> Parser OnConflict
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
hasuraJSON {omitNothingFields :: Bool
omitNothingFields = Bool
True}

data InsertQuery = InsertQuery
  { InsertQuery -> QualifiedTable
iqTable :: QualifiedTable,
    InsertQuery -> SourceName
iqSource :: SourceName,
    InsertQuery -> Value
iqObjects :: Value,
    InsertQuery -> Maybe OnConflict
iqOnConflict :: Maybe OnConflict,
    InsertQuery -> Maybe [PGCol]
iqReturning :: Maybe [PGCol]
  }
  deriving (Int -> InsertQuery -> ShowS
[InsertQuery] -> ShowS
InsertQuery -> String
(Int -> InsertQuery -> ShowS)
-> (InsertQuery -> String)
-> ([InsertQuery] -> ShowS)
-> Show InsertQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InsertQuery -> ShowS
showsPrec :: Int -> InsertQuery -> ShowS
$cshow :: InsertQuery -> String
show :: InsertQuery -> String
$cshowList :: [InsertQuery] -> ShowS
showList :: [InsertQuery] -> ShowS
Show, InsertQuery -> InsertQuery -> Bool
(InsertQuery -> InsertQuery -> Bool)
-> (InsertQuery -> InsertQuery -> Bool) -> Eq InsertQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InsertQuery -> InsertQuery -> Bool
== :: InsertQuery -> InsertQuery -> Bool
$c/= :: InsertQuery -> InsertQuery -> Bool
/= :: InsertQuery -> InsertQuery -> Bool
Eq)

instance FromJSON InsertQuery where
  parseJSON :: Value -> Parser InsertQuery
parseJSON = String
-> (Object -> Parser InsertQuery) -> Value -> Parser InsertQuery
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"insert query" ((Object -> Parser InsertQuery) -> Value -> Parser InsertQuery)
-> (Object -> Parser InsertQuery) -> Value -> Parser InsertQuery
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    QualifiedTable
-> SourceName
-> Value
-> Maybe OnConflict
-> Maybe [PGCol]
-> InsertQuery
InsertQuery
      (QualifiedTable
 -> SourceName
 -> Value
 -> Maybe OnConflict
 -> Maybe [PGCol]
 -> InsertQuery)
-> Parser QualifiedTable
-> Parser
     (SourceName
      -> Value -> Maybe OnConflict -> Maybe [PGCol] -> InsertQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o
      Object -> Key -> Parser QualifiedTable
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"table"
      Parser
  (SourceName
   -> Value -> Maybe OnConflict -> Maybe [PGCol] -> InsertQuery)
-> Parser SourceName
-> Parser
     (Value -> Maybe OnConflict -> Maybe [PGCol] -> InsertQuery)
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 SourceName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"source"
      Parser (Maybe SourceName) -> SourceName -> Parser SourceName
forall a. Parser (Maybe a) -> a -> Parser a
.!= SourceName
defaultSource
      Parser (Value -> Maybe OnConflict -> Maybe [PGCol] -> InsertQuery)
-> Parser Value
-> Parser (Maybe OnConflict -> Maybe [PGCol] -> InsertQuery)
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 Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"objects"
      Parser (Maybe OnConflict -> Maybe [PGCol] -> InsertQuery)
-> Parser (Maybe OnConflict)
-> Parser (Maybe [PGCol] -> InsertQuery)
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 OnConflict)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"on_conflict"
      Parser (Maybe [PGCol] -> InsertQuery)
-> Parser (Maybe [PGCol]) -> Parser InsertQuery
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 [PGCol])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"returning"

type UpdVals b = ColumnValues b Value

data UpdateQuery = UpdateQuery
  { UpdateQuery -> QualifiedTable
uqTable :: QualifiedTable,
    UpdateQuery -> SourceName
uqSource :: SourceName,
    UpdateQuery -> BoolExp ('Postgres 'Vanilla)
uqWhere :: BoolExp ('Postgres 'Vanilla),
    UpdateQuery -> UpdVals ('Postgres 'Vanilla)
uqSet :: UpdVals ('Postgres 'Vanilla),
    UpdateQuery -> UpdVals ('Postgres 'Vanilla)
uqInc :: UpdVals ('Postgres 'Vanilla),
    UpdateQuery -> UpdVals ('Postgres 'Vanilla)
uqMul :: UpdVals ('Postgres 'Vanilla),
    UpdateQuery -> [PGCol]
uqDefault :: [PGCol],
    UpdateQuery -> Maybe [PGCol]
uqReturning :: Maybe [PGCol]
  }
  deriving (Int -> UpdateQuery -> ShowS
[UpdateQuery] -> ShowS
UpdateQuery -> String
(Int -> UpdateQuery -> ShowS)
-> (UpdateQuery -> String)
-> ([UpdateQuery] -> ShowS)
-> Show UpdateQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpdateQuery -> ShowS
showsPrec :: Int -> UpdateQuery -> ShowS
$cshow :: UpdateQuery -> String
show :: UpdateQuery -> String
$cshowList :: [UpdateQuery] -> ShowS
showList :: [UpdateQuery] -> ShowS
Show, UpdateQuery -> UpdateQuery -> Bool
(UpdateQuery -> UpdateQuery -> Bool)
-> (UpdateQuery -> UpdateQuery -> Bool) -> Eq UpdateQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpdateQuery -> UpdateQuery -> Bool
== :: UpdateQuery -> UpdateQuery -> Bool
$c/= :: UpdateQuery -> UpdateQuery -> Bool
/= :: UpdateQuery -> UpdateQuery -> Bool
Eq)

instance FromJSON UpdateQuery where
  parseJSON :: Value -> Parser UpdateQuery
parseJSON = String
-> (Object -> Parser UpdateQuery) -> Value -> Parser UpdateQuery
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"update query" \Object
o ->
    QualifiedTable
-> SourceName
-> BoolExp ('Postgres 'Vanilla)
-> UpdVals ('Postgres 'Vanilla)
-> UpdVals ('Postgres 'Vanilla)
-> UpdVals ('Postgres 'Vanilla)
-> [PGCol]
-> Maybe [PGCol]
-> UpdateQuery
QualifiedTable
-> SourceName
-> BoolExp ('Postgres 'Vanilla)
-> HashMap PGCol Value
-> HashMap PGCol Value
-> HashMap PGCol Value
-> [PGCol]
-> Maybe [PGCol]
-> UpdateQuery
UpdateQuery
      (QualifiedTable
 -> SourceName
 -> BoolExp ('Postgres 'Vanilla)
 -> HashMap PGCol Value
 -> HashMap PGCol Value
 -> HashMap PGCol Value
 -> [PGCol]
 -> Maybe [PGCol]
 -> UpdateQuery)
-> Parser QualifiedTable
-> Parser
     (SourceName
      -> BoolExp ('Postgres 'Vanilla)
      -> HashMap PGCol Value
      -> HashMap PGCol Value
      -> HashMap PGCol Value
      -> [PGCol]
      -> Maybe [PGCol]
      -> UpdateQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o
      Object -> Key -> Parser QualifiedTable
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"table"
      Parser
  (SourceName
   -> BoolExp ('Postgres 'Vanilla)
   -> HashMap PGCol Value
   -> HashMap PGCol Value
   -> HashMap PGCol Value
   -> [PGCol]
   -> Maybe [PGCol]
   -> UpdateQuery)
-> Parser SourceName
-> Parser
     (BoolExp ('Postgres 'Vanilla)
      -> HashMap PGCol Value
      -> HashMap PGCol Value
      -> HashMap PGCol Value
      -> [PGCol]
      -> Maybe [PGCol]
      -> UpdateQuery)
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 SourceName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"source"
      Parser (Maybe SourceName) -> SourceName -> Parser SourceName
forall a. Parser (Maybe a) -> a -> Parser a
.!= SourceName
defaultSource
      Parser
  (BoolExp ('Postgres 'Vanilla)
   -> HashMap PGCol Value
   -> HashMap PGCol Value
   -> HashMap PGCol Value
   -> [PGCol]
   -> Maybe [PGCol]
   -> UpdateQuery)
-> Parser (BoolExp ('Postgres 'Vanilla))
-> Parser
     (HashMap PGCol Value
      -> HashMap PGCol Value
      -> HashMap PGCol Value
      -> [PGCol]
      -> Maybe [PGCol]
      -> UpdateQuery)
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 (BoolExp ('Postgres 'Vanilla))
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"where"
      Parser
  (HashMap PGCol Value
   -> HashMap PGCol Value
   -> HashMap PGCol Value
   -> [PGCol]
   -> Maybe [PGCol]
   -> UpdateQuery)
-> Parser (HashMap PGCol Value)
-> Parser
     (HashMap PGCol Value
      -> HashMap PGCol Value -> [PGCol] -> Maybe [PGCol] -> UpdateQuery)
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 (HashMap PGCol Value))
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"$set" Parser (Maybe (HashMap PGCol Value))
-> Parser (Maybe (HashMap PGCol Value))
-> Parser (Maybe (HashMap PGCol Value))
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
o Object -> Key -> Parser (Maybe (HashMap PGCol Value))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"values") Parser (Maybe (HashMap PGCol Value))
-> HashMap PGCol Value -> Parser (HashMap PGCol Value)
forall a. Parser (Maybe a) -> a -> Parser a
.!= HashMap PGCol Value
forall k v. HashMap k v
HashMap.empty)
      Parser
  (HashMap PGCol Value
   -> HashMap PGCol Value -> [PGCol] -> Maybe [PGCol] -> UpdateQuery)
-> Parser (HashMap PGCol Value)
-> Parser
     (HashMap PGCol Value -> [PGCol] -> Maybe [PGCol] -> UpdateQuery)
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 (HashMap PGCol Value))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"$inc" Parser (Maybe (HashMap PGCol Value))
-> HashMap PGCol Value -> Parser (HashMap PGCol Value)
forall a. Parser (Maybe a) -> a -> Parser a
.!= HashMap PGCol Value
forall k v. HashMap k v
HashMap.empty)
      Parser
  (HashMap PGCol Value -> [PGCol] -> Maybe [PGCol] -> UpdateQuery)
-> Parser (HashMap PGCol Value)
-> Parser ([PGCol] -> Maybe [PGCol] -> UpdateQuery)
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 (HashMap PGCol Value))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"$mul" Parser (Maybe (HashMap PGCol Value))
-> HashMap PGCol Value -> Parser (HashMap PGCol Value)
forall a. Parser (Maybe a) -> a -> Parser a
.!= HashMap PGCol Value
forall k v. HashMap k v
HashMap.empty)
      Parser ([PGCol] -> Maybe [PGCol] -> UpdateQuery)
-> Parser [PGCol] -> Parser (Maybe [PGCol] -> UpdateQuery)
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 [PGCol])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"$default"
      Parser (Maybe [PGCol]) -> [PGCol] -> Parser [PGCol]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
      Parser (Maybe [PGCol] -> UpdateQuery)
-> Parser (Maybe [PGCol]) -> Parser UpdateQuery
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 [PGCol])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"returning"

data DeleteQuery = DeleteQuery
  { DeleteQuery -> QualifiedTable
doTable :: QualifiedTable,
    DeleteQuery -> SourceName
doSource :: SourceName,
    DeleteQuery -> BoolExp ('Postgres 'Vanilla)
doWhere :: BoolExp ('Postgres 'Vanilla), -- where clause
    DeleteQuery -> Maybe [PGCol]
doReturning :: Maybe [PGCol] -- columns returning
  }
  deriving (Int -> DeleteQuery -> ShowS
[DeleteQuery] -> ShowS
DeleteQuery -> String
(Int -> DeleteQuery -> ShowS)
-> (DeleteQuery -> String)
-> ([DeleteQuery] -> ShowS)
-> Show DeleteQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeleteQuery -> ShowS
showsPrec :: Int -> DeleteQuery -> ShowS
$cshow :: DeleteQuery -> String
show :: DeleteQuery -> String
$cshowList :: [DeleteQuery] -> ShowS
showList :: [DeleteQuery] -> ShowS
Show, DeleteQuery -> DeleteQuery -> Bool
(DeleteQuery -> DeleteQuery -> Bool)
-> (DeleteQuery -> DeleteQuery -> Bool) -> Eq DeleteQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeleteQuery -> DeleteQuery -> Bool
== :: DeleteQuery -> DeleteQuery -> Bool
$c/= :: DeleteQuery -> DeleteQuery -> Bool
/= :: DeleteQuery -> DeleteQuery -> Bool
Eq)

instance FromJSON DeleteQuery where
  parseJSON :: Value -> Parser DeleteQuery
parseJSON = String
-> (Object -> Parser DeleteQuery) -> Value -> Parser DeleteQuery
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"delete query" ((Object -> Parser DeleteQuery) -> Value -> Parser DeleteQuery)
-> (Object -> Parser DeleteQuery) -> Value -> Parser DeleteQuery
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    QualifiedTable
-> SourceName
-> BoolExp ('Postgres 'Vanilla)
-> Maybe [PGCol]
-> DeleteQuery
DeleteQuery
      (QualifiedTable
 -> SourceName
 -> BoolExp ('Postgres 'Vanilla)
 -> Maybe [PGCol]
 -> DeleteQuery)
-> Parser QualifiedTable
-> Parser
     (SourceName
      -> BoolExp ('Postgres 'Vanilla) -> Maybe [PGCol] -> DeleteQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o
      Object -> Key -> Parser QualifiedTable
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"table"
      Parser
  (SourceName
   -> BoolExp ('Postgres 'Vanilla) -> Maybe [PGCol] -> DeleteQuery)
-> Parser SourceName
-> Parser
     (BoolExp ('Postgres 'Vanilla) -> Maybe [PGCol] -> DeleteQuery)
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 SourceName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"source"
      Parser (Maybe SourceName) -> SourceName -> Parser SourceName
forall a. Parser (Maybe a) -> a -> Parser a
.!= SourceName
defaultSource
      Parser
  (BoolExp ('Postgres 'Vanilla) -> Maybe [PGCol] -> DeleteQuery)
-> Parser (BoolExp ('Postgres 'Vanilla))
-> Parser (Maybe [PGCol] -> DeleteQuery)
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 (BoolExp ('Postgres 'Vanilla))
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"where"
      Parser (Maybe [PGCol] -> DeleteQuery)
-> Parser (Maybe [PGCol]) -> Parser DeleteQuery
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 [PGCol])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"returning"

data CountQuery = CountQuery
  { CountQuery -> QualifiedTable
cqTable :: QualifiedTable,
    CountQuery -> SourceName
cqSource :: SourceName,
    CountQuery -> Maybe [PGCol]
cqDistinct :: Maybe [PGCol],
    CountQuery -> Maybe (BoolExp ('Postgres 'Vanilla))
cqWhere :: Maybe (BoolExp ('Postgres 'Vanilla))
  }
  deriving (Int -> CountQuery -> ShowS
[CountQuery] -> ShowS
CountQuery -> String
(Int -> CountQuery -> ShowS)
-> (CountQuery -> String)
-> ([CountQuery] -> ShowS)
-> Show CountQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CountQuery -> ShowS
showsPrec :: Int -> CountQuery -> ShowS
$cshow :: CountQuery -> String
show :: CountQuery -> String
$cshowList :: [CountQuery] -> ShowS
showList :: [CountQuery] -> ShowS
Show, CountQuery -> CountQuery -> Bool
(CountQuery -> CountQuery -> Bool)
-> (CountQuery -> CountQuery -> Bool) -> Eq CountQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CountQuery -> CountQuery -> Bool
== :: CountQuery -> CountQuery -> Bool
$c/= :: CountQuery -> CountQuery -> Bool
/= :: CountQuery -> CountQuery -> Bool
Eq)

instance FromJSON CountQuery where
  parseJSON :: Value -> Parser CountQuery
parseJSON = String
-> (Object -> Parser CountQuery) -> Value -> Parser CountQuery
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"count query" ((Object -> Parser CountQuery) -> Value -> Parser CountQuery)
-> (Object -> Parser CountQuery) -> Value -> Parser CountQuery
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    QualifiedTable
-> SourceName
-> Maybe [PGCol]
-> Maybe (BoolExp ('Postgres 'Vanilla))
-> CountQuery
CountQuery
      (QualifiedTable
 -> SourceName
 -> Maybe [PGCol]
 -> Maybe (BoolExp ('Postgres 'Vanilla))
 -> CountQuery)
-> Parser QualifiedTable
-> Parser
     (SourceName
      -> Maybe [PGCol]
      -> Maybe (BoolExp ('Postgres 'Vanilla))
      -> CountQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o
      Object -> Key -> Parser QualifiedTable
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"table"
      Parser
  (SourceName
   -> Maybe [PGCol]
   -> Maybe (BoolExp ('Postgres 'Vanilla))
   -> CountQuery)
-> Parser SourceName
-> Parser
     (Maybe [PGCol]
      -> Maybe (BoolExp ('Postgres 'Vanilla)) -> CountQuery)
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 SourceName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"source"
      Parser (Maybe SourceName) -> SourceName -> Parser SourceName
forall a. Parser (Maybe a) -> a -> Parser a
.!= SourceName
defaultSource
      Parser
  (Maybe [PGCol]
   -> Maybe (BoolExp ('Postgres 'Vanilla)) -> CountQuery)
-> Parser (Maybe [PGCol])
-> Parser (Maybe (BoolExp ('Postgres 'Vanilla)) -> CountQuery)
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 [PGCol])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"distinct"
      Parser (Maybe (BoolExp ('Postgres 'Vanilla)) -> CountQuery)
-> Parser (Maybe (BoolExp ('Postgres 'Vanilla)))
-> Parser CountQuery
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 (BoolExp ('Postgres 'Vanilla)))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"where"

data QueryT
  = QTInsert InsertQuery
  | QTSelect SelectQueryT
  | QTUpdate UpdateQuery
  | QTDelete DeleteQuery
  | QTCount CountQuery
  | QTBulk [QueryT]
  deriving (Int -> QueryT -> ShowS
[QueryT] -> ShowS
QueryT -> String
(Int -> QueryT -> ShowS)
-> (QueryT -> String) -> ([QueryT] -> ShowS) -> Show QueryT
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueryT -> ShowS
showsPrec :: Int -> QueryT -> ShowS
$cshow :: QueryT -> String
show :: QueryT -> String
$cshowList :: [QueryT] -> ShowS
showList :: [QueryT] -> ShowS
Show, (forall x. QueryT -> Rep QueryT x)
-> (forall x. Rep QueryT x -> QueryT) -> Generic QueryT
forall x. Rep QueryT x -> QueryT
forall x. QueryT -> Rep QueryT x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. QueryT -> Rep QueryT x
from :: forall x. QueryT -> Rep QueryT x
$cto :: forall x. Rep QueryT x -> QueryT
to :: forall x. Rep QueryT x -> QueryT
Generic, QueryT -> QueryT -> Bool
(QueryT -> QueryT -> Bool)
-> (QueryT -> QueryT -> Bool) -> Eq QueryT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QueryT -> QueryT -> Bool
== :: QueryT -> QueryT -> Bool
$c/= :: QueryT -> QueryT -> Bool
/= :: QueryT -> QueryT -> Bool
Eq)

instance FromJSON QueryT where
  parseJSON :: Value -> Parser QueryT
parseJSON =
    Options -> Value -> Parser QueryT
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      Options
defaultOptions
        { constructorTagModifier :: ShowS
constructorTagModifier = ShowS
snakeCase ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
2,
          sumEncoding :: SumEncoding
sumEncoding = String -> String -> SumEncoding
TaggedObject String
"type" String
"args"
        }