git.iko.soy/rel8
on 5a45f67 help sign in
rel8/src/Rel8/Schema/Insert.hs
164 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 PolyKinds #-}
10{-# language StandaloneKindSignatures #-}
11{-# language TypeFamilies #-}
12{-# language UndecidableInstances #-}
13{-# language UndecidableSuperClasses #-}
15module Rel8.Schema.Insert
16 ( Insert(..)
17 , OnConflict(..)
18 , Col( I, unI )
19 , Inserts
20 , Create(..)
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), KnownNecessity )
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.Identity ( HIdentity( HIdentity ) )
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 I :: {unI :: !(Create necessity a)} -> Col Insert ('Spec labels necessity a)
85type Create :: Necessity -> Type -> Type
86data Create necessity a where
87 Default :: Create 'Optional a
88 Value :: Expr a -> Create necessity a
91instance (KnownNecessity necessity, Sql DBType a) =>
92 Table Insert (Create necessity a)
93 where
94 type Columns (Create necessity a) = HIdentity ('Spec '[] necessity a)
95 type Context (Create necessity a) = Insert
97 toColumns = HIdentity . I
98 fromColumns (HIdentity (I a)) = a
99 reify = notReify
100 unreify = notReify
103instance Sql DBType a =>
104 Recontextualize Aggregate Insert (Aggregate (Expr a)) (Create 'Required a)
107instance Sql DBType a => Recontextualize Expr Insert (Expr a) (Create 'Required a)
110instance Sql DBType a =>
111 Recontextualize Result Insert (Identity a) (Create 'Required a)
114instance Sql DBType a =>
115 Recontextualize Insert Aggregate (Create 'Required a) (Aggregate (Expr a))
118instance Sql DBType a => Recontextualize Insert Expr (Create 'Required a) (Expr a)
121instance Sql DBType a =>
122 Recontextualize Insert Result (Create 'Required a) (Identity a)
125instance Sql DBType a => Recontextualize Insert Insert (Create 'Required a) (Create 'Required a)
128instance Sql DBType a => Recontextualize Insert Name (Create 'Required a) (Name a)
131instance Sql DBType a => Recontextualize Name Insert (Name a) (Create 'Required a)
134instance Labelable Insert where
135 labeler (I a) = I a
136 unlabeler (I a) = I a
139instance Nullifiable Insert where
140 encodeTag = I . Value . expr
142 decodeTag (I (Value a)) = fromExpr a
144 nullifier Tag {expr} test SSpec {nullity} = \case
145 I Default -> I Default
146 I (Value a) -> I $ Value $ runTag nullity condition a
147 where
148 condition = test expr
150 unnullifier SSpec {nullity} = \case
151 I Default -> I Default
152 I (Value a) -> I $ Value $ unnull nullity a
154 {-# INLINABLE encodeTag #-}
155 {-# INLINABLE decodeTag #-}
156 {-# INLINABLE nullifier #-}
157 {-# INLINABLE unnullifier #-}
160-- | @Inserts a b@ means that the columns in @a@ are compatible for inserting
161-- with the table @b@.
162type Inserts :: Type -> Type -> Constraint
163class Recontextualize Expr Insert exprs inserts => Inserts exprs inserts
164instance Recontextualize Expr Insert exprs inserts => Inserts exprs inserts