git.iko.soy/rel8
on da76712 help sign in
rel8/src/Rel8/Statement/Update.hs
83 lines 2.3 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 Data.Kind ( Type )
17import Prelude
19-- hasql
20import qualified Hasql.Encoders as Hasql
21import qualified Hasql.Statement as Hasql
23-- pretty
24import Text.PrettyPrint ( Doc, (<+>), ($$), text )
26-- rel8
27import Rel8.Expr ( Expr )
28import Rel8.Query ( Query )
29import Rel8.Schema.Name ( Selects )
30import Rel8.Schema.Table ( TableSchema(..), ppTable )
31import Rel8.Statement.Returning ( Returning, decodeReturning, ppReturning )
32import Rel8.Statement.Set ( ppSet )
33import Rel8.Statement.Using ( ppFrom )
34import Rel8.Statement.Where ( ppWhere )
36-- text
37import qualified Data.Text as Text
38import Data.Text.Encoding ( encodeUtf8 )
41-- | The constituent parts of an @UPDATE@ statement.
42type Update :: Type -> Type
43data Update a where
44 Update :: Selects names exprs =>
45 { target :: TableSchema names
46 -- ^ Which table to update.
47 , from :: Query from
48 -- ^ @FROM@ clause — this can be used to join against other tables,
49 -- and its results can be referenced in the @SET@ and @WHERE@ clauses.
50 , set :: from -> exprs -> exprs
51 -- ^ How to update each selected row.
52 , updateWhere :: from -> exprs -> Expr Bool
53 -- ^ Which rows to select for update.
54 , returning :: Returning names a
55 -- ^ What to return from the @UPDATE@ statement.
56 }
57 -> Update a
60ppUpdate :: Update a -> Doc
61ppUpdate Update {..} = case ppFrom from of
62 Nothing ->
63 text "UPDATE" <+> ppTable target $$
64 ppSet target id $$
65 text "WHERE false"
66 Just (fromDoc, i) ->
67 text "UPDATE" <+> ppTable target $$
68 ppSet target (set i) $$
69 fromDoc $$
70 ppWhere target (updateWhere i) $$
71 ppReturning target returning
74-- | Run an @UPDATE@ statement.
75update :: Update a -> Hasql.Statement () a
76update u@Update {returning} = Hasql.Statement bytes params decode prepare
77 where
78 bytes = encodeUtf8 $ Text.pack sql
79 params = Hasql.noParams
80 decode = decodeReturning returning
81 prepare = False
82 sql = show doc
83 doc = ppUpdate u