git.iko.soy/rel8
on 09e449b help sign in
rel8/src/Rel8/Schema/Insert.hs
160 lines 4.7 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 StandaloneKindSignatures #-}
10{-# language TypeFamilies #-}
11{-# language UndecidableInstances #-}
12{-# language UndecidableSuperClasses #-}
14module Rel8.Schema.Insert
15 ( Insert(..)
16 , OnConflict(..)
17 , Col( RequiredInsert, OptionalInsert )
18 , Insertion(..)
19 , Inserts
20 )
21where
23-- base
24import Data.Functor.Identity ( Identity )
25import Data.Kind ( Constraint, Type )
26import Prelude
28-- rel8
29import Rel8.Aggregate ( Aggregate )
30import Rel8.Expr ( Expr )
31import Rel8.Kind.Necessity ( Necessity(Optional, Required) )
32import Rel8.Schema.Context ( Interpretation(..) )
33import Rel8.Schema.Context.Label ( Labelable(..) )
34import Rel8.Schema.Context.Nullify
35 ( Nullifiable, encodeTag, decodeTag, nullifier, unnullifier
36 , runTag, unnull
37 )
38import Rel8.Schema.HTable.Type ( HType(HType) )
39import qualified Rel8.Schema.Kind as K
40import Rel8.Schema.Name ( Name, Selects )
41import Rel8.Schema.Null ( Sql )
42import Rel8.Schema.Spec ( SSpec(SSpec, nullity), Spec(Spec) )
43import Rel8.Schema.Table ( TableSchema )
44import Rel8.Statement.Returning ( Returning )
45import Rel8.Table ( Table(..) )
46import Rel8.Table.Recontextualize ( Recontextualize )
47import Rel8.Table.Tag ( Tag(..), fromExpr )
48import Rel8.Type ( DBType )
51-- | @OnConflict@ allows you to add an @ON CONFLICT@ clause to an @INSERT@
52-- statement.
53data OnConflict
54 = Abort -- ^ @ON CONFLICT ABORT@
55 | DoNothing -- ^ @ON CONFLICT DO NOTHING@
58-- | The constituent parts of a SQL @INSERT@ statement.
59type Insert :: K.Context
60data Insert a where
61 Insert :: (Selects names exprs, Inserts exprs inserts) =>
62 { into :: TableSchema names
63 -- ^ Which table to insert into.
64 , rows :: [inserts]
65 -- ^ The rows to insert.
66 , onConflict :: OnConflict
67 -- ^ What to do if the inserted rows conflict with data already in the
68 -- table.
69 , returning :: Returning names a
70 -- ^ What information to return on completion.
71 }
72 -> Insert a
75instance Interpretation Insert where
76 data Col Insert _spec where
77 RequiredInsert :: Expr a -> Col Insert ('Spec labels 'Required a)
78 OptionalInsert :: Maybe (Expr a) -> Col Insert ('Spec labels 'Optional a)
81type Insertion :: K.Context
82newtype Insertion a = Insertion (Expr a)
85instance Sql DBType a => Table Insert (Insertion a) where
86 type Columns (Insertion a) = HType a
87 type Context (Insertion a) = Insert
89 toColumns (Insertion a) = HType (RequiredInsert a)
90 fromColumns (HType (RequiredInsert a)) = Insertion a
93instance Sql DBType a =>
94 Recontextualize Aggregate Insert (Aggregate (Expr a)) (Insertion a)
97instance Sql DBType a => Recontextualize Expr Insert (Expr a) (Insertion a)
100instance Sql DBType a =>
101 Recontextualize Identity Insert (Identity a) (Insertion a)
104instance Sql DBType a =>
105 Recontextualize Insert Aggregate (Insertion a) (Aggregate (Expr a))
108instance Sql DBType a => Recontextualize Insert Expr (Insertion a) (Expr a)
111instance Sql DBType a =>
112 Recontextualize Insert Identity (Insertion a) (Identity a)
115instance Sql DBType a => Recontextualize Insert Insert (Insertion a) (Insertion a)
118instance Sql DBType a => Recontextualize Insert Name (Insertion a) (Name a)
121instance Sql DBType a => Recontextualize Name Insert (Name a) (Insertion a)
124instance Labelable Insert where
125 labeler = \case
126 RequiredInsert a -> RequiredInsert a
127 OptionalInsert ma -> OptionalInsert ma
129 unlabeler = \case
130 RequiredInsert a -> RequiredInsert a
131 OptionalInsert ma -> OptionalInsert ma
134instance Nullifiable Insert where
135 encodeTag = RequiredInsert . expr
136 decodeTag (RequiredInsert a) = fromExpr a
138 nullifier Tag {expr} test SSpec {nullity} = \case
139 RequiredInsert a ->
140 RequiredInsert $ runTag nullity condition a
141 OptionalInsert ma ->
142 OptionalInsert $ runTag nullity condition <$> ma
143 where
144 condition = test expr
146 unnullifier SSpec {nullity} = \case
147 RequiredInsert a -> RequiredInsert $ unnull nullity a
148 OptionalInsert ma -> OptionalInsert $ unnull nullity <$> ma
150 {-# INLINABLE encodeTag #-}
151 {-# INLINABLE decodeTag #-}
152 {-# INLINABLE nullifier #-}
153 {-# INLINABLE unnullifier #-}
156-- | @Inserts a b@ means that the columns in @a@ are compatible for inserting
157-- with the table @b@.
158type Inserts :: Type -> Type -> Constraint
159class Recontextualize Expr Insert exprs inserts => Inserts exprs inserts
160instance Recontextualize Expr Insert exprs inserts => Inserts exprs inserts