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