git.iko.soy/rel8
on 13eac89 help sign in
rel8/src/Rel8/Statement/Insert.hs
106 lines 3.2 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 )
45type Insert :: Type -> Type
46data Insert a where
47 Insert :: (Selects names exprs, Inserts exprs inserts) =>
48 { into :: TableSchema names
49 , rows :: [inserts]
50 , onConflict :: OnConflict
51 , returning :: Returning names a
52 }
53 -> Insert a
56data OnConflict = Abort | DoNothing
59insert :: Insert a -> Connection -> IO a
60insert Insert {into, rows, onConflict, returning} =
61 case (rows, returning) of
62 ([], NumberOfRowsAffected) -> const $ pure 0
63 ([], Projection _) -> const $ pure []
65 (x:xs, NumberOfRowsAffected) -> Hasql.run session >=> either throwIO pure
66 where
67 session = Hasql.statement () statement
68 statement = Hasql.Statement bytes params decode prepare
69 bytes = encodeUtf8 $ Text.pack sql
70 params = Hasql.noParams
71 decode = Hasql.rowsAffected
72 prepare = False
73 sql = Opaleye.arrangeInsertManySql into' rows' onConflict'
74 where
75 into' = table $ toColumns <$> into
76 rows' = toColumns <$> x :| xs
78 (x:xs, Projection project) -> Hasql.run session >=> either throwIO pure
79 where
80 session = Hasql.statement () statement
81 statement = Hasql.Statement bytes params decode prepare
82 bytes = encodeUtf8 $ Text.pack sql
83 params = Hasql.noParams
84 decode = decoder project
85 prepare = False
86 sql =
87 Opaleye.arrangeInsertManyReturningSql
88 unpackspec
89 into'
90 rows'
91 project'
92 onConflict'
93 where
94 into' = table $ toColumns <$> into
95 rows' = toColumns <$> x :| xs
96 project' = toColumns . project . fromColumns
98 where
99 onConflict' =
100 case onConflict of
101 DoNothing -> Just Opaleye.DoNothing
102 Abort -> Nothing
104 decoder :: forall exprs projection a. Serializable projection a
105 => (exprs -> projection) -> Hasql.Result [a]
106 decoder _ = Hasql.rowList (parse @projection @a)