{-# LANGUAGE DeriveGeneric, DerivingVia, DeriveAnyClass #-}
module ProjectM36.SQL.Update where
import ProjectM36.SQL.Select
import ProjectM36.Serialise.Base ()
import Control.DeepSeq
import Codec.Winery
import GHC.Generics

data Update = Update
  { Update -> TableName
target :: TableName,
--    targetAlias :: Maybe TableAlias,
    --SET
    Update -> [(UnqualifiedColumnName, ScalarExpr)]
setColumns :: [(UnqualifiedColumnName, ScalarExpr)], --we don't support multi-column SET yet
    Update -> Maybe RestrictionExpr
mRestriction :: Maybe RestrictionExpr
  }
            --RETURNING not yet supported- how would we support this anyway- we must force the update to be materialized
  deriving (Int -> Update -> ShowS
[Update] -> ShowS
Update -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Update] -> ShowS
$cshowList :: [Update] -> ShowS
show :: Update -> String
$cshow :: Update -> String
showsPrec :: Int -> Update -> ShowS
$cshowsPrec :: Int -> Update -> ShowS
Show, Update -> Update -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Update -> Update -> Bool
$c/= :: Update -> Update -> Bool
== :: Update -> Update -> Bool
$c== :: Update -> Update -> Bool
Eq, forall x. Rep Update x -> Update
forall x. Update -> Rep Update x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Update x -> Update
$cfrom :: forall x. Update -> Rep Update x
Generic, Update -> ()
forall a. (a -> ()) -> NFData a
rnf :: Update -> ()
$crnf :: Update -> ()
NFData)
  deriving Typeable Update
BundleSerialise Update
Extractor Update
Decoder Update
Proxy Update -> SchemaGen Schema
Update -> Builder
forall a.
Typeable a
-> (Proxy a -> SchemaGen Schema)
-> (a -> Builder)
-> Extractor a
-> Decoder a
-> BundleSerialise a
-> Serialise a
bundleSerialise :: BundleSerialise Update
$cbundleSerialise :: BundleSerialise Update
decodeCurrent :: Decoder Update
$cdecodeCurrent :: Decoder Update
extractor :: Extractor Update
$cextractor :: Extractor Update
toBuilder :: Update -> Builder
$ctoBuilder :: Update -> Builder
schemaGen :: Proxy Update -> SchemaGen Schema
$cschemaGen :: Proxy Update -> SchemaGen Schema
Serialise via WineryRecord Update