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