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