{-# LANGUAGE DeriveGeneric, DerivingVia, DeriveAnyClass #-}
module ProjectM36.SQL.Delete where
import ProjectM36.SQL.Select
import Control.DeepSeq
import Codec.Winery
import GHC.Generics

data Delete = Delete { Delete -> TableName
target :: TableName,
                       Delete -> RestrictionExpr
restriction :: RestrictionExpr
                     }
  deriving (Int -> Delete -> ShowS
[Delete] -> ShowS
Delete -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Delete] -> ShowS
$cshowList :: [Delete] -> ShowS
show :: Delete -> String
$cshow :: Delete -> String
showsPrec :: Int -> Delete -> ShowS
$cshowsPrec :: Int -> Delete -> ShowS
Show, Delete -> Delete -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Delete -> Delete -> Bool
$c/= :: Delete -> Delete -> Bool
== :: Delete -> Delete -> Bool
$c== :: Delete -> Delete -> Bool
Eq, forall x. Rep Delete x -> Delete
forall x. Delete -> Rep Delete x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Delete x -> Delete
$cfrom :: forall x. Delete -> Rep Delete x
Generic, Delete -> ()
forall a. (a -> ()) -> NFData a
rnf :: Delete -> ()
$crnf :: Delete -> ()
NFData)
  deriving Typeable Delete
BundleSerialise Delete
Extractor Delete
Decoder Delete
Proxy Delete -> SchemaGen Schema
Delete -> Builder
forall a.
Typeable a
-> (Proxy a -> SchemaGen Schema)
-> (a -> Builder)
-> Extractor a
-> Decoder a
-> BundleSerialise a
-> Serialise a
bundleSerialise :: BundleSerialise Delete
$cbundleSerialise :: BundleSerialise Delete
decodeCurrent :: Decoder Delete
$cdecodeCurrent :: Decoder Delete
extractor :: Extractor Delete
$cextractor :: Extractor Delete
toBuilder :: Delete -> Builder
$ctoBuilder :: Delete -> Builder
schemaGen :: Proxy Delete -> SchemaGen Schema
$cschemaGen :: Proxy Delete -> SchemaGen Schema
Serialise via WineryRecord Delete