@@ -1,64 +1,65 @@
11{-# language DuplicateRecordFields #-}
2+{-# language FlexibleContexts #-}
23{-# language GADTs #-}
34{-# language NamedFieldPuns #-}
4−{-# language ScopedTypeVariables #-}
5+{-# language RecordWildCards #-}
56{-# language StandaloneKindSignatures #-}
6−{-# language TypeApplications #-}
7+{-# language StrictData #-}
78
89module Rel8.Statement.Insert
910 ( Insert(..)
10− , OnConflict(..)
1111 , insert
12+ , ppInsert
13+ , ppInto
1214 )
1315where
1416
1517-- base
1618import Control.Exception ( throwIO )
17−import Data.List.NonEmpty ( NonEmpty( (:|) ) )
19+import Data.Foldable ( toList )
1820import Data.Kind ( Type )
1921import Prelude
2022
2123-- hasql
2224import Hasql.Connection ( Connection )
23−import qualified Hasql.Decoders as Hasql
2425import qualified Hasql.Encoders as Hasql
2526import qualified Hasql.Session as Hasql
2627import qualified Hasql.Statement as Hasql
2728
2829-- opaleye
29−import qualified Opaleye.Internal.Manipulation as Opaleye
30−import qualified Opaleye.Manipulation as Opaleye
30+import qualified Opaleye.Internal.HaskellDB.Sql.Print as Opaleye
31+
32+-- pretty
33+import Text.PrettyPrint ( Doc, (<+>), ($$), parens, text )
3134
3235-- rel8
33−import Rel8.Schema.Name ( Selects )
34−import Rel8.Schema.Table ( TableSchema )
35−import Rel8.Statement.Returning ( Returning( Projection, NumberOfRowsAffected ) )
36−import Rel8.Table.Cols ( fromCols, toCols )
37−import Rel8.Table.Opaleye ( castTable, table, unpackspec )
38−import Rel8.Table.Serialize ( Serializable, parse )
36+import Rel8.Query ( Query )
37+import Rel8.Schema.Name ( Name, Selects, ppColumn )
38+import Rel8.Schema.Table ( TableSchema(..), ppTable )
39+import Rel8.Statement.OnConflict ( OnConflict, ppOnConflict )
40+import Rel8.Statement.Returning
41+ ( Returning
42+ , decodeReturning, emptyReturning, ppReturning
43+ )
44+import Rel8.Statement.Select ( ppSelect )
45+import Rel8.Table ( Table )
46+import Rel8.Table.Name ( showNames )
3947
4048-- text
4149import qualified Data.Text as Text ( pack )
4250import Data.Text.Encoding ( encodeUtf8 )
4351
4452
45−-- | @OnConflict@ allows you to add an @ON CONFLICT@ clause to an @INSERT@
46−-- statement.
47−type OnConflict :: Type
48−data OnConflict
49− = Abort -- ^ @ON CONFLICT ABORT@
50− | DoNothing -- ^ @ON CONFLICT DO NOTHING@
51−
52−
5353-- | The constituent parts of a SQL @INSERT@ statement.
5454type Insert :: Type -> Type
5555data Insert a where
5656 Insert :: Selects names exprs =>
5757 { into :: TableSchema names
5858 -- ^ Which table to insert into.
59− , rows :: [exprs]
60− -- ^ The rows to insert.
61− , onConflict :: OnConflict
59+ , rows :: Query exprs
60+ -- ^ The rows to insert. This can be an arbitrary query — use
61+ -- 'Rel8.values' insert a static list of rows.
62+ , onConflict :: OnConflict names
6263 -- ^ What to do if the inserted rows conflict with data already in the
6364 -- table.
6465 , returning :: Returning names a
@@ -67,52 +68,32 @@ data Insert a where
6768 -> Insert a
6869
6970
70−-- | Run an @INSERT@ statement
71−insert :: Connection -> Insert a -> IO a
72−insert c Insert {into, rows, onConflict, returning} =
73− case (rows, returning) of
74− ([], NumberOfRowsAffected) -> pure 0
75− ([], Projection _) -> pure []
71+ppInsert :: Insert a -> Maybe Doc
72+ppInsert Insert {..} = do
73+ rows' <- ppSelect rows
74+ pure $ text "INSERT INTO" <+> ppInto into
75+ $$ rows'
76+ $$ ppOnConflict into onConflict
77+ $$ ppReturning into returning
7678
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 $ toCols <$> into
88− rows' = toCols <$> x :| xs
8979
90− (x:xs, Projection project) -> Hasql.run session c >>= either throwIO pure
80+ppInto :: Table Name a => TableSchema a -> Doc
81+ppInto table@TableSchema {columns} =
82+ ppTable table <+>
83+ parens (Opaleye.commaV ppColumn (toList (showNames columns)))
84+
85+
86+-- | Run an 'Insert' statement.
87+insert :: Connection -> Insert a -> IO a
88+insert connection i@Insert {returning} =
89+ case show <$> ppInsert i of
90+ Nothing -> pure (emptyReturning returning)
91+ Just sql ->
92+ Hasql.run session connection >>= either throwIO pure
9193 where
9294 session = Hasql.statement () statement
9395 statement = Hasql.Statement bytes params decode prepare
9496 bytes = encodeUtf8 $ Text.pack sql
9597 params = Hasql.noParams
96− decode = decoder project
98+ decode = decodeReturning returning
9799 prepare = False
98− sql =
99− Opaleye.arrangeInsertManyReturningSql
100− unpackspec
101− into'
102− rows'
103− project'
104− onConflict'
105− where
106− into' = table $ toCols <$> into
107− rows' = toCols <$> x :| xs
108− project' = castTable . toCols . project . fromCols
109−
110− where
111− onConflict' =
112− case onConflict of
113− DoNothing -> Just Opaleye.DoNothing
114− Abort -> Nothing
115−
116− decoder :: forall exprs projection a. Serializable projection a
117− => (exprs -> projection) -> Hasql.Result [a]
118− decoder _ = Hasql.rowList (parse @projection @a)