git.iko.soy/rel8
on 11bcbbb help sign in
rel8/src/Rel8/Statement/Insert.hs
99 lines 3.0 kB history raw
1{-# language GADTs #-}
2{-# language NamedFieldPuns #-}
3{-# language ScopedTypeVariables #-}
4{-# language TypeApplications #-}
6module Rel8.Statement.Insert
7 ( Insert(..)
8 , OnConflict(..)
9 , insert
10 )
11where
13-- base
14import Control.Exception ( throwIO )
15import Data.List.NonEmpty ( NonEmpty( (:|) ) )
16import Prelude
18-- hasql
19import Hasql.Connection ( Connection )
20import qualified Hasql.Decoders as Hasql
21import qualified Hasql.Encoders as Hasql
22import qualified Hasql.Session as Hasql
23import qualified Hasql.Statement as Hasql
25-- opaleye
26import qualified Opaleye.Internal.Manipulation as Opaleye
27import qualified Opaleye.Manipulation as Opaleye
29-- rel8
30import Rel8.Schema.Insert ( Insert(..), OnConflict(..) )
31import Rel8.Statement.Returning ( Returning( Projection, NumberOfRowsAffected ) )
32import Rel8.Table ( fromColumns, toColumns )
33import Rel8.Table.Opaleye ( table, unpackspec )
34import Rel8.Table.Serialize ( Serializable, parse )
36-- text
37import qualified Data.Text as Text ( pack )
38import Data.Text.Encoding ( encodeUtf8 )
41-- | Run an @INSERT@ statement
42--
43-- >>> :{
44-- insert c Insert
45-- { into = authorSchema
46-- , rows = [ lit Author{ authorName = "Gabriel Gonzales", authorId = AuthorId 4, authorUrl = Just "https://haskellforall.com" } ]
47-- , onConflict = Abort
48-- , returning = NumberOfRowsAffected
49-- }
50-- :}
51-- 1
52insert :: Connection -> Insert a -> IO a
53insert c Insert {into, rows, onConflict, returning} =
54 case (rows, returning) of
55 ([], NumberOfRowsAffected) -> pure 0
56 ([], Projection _) -> pure []
58 (x:xs, NumberOfRowsAffected) -> Hasql.run session c >>= either throwIO pure
59 where
60 session = Hasql.statement () statement
61 statement = Hasql.Statement bytes params decode prepare
62 bytes = encodeUtf8 $ Text.pack sql
63 params = Hasql.noParams
64 decode = Hasql.rowsAffected
65 prepare = False
66 sql = Opaleye.arrangeInsertManySql into' rows' onConflict'
67 where
68 into' = table $ toColumns <$> into
69 rows' = toColumns <$> x :| xs
71 (x:xs, Projection project) -> Hasql.run session c >>= either throwIO pure
72 where
73 session = Hasql.statement () statement
74 statement = Hasql.Statement bytes params decode prepare
75 bytes = encodeUtf8 $ Text.pack sql
76 params = Hasql.noParams
77 decode = decoder project
78 prepare = False
79 sql =
80 Opaleye.arrangeInsertManyReturningSql
81 unpackspec
82 into'
83 rows'
84 project'
85 onConflict'
86 where
87 into' = table $ toColumns <$> into
88 rows' = toColumns <$> x :| xs
89 project' = toColumns . project . fromColumns
91 where
92 onConflict' =
93 case onConflict of
94 DoNothing -> Just Opaleye.DoNothing
95 Abort -> Nothing
97 decoder :: forall exprs projection a. Serializable projection a
98 => (exprs -> projection) -> Hasql.Result [a]
99 decoder _ = Hasql.rowList (parse @projection @a)