git.iko.soy/rel8
on 8de0eec help sign in
rel8/src/Rel8/Statement/Update.hs
91 lines 2.5 kB history raw
1{-# language DuplicateRecordFields #-}
2{-# language GADTs #-}
3{-# language NamedFieldPuns #-}
4{-# language RecordWildCards #-}
5{-# language StandaloneKindSignatures #-}
6{-# language StrictData #-}
8module Rel8.Statement.Update
9 ( Update(..)
10 , update
11 , ppUpdate
12 )
13where
15-- base
16import Control.Exception ( throwIO )
17import Data.Kind ( Type )
18import Prelude
20-- hasql
21import Hasql.Connection ( Connection )
22import qualified Hasql.Encoders as Hasql
23import qualified Hasql.Session as Hasql
24import qualified Hasql.Statement as Hasql
26-- pretty
27import Text.PrettyPrint ( Doc, (<+>), ($$), text )
29-- rel8
30import Rel8.Expr ( Expr )
31import Rel8.Query ( Query )
32import Rel8.Schema.Name ( Selects )
33import Rel8.Schema.Table ( TableSchema(..), ppTable )
34import Rel8.Statement.Returning
35 ( Returning
36 , decodeReturning, emptyReturning, ppReturning
37 )
38import Rel8.Statement.Set ( ppSet )
39import Rel8.Statement.Using ( ppFrom )
40import Rel8.Statement.Where ( ppWhere )
42-- text
43import qualified Data.Text as Text
44import Data.Text.Encoding ( encodeUtf8 )
47-- | The constituent parts of an @UPDATE@ statement.
48type Update :: Type -> Type
49data Update a where
50 Update :: Selects names exprs =>
51 { target :: TableSchema names
52 -- ^ Which table to update.
53 , from :: Query from
54 -- ^ @FROM@ clause — this can be used to join against other tables,
55 -- and its results can be referenced in the @SET@ and @WHERE@ clauses.
56 , set :: from -> exprs -> exprs
57 -- ^ How to update each selected row.
58 , updateWhere :: from -> exprs -> Expr Bool
59 -- ^ Which rows to select for update.
60 , returning :: Returning names a
61 -- ^ What to return from the @UPDATE@ statement.
62 }
63 -> Update a
66ppUpdate :: Update a -> Maybe Doc
67ppUpdate Update {..} = do
68 (fromDoc, i) <- ppFrom from
69 pure $
70 text "UPDATE" <+>
71 ppTable target $$
72 ppSet target (set i) $$
73 fromDoc $$
74 ppWhere target (updateWhere i) $$
75 ppReturning target returning
78-- | Run an @UPDATE@ statement.
79update :: Connection -> Update a -> IO a
80update connection u@Update {returning} =
81 case show <$> ppUpdate u of
82 Nothing -> pure (emptyReturning returning)
83 Just sql ->
84 Hasql.run session connection >>= either throwIO pure
85 where
86 session = Hasql.statement () statement
87 statement = Hasql.Statement bytes params decode prepare
88 bytes = encodeUtf8 $ Text.pack sql
89 params = Hasql.noParams
90 decode = decodeReturning returning
91 prepare = False