git.iko.soy/rel8
on 6c20afa help sign in
rel8/src/Rel8/Schema/Insert.hs
167 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 PolyKinds #-}
10{-# language StandaloneKindSignatures #-}
11{-# language TypeFamilies #-}
12{-# language UndecidableInstances #-}
13{-# language UndecidableSuperClasses #-}
15module Rel8.Schema.Insert
16 ( Insert(..)
17 , OnConflict(..)
18 , Col( RequiredInsert, OptionalInsert )
19 , Inserts
20 , Insertion(..)
21 )
22where
24-- base
25import Data.Functor.Identity ( Identity )
26import Data.Kind ( Constraint, Type )
27import Prelude
29-- rel8
30import Rel8.Aggregate ( Aggregate )
31import Rel8.Expr ( Expr )
32import Rel8.Kind.Necessity ( Necessity(Optional, Required) )
33import Rel8.Schema.Context ( Interpretation(..) )
34import Rel8.Schema.Context.Label ( Labelable(..) )
35import Rel8.Schema.Context.Nullify
36 ( Nullifiable, encodeTag, decodeTag, nullifier, unnullifier
37 , runTag, unnull
38 )
39import Rel8.Schema.HTable.Type ( HType( HType ) )
40import Rel8.Schema.Name ( Name, Selects )
41import Rel8.Schema.Null ( Sql )
42import Rel8.Schema.Reify ( notReify )
43import Rel8.Schema.Result ( Result )
44import Rel8.Schema.Spec ( SSpec(SSpec, nullity), Spec(Spec) )
45import Rel8.Schema.Table ( TableSchema )
46import Rel8.Statement.Returning ( Returning )
47import Rel8.Table
48 ( Table, Context, Columns, fromColumns, toColumns
49 , reify, unreify
50 )
51import Rel8.Table.Recontextualize ( Recontextualize )
52import Rel8.Table.Tag ( Tag(..), fromExpr )
53import Rel8.Type ( DBType )
56-- | @OnConflict@ allows you to add an @ON CONFLICT@ clause to an @INSERT@
57-- statement.
58data OnConflict
59 = Abort -- ^ @ON CONFLICT ABORT@
60 | DoNothing -- ^ @ON CONFLICT DO NOTHING@
63-- | The constituent parts of a SQL @INSERT@ statement.
64type Insert :: k -> Type
65data Insert a where
66 Insert :: (Selects names exprs, Inserts exprs inserts) =>
67 { into :: TableSchema names
68 -- ^ Which table to insert into.
69 , rows :: [inserts]
70 -- ^ The rows to insert.
71 , onConflict :: OnConflict
72 -- ^ What to do if the inserted rows conflict with data already in the
73 -- table.
74 , returning :: Returning names a
75 -- ^ What information to return on completion.
76 }
77 -> Insert a
80instance Interpretation Insert where
81 data Col Insert _spec where
82 RequiredInsert :: Expr a -> Col Insert ('Spec labels 'Required a)
83 OptionalInsert :: Maybe (Expr a) -> Col Insert ('Spec labels 'Optional a)
86type Insertion :: Type -> Type
87newtype Insertion a = Insertion (Expr a)
90instance Sql DBType a => Table Insert (Insertion a) where
91 type Columns (Insertion a) = HType a
92 type Context (Insertion a) = Insert
94 toColumns (Insertion a) = HType (RequiredInsert a)
95 fromColumns (HType (RequiredInsert a)) = Insertion a
96 reify = notReify
97 unreify = notReify
100instance Sql DBType a =>
101 Recontextualize Aggregate Insert (Aggregate (Expr a)) (Insertion a)
104instance Sql DBType a => Recontextualize Expr Insert (Expr a) (Insertion a)
107instance Sql DBType a =>
108 Recontextualize Result Insert (Identity a) (Insertion a)
111instance Sql DBType a =>
112 Recontextualize Insert Aggregate (Insertion a) (Aggregate (Expr a))
115instance Sql DBType a => Recontextualize Insert Expr (Insertion a) (Expr a)
118instance Sql DBType a =>
119 Recontextualize Insert Result (Insertion a) (Identity a)
122instance Sql DBType a => Recontextualize Insert Insert (Insertion a) (Insertion a)
125instance Sql DBType a => Recontextualize Insert Name (Insertion a) (Name a)
128instance Sql DBType a => Recontextualize Name Insert (Name a) (Insertion a)
131instance Labelable Insert where
132 labeler = \case
133 RequiredInsert a -> RequiredInsert a
134 OptionalInsert ma -> OptionalInsert ma
136 unlabeler = \case
137 RequiredInsert a -> RequiredInsert a
138 OptionalInsert ma -> OptionalInsert ma
141instance Nullifiable Insert where
142 encodeTag = RequiredInsert . expr
143 decodeTag (RequiredInsert a) = fromExpr a
145 nullifier Tag {expr} test SSpec {nullity} = \case
146 RequiredInsert a ->
147 RequiredInsert $ runTag nullity condition a
148 OptionalInsert ma ->
149 OptionalInsert $ runTag nullity condition <$> ma
150 where
151 condition = test expr
153 unnullifier SSpec {nullity} = \case
154 RequiredInsert a -> RequiredInsert $ unnull nullity a
155 OptionalInsert ma -> OptionalInsert $ unnull nullity <$> ma
157 {-# INLINABLE encodeTag #-}
158 {-# INLINABLE decodeTag #-}
159 {-# INLINABLE nullifier #-}
160 {-# INLINABLE unnullifier #-}
163-- | @Inserts a b@ means that the columns in @a@ are compatible for inserting
164-- with the table @b@.
165type Inserts :: Type -> Type -> Constraint
166class Recontextualize Expr Insert exprs inserts => Inserts exprs inserts
167instance Recontextualize Expr Insert exprs inserts => Inserts exprs inserts