git.iko.soy/rel8
on 00a36f5 help sign in
rel8/src/Rel8/Statement/Insert.hs
126 lines 3.9 kB history raw
1{-# language DuplicateRecordFields #-}
2{-# language FlexibleContexts #-}
3{-# language GADTs #-}
4{-# language NamedFieldPuns #-}
5{-# language ScopedTypeVariables #-}
6{-# language StandaloneKindSignatures #-}
7{-# language TypeApplications #-}
9module Rel8.Statement.Insert
10 ( Insert(..)
11 , OnConflict(..)
12 , insert
13 )
14where
16-- base
17import Control.Exception ( throwIO )
18import Data.Kind ( Type )
19import Data.List.NonEmpty ( NonEmpty( (:|) ) )
20import Prelude
22-- hasql
23import Hasql.Connection ( Connection )
24import qualified Hasql.Decoders as Hasql
25import qualified Hasql.Encoders as Hasql
26import qualified Hasql.Session as Hasql
27import qualified Hasql.Statement as Hasql
29-- rel8
30import qualified Opaleye.Internal.Manipulation as Opaleye
31import qualified Opaleye.Manipulation as Opaleye
32import Rel8.Schema.Table ( TableSchema )
33import Rel8.Statement.Returning ( Returning( Projection, NumberOfRowsAffected ) )
34import Rel8.Table ( fromColumns, toColumns )
35import Rel8.Table.Opaleye ( table, unpackspec )
36import Rel8.Table.Recontextualize ( Inserts, Selects )
37import Rel8.Table.Serialize ( Serializable, parse )
39-- text
40import qualified Data.Text as Text ( pack )
41import Data.Text.Encoding ( encodeUtf8 )
44-- | The constituent parts of a SQL @INSERT@ statement.
45type Insert :: Type -> Type
46data Insert a where
47 Insert :: (Selects names exprs, Inserts exprs inserts) =>
48 { into :: TableSchema names
49 -- ^ Which table to insert into.
50 , rows :: [inserts]
51 -- ^ The rows to insert.
52 , onConflict :: OnConflict
53 -- ^ What to do if the inserted rows conflict with data already in the
54 -- table.
55 , returning :: Returning names a
56 -- ^ What information to return on completion.
57 }
58 -> Insert a
61-- | @OnConflict@ allows you to add an @ON CONFLICT@ clause to an @INSERT@
62-- statement.
63data OnConflict
64 = Abort -- ^ @ON CONFLICT ABORT@
65 | DoNothing -- ^ @ON CONFLICT DO NOTHING@
68-- | Run an @INSERT@ statement
69--
70-- >>> :{
71-- insert c Insert
72-- { into = authorSchema
73-- , rows = [ lit Author{ authorName = "Gabriel Gonzales", authorId = AuthorId 4, authorUrl = Just "https://haskellforall.com" } ]
74-- , onConflict = Abort
75-- , returning = NumberOfRowsAffected
76-- }
77-- :}
78-- 1
79insert :: Connection -> Insert a -> IO a
80insert c Insert {into, rows, onConflict, returning} =
81 case (rows, returning) of
82 ([], NumberOfRowsAffected) -> pure 0
83 ([], Projection _) -> pure []
85 (x:xs, NumberOfRowsAffected) -> Hasql.run session c >>= either throwIO pure
86 where
87 session = Hasql.statement () statement
88 statement = Hasql.Statement bytes params decode prepare
89 bytes = encodeUtf8 $ Text.pack sql
90 params = Hasql.noParams
91 decode = Hasql.rowsAffected
92 prepare = False
93 sql = Opaleye.arrangeInsertManySql into' rows' onConflict'
94 where
95 into' = table $ toColumns <$> into
96 rows' = toColumns <$> x :| xs
98 (x:xs, Projection project) -> Hasql.run session c >>= either throwIO pure
99 where
100 session = Hasql.statement () statement
101 statement = Hasql.Statement bytes params decode prepare
102 bytes = encodeUtf8 $ Text.pack sql
103 params = Hasql.noParams
104 decode = decoder project
105 prepare = False
106 sql =
107 Opaleye.arrangeInsertManyReturningSql
108 unpackspec
109 into'
110 rows'
111 project'
112 onConflict'
113 where
114 into' = table $ toColumns <$> into
115 rows' = toColumns <$> x :| xs
116 project' = toColumns . project . fromColumns
118 where
119 onConflict' =
120 case onConflict of
121 DoNothing -> Just Opaleye.DoNothing
122 Abort -> Nothing
124 decoder :: forall exprs projection a. Serializable projection a
125 => (exprs -> projection) -> Hasql.Result [a]
126 decoder _ = Hasql.rowList (parse @projection @a)