git.iko.soy/rel8
on 137ebed help sign in
rel8/src/Rel8/Statement/Update.hs
101 lines 3.2 kB history raw
1{-# language GADTs #-}
2{-# language NamedFieldPuns #-}
3{-# language ScopedTypeVariables #-}
4{-# language StandaloneKindSignatures #-}
5{-# language TypeApplications #-}
7module Rel8.Statement.Update
8 ( Update(..)
9 , update
10 )
11where
13-- base
14import Control.Exception ( throwIO )
15import Data.Kind ( Type )
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
28-- rel8
29import Rel8.Expr ( Expr )
30import Rel8.Expr.Opaleye ( toColumn, toPrimExpr )
31import Rel8.Schema.Name ( Selects )
32import Rel8.Schema.Table ( TableSchema )
33import Rel8.Statement.Returning ( Returning( Projection, NumberOfRowsAffected ) )
34import Rel8.Table ( fromColumns, toColumns )
35import Rel8.Table.Opaleye ( castTable, table, unpackspec )
36import Rel8.Table.Serialize ( Serializable, parse )
38-- text
39import qualified Data.Text as Text
40import Data.Text.Encoding ( encodeUtf8 )
43-- | The constituent parts of an @UPDATE@ statement.
44type Update :: Type -> Type
45data Update a where
46 Update :: Selects names exprs =>
47 { target :: TableSchema names
48 -- ^ Which table to update.
49 , set :: exprs -> exprs
50 -- ^ How to update each selected row.
51 , updateWhere :: exprs -> Expr Bool
52 -- ^ Which rows to select for update.
53 , returning :: Returning names a
54 -- ^ What to return from the @UPDATE@ statement.
55 }
56 -> Update a
59-- | Run an @UPDATE@ statement.
60update :: Connection -> Update a -> IO a
61update c Update {target, set, updateWhere, returning} =
62 case returning of
63 NumberOfRowsAffected -> Hasql.run session c >>= either throwIO pure
64 where
65 session = Hasql.statement () statement
66 statement = Hasql.Statement bytes params decode prepare
67 bytes = encodeUtf8 $ Text.pack sql
68 params = Hasql.noParams
69 decode = Hasql.rowsAffected
70 prepare = False
71 sql = Opaleye.arrangeUpdateSql target' set' where'
72 where
73 target' = table $ toColumns <$> target
74 set' = toColumns . set . fromColumns
75 where' = toColumn . toPrimExpr . updateWhere . fromColumns
77 Projection project -> 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 = decoder project
84 prepare = False
85 sql =
86 Opaleye.arrangeUpdateReturningSql
87 unpackspec
88 target'
89 set'
90 where'
91 project'
92 where
93 target' = table $ toColumns <$> target
94 set' = toColumns . set . fromColumns
95 where' = toColumn . toPrimExpr . updateWhere . fromColumns
96 project' = castTable . toColumns . project . fromColumns
98 where
99 decoder :: forall exprs projection a. Serializable projection a
100 => (exprs -> projection) -> Hasql.Result [a]
101 decoder _ = Hasql.rowList (parse @projection @a)