git.iko.soy/rel8
on 1276beb help sign in
rel8/src/Rel8/Schema/Insert.hs
161 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( 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.Result ( Result )
43import Rel8.Schema.Spec ( SSpec(SSpec, nullity), Spec(Spec) )
44import Rel8.Schema.Table ( TableSchema )
45import Rel8.Statement.Returning ( Returning )
46import Rel8.Table ( Table(..) )
47import Rel8.Table.Recontextualize ( Recontextualize )
48import Rel8.Table.Tag ( Tag(..), fromExpr )
49import Rel8.Type ( DBType )
52-- | @OnConflict@ allows you to add an @ON CONFLICT@ clause to an @INSERT@
53-- statement.
54data OnConflict
55 = Abort -- ^ @ON CONFLICT ABORT@
56 | DoNothing -- ^ @ON CONFLICT DO NOTHING@
59-- | The constituent parts of a SQL @INSERT@ statement.
60type Insert :: k -> Type
61data Insert a where
62 Insert :: (Selects names exprs, Inserts exprs inserts) =>
63 { into :: TableSchema names
64 -- ^ Which table to insert into.
65 , rows :: [inserts]
66 -- ^ The rows to insert.
67 , onConflict :: OnConflict
68 -- ^ What to do if the inserted rows conflict with data already in the
69 -- table.
70 , returning :: Returning names a
71 -- ^ What information to return on completion.
72 }
73 -> Insert a
76instance Interpretation Insert where
77 data Col Insert _spec where
78 RequiredInsert :: Expr a -> Col Insert ('Spec labels 'Required a)
79 OptionalInsert :: Maybe (Expr a) -> Col Insert ('Spec labels 'Optional a)
82type Insertion :: Type -> Type
83newtype Insertion a = Insertion (Expr a)
86instance Sql DBType a => Table Insert (Insertion a) where
87 type Columns (Insertion a) = HType a
88 type Context (Insertion a) = Insert
90 toColumns (Insertion a) = HType (RequiredInsert a)
91 fromColumns (HType (RequiredInsert a)) = Insertion a
94instance Sql DBType a =>
95 Recontextualize Aggregate Insert (Aggregate (Expr a)) (Insertion a)
98instance Sql DBType a => Recontextualize Expr Insert (Expr a) (Insertion a)
101instance Sql DBType a =>
102 Recontextualize Result Insert (Identity a) (Insertion a)
105instance Sql DBType a =>
106 Recontextualize Insert Aggregate (Insertion a) (Aggregate (Expr a))
109instance Sql DBType a => Recontextualize Insert Expr (Insertion a) (Expr a)
112instance Sql DBType a =>
113 Recontextualize Insert Result (Insertion a) (Identity a)
116instance Sql DBType a => Recontextualize Insert Insert (Insertion a) (Insertion a)
119instance Sql DBType a => Recontextualize Insert Name (Insertion a) (Name a)
122instance Sql DBType a => Recontextualize Name Insert (Name a) (Insertion a)
125instance Labelable Insert where
126 labeler = \case
127 RequiredInsert a -> RequiredInsert a
128 OptionalInsert ma -> OptionalInsert ma
130 unlabeler = \case
131 RequiredInsert a -> RequiredInsert a
132 OptionalInsert ma -> OptionalInsert ma
135instance Nullifiable Insert where
136 encodeTag = RequiredInsert . expr
137 decodeTag (RequiredInsert a) = fromExpr a
139 nullifier Tag {expr} test SSpec {nullity} = \case
140 RequiredInsert a ->
141 RequiredInsert $ runTag nullity condition a
142 OptionalInsert ma ->
143 OptionalInsert $ runTag nullity condition <$> ma
144 where
145 condition = test expr
147 unnullifier SSpec {nullity} = \case
148 RequiredInsert a -> RequiredInsert $ unnull nullity a
149 OptionalInsert ma -> OptionalInsert $ unnull nullity <$> ma
151 {-# INLINABLE encodeTag #-}
152 {-# INLINABLE decodeTag #-}
153 {-# INLINABLE nullifier #-}
154 {-# INLINABLE unnullifier #-}
157-- | @Inserts a b@ means that the columns in @a@ are compatible for inserting
158-- with the table @b@.
159type Inserts :: Type -> Type -> Constraint
160class Recontextualize Expr Insert exprs inserts => Inserts exprs inserts
161instance Recontextualize Expr Insert exprs inserts => Inserts exprs inserts