git.iko.soy/rel8
on 5d2b9e4 help sign in
rel8/src/Rel8/Statement/Insert.hs
99 lines 2.8 kB history raw
1{-# language DuplicateRecordFields #-}
2{-# language FlexibleContexts #-}
3{-# language GADTs #-}
4{-# language NamedFieldPuns #-}
5{-# language RecordWildCards #-}
6{-# language StandaloneKindSignatures #-}
7{-# language StrictData #-}
9module Rel8.Statement.Insert
10 ( Insert(..)
11 , insert
12 , ppInsert
13 , ppInto
14 )
15where
17-- base
18import Control.Exception ( throwIO )
19import Data.Foldable ( toList )
20import Data.Kind ( Type )
21import Prelude
23-- hasql
24import Hasql.Connection ( Connection )
25import qualified Hasql.Encoders as Hasql
26import qualified Hasql.Session as Hasql
27import qualified Hasql.Statement as Hasql
29-- opaleye
30import qualified Opaleye.Internal.HaskellDB.Sql.Print as Opaleye
32-- pretty
33import Text.PrettyPrint ( Doc, (<+>), ($$), parens, text )
35-- rel8
36import Rel8.Query ( Query )
37import Rel8.Schema.Name ( Name, Selects, ppColumn )
38import Rel8.Schema.Table ( TableSchema(..), ppTable )
39import Rel8.Statement.OnConflict ( OnConflict, ppOnConflict )
40import Rel8.Statement.Returning
41 ( Returning
42 , decodeReturning, emptyReturning, ppReturning
43 )
44import Rel8.Statement.Select ( ppSelect )
45import Rel8.Table ( Table )
46import Rel8.Table.Name ( showNames )
48-- text
49import qualified Data.Text as Text ( pack )
50import Data.Text.Encoding ( encodeUtf8 )
53-- | The constituent parts of a SQL @INSERT@ statement.
54type Insert :: Type -> Type
55data Insert a where
56 Insert :: Selects names exprs =>
57 { into :: TableSchema names
58 -- ^ Which table to insert into.
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
63 -- ^ What to do if the inserted rows conflict with data already in the
64 -- table.
65 , returning :: Returning names a
66 -- ^ What information to return on completion.
67 }
68 -> Insert a
71ppInsert :: Insert a -> Maybe Doc
72ppInsert Insert {..} = do
73 rows' <- ppSelect rows
74 pure $ text "INSERT INTO" <+> ppInto into
75 $$ rows'
76 $$ ppOnConflict into onConflict
77 $$ ppReturning into returning
80ppInto :: Table Name a => TableSchema a -> Doc
81ppInto table@TableSchema {columns} =
82 ppTable table <+>
83 parens (Opaleye.commaV ppColumn (toList (showNames columns)))
86-- | Run an 'Insert' statement.
87insert :: Connection -> Insert a -> IO a
88insert 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
93 where
94 session = Hasql.statement () statement
95 statement = Hasql.Statement bytes params decode prepare
96 bytes = encodeUtf8 $ Text.pack sql
97 params = Hasql.noParams
98 decode = decodeReturning returning
99 prepare = False