{-# LANGUAGE DeriveGeneric, DerivingVia, DeriveAnyClass #-}
module ProjectM36.SQL.DBUpdate where
import ProjectM36.SQL.Update
import ProjectM36.SQL.Insert
import ProjectM36.SQL.Delete
import ProjectM36.SQL.CreateTable
import ProjectM36.SQL.DropTable
import Control.DeepSeq
import Codec.Winery
import GHC.Generics

-- | represents any SQL expression which can change the current transaction state such as
data DBUpdate = UpdateUpdate Update |
                UpdateInsert Insert |
                UpdateDelete Delete |
                UpdateCreateTable CreateTable |
                UpdateDropTable DropTable
  deriving (Int -> DBUpdate -> ShowS
[DBUpdate] -> ShowS
DBUpdate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DBUpdate] -> ShowS
$cshowList :: [DBUpdate] -> ShowS
show :: DBUpdate -> String
$cshow :: DBUpdate -> String
showsPrec :: Int -> DBUpdate -> ShowS
$cshowsPrec :: Int -> DBUpdate -> ShowS
Show, DBUpdate -> DBUpdate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DBUpdate -> DBUpdate -> Bool
$c/= :: DBUpdate -> DBUpdate -> Bool
== :: DBUpdate -> DBUpdate -> Bool
$c== :: DBUpdate -> DBUpdate -> Bool
Eq, forall x. Rep DBUpdate x -> DBUpdate
forall x. DBUpdate -> Rep DBUpdate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DBUpdate x -> DBUpdate
$cfrom :: forall x. DBUpdate -> Rep DBUpdate x
Generic, DBUpdate -> ()
forall a. (a -> ()) -> NFData a
rnf :: DBUpdate -> ()
$crnf :: DBUpdate -> ()
NFData)
  deriving Typeable DBUpdate
BundleSerialise DBUpdate
Extractor DBUpdate
Decoder DBUpdate
Proxy DBUpdate -> SchemaGen Schema
DBUpdate -> Builder
forall a.
Typeable a
-> (Proxy a -> SchemaGen Schema)
-> (a -> Builder)
-> Extractor a
-> Decoder a
-> BundleSerialise a
-> Serialise a
bundleSerialise :: BundleSerialise DBUpdate
$cbundleSerialise :: BundleSerialise DBUpdate
decodeCurrent :: Decoder DBUpdate
$cdecodeCurrent :: Decoder DBUpdate
extractor :: Extractor DBUpdate
$cextractor :: Extractor DBUpdate
toBuilder :: DBUpdate -> Builder
$ctoBuilder :: DBUpdate -> Builder
schemaGen :: Proxy DBUpdate -> SchemaGen Schema
$cschemaGen :: Proxy DBUpdate -> SchemaGen Schema
Serialise via WineryVariant DBUpdate