git.iko.soy/rel8
on 11bcbbb help sign in
rel8/src/Rel8/Schema/Insert.hs
160 lines 4.8 kB history raw
1{-# language DataKinds #-}
2{-# language DuplicateRecordFields #-}
3{-# language FlexibleContexts #-}
4{-# language FlexibleInstances #-}
5{-# language GADTs #-}
6{-# language LambdaCase #-}
7{-# language MultiParamTypeClasses #-}
8{-# language NamedFieldPuns #-}
9{-# language ScopedTypeVariables #-}
10{-# language StandaloneKindSignatures #-}
11{-# language TypeApplications #-}
12{-# language TypeFamilies #-}
13{-# language UndecidableInstances #-}
14{-# language UndecidableSuperClasses #-}
16module Rel8.Schema.Insert
17 ( Insert(..)
18 , OnConflict(..)
19 , Col( RequiredInsert, OptionalInsert )
20 , Insertion(..)
21 , Inserts
22 )
23where
25-- base
26import Data.Functor.Identity ( Identity )
27import Data.Kind ( Constraint, Type )
28import Prelude
30-- rel8
31import Rel8.Aggregate ( Aggregate )
32import Rel8.Expr ( Expr )
33import Rel8.Kind.Necessity ( Necessity(Optional, Required) )
34import Rel8.Opaque ( Opaque )
35import Rel8.Schema.Context ( Interpretation(..) )
36import Rel8.Schema.Context.Label ( Labelable(..) )
37import Rel8.Schema.Context.Nullify
38 ( Nullifiable, encodeTag, decodeTag, nullifier, unnullifier
39 , runTag, unnull
40 )
41import Rel8.Schema.HTable.Type ( HType(HType) )
42import qualified Rel8.Schema.Kind as K
43import Rel8.Schema.Name ( Name, Selects )
44import Rel8.Schema.Nullability ( Sql )
45import Rel8.Schema.Spec ( SSpec(SSpec, nullability), Spec(Spec) )
46import Rel8.Schema.Table ( TableSchema )
47import Rel8.Statement.Returning ( Returning )
48import Rel8.Table ( Table(..) )
49import Rel8.Table.Recontextualize ( Recontextualize )
50import Rel8.Type ( DBType )
53-- | @OnConflict@ allows you to add an @ON CONFLICT@ clause to an @INSERT@
54-- statement.
55data OnConflict
56 = Abort -- ^ @ON CONFLICT ABORT@
57 | DoNothing -- ^ @ON CONFLICT DO NOTHING@
60-- | The constituent parts of a SQL @INSERT@ statement.
61type Insert :: K.Context
62data Insert a where
63 Insert :: (Selects names exprs, Inserts exprs inserts) =>
64 { into :: TableSchema names
65 -- ^ Which table to insert into.
66 , rows :: [inserts]
67 -- ^ The rows to insert.
68 , onConflict :: OnConflict
69 -- ^ What to do if the inserted rows conflict with data already in the
70 -- table.
71 , returning :: Returning names a
72 -- ^ What information to return on completion.
73 }
74 -> Insert a
77instance Interpretation Insert where
78 data Col Insert _spec where
79 RequiredInsert :: Expr a -> Col Insert ('Spec labels 'Required a)
80 OptionalInsert :: Maybe (Expr a) -> Col Insert ('Spec labels 'Optional a)
83type Insertion :: K.Context
84newtype Insertion a = Insertion (Expr a)
87instance Sql DBType a => Table Insert (Insertion a) where
88 type Columns (Insertion a) = HType a
89 type Context (Insertion a) = Insert
91 toColumns (Insertion a) = HType (RequiredInsert a)
92 fromColumns (HType (RequiredInsert a)) = Insertion a
95instance Sql DBType a =>
96 Recontextualize Aggregate Insert (Aggregate (Expr a)) (Insertion a)
99instance Sql DBType a => Recontextualize Expr Insert (Expr a) (Insertion a)
102instance Sql DBType a =>
103 Recontextualize Identity Insert (Identity a) (Insertion a)
106instance Sql DBType a =>
107 Recontextualize Insert Aggregate (Insertion a) (Aggregate (Expr a))
110instance Sql DBType a => Recontextualize Insert Expr (Insertion a) (Expr a)
113instance Sql DBType a =>
114 Recontextualize Insert Identity (Insertion a) (Identity a)
117instance Sql DBType a => Recontextualize Insert Insert (Insertion a) (Insertion a)
120instance Sql DBType a => Recontextualize Insert Name (Insertion a) (Name a)
123instance Sql DBType a => Recontextualize Name Insert (Name a) (Insertion a)
126instance Labelable Insert where
127 labeler = \case
128 RequiredInsert a -> RequiredInsert a
129 OptionalInsert ma -> OptionalInsert ma
131 unlabeler = \case
132 RequiredInsert a -> RequiredInsert a
133 OptionalInsert ma -> OptionalInsert ma
136instance Nullifiable Insert where
137 encodeTag = RequiredInsert
138 decodeTag (RequiredInsert a) = a
140 nullifier tag SSpec {nullability} = \case
141 RequiredInsert a -> RequiredInsert $ runTag nullability tag a
142 OptionalInsert ma -> OptionalInsert $ runTag nullability tag <$> ma
144 unnullifier _ SSpec {nullability} = \case
145 RequiredInsert a -> RequiredInsert $ unnull nullability a
146 OptionalInsert ma -> OptionalInsert $ unnull nullability <$> ma
148 {-# INLINABLE encodeTag #-}
149 {-# INLINABLE decodeTag #-}
150 {-# INLINABLE nullifier #-}
151 {-# INLINABLE unnullifier #-}
155-- | @Inserts a b@ means that the columns in @a@ are compatible for inserting
156-- with the table @b@.
157type Inserts :: Type -> Type -> Constraint
158class Recontextualize Expr Insert exprs inserts => Inserts exprs inserts
159instance Recontextualize Expr Insert exprs inserts => Inserts exprs inserts
160instance {-# OVERLAPPING #-} Inserts (Opaque Expr Opaque) (Opaque Insert Opaque)