git.iko.soy/rel8
on 29cdfdb help sign in
rel8/src/Rel8/Statement/Delete.hs
79 lines 2.1 kB history raw
1{-# language DuplicateRecordFields #-}
2{-# language GADTs #-}
3{-# language NamedFieldPuns #-}
4{-# language RankNTypes #-}
5{-# language RecordWildCards #-}
6{-# language StandaloneKindSignatures #-}
7{-# language StrictData #-}
9module Rel8.Statement.Delete
10 ( Delete(..)
11 , delete
12 , ppDelete
13 )
14where
16-- base
17import Data.Kind ( Type )
18import Prelude
20-- hasql
21import qualified Hasql.Encoders as Hasql
22import qualified Hasql.Statement as Hasql
24-- pretty
25import Text.PrettyPrint ( Doc, (<+>), ($$), text )
27-- rel8
28import Rel8.Expr ( Expr )
29import Rel8.Query ( Query )
30import Rel8.Schema.Name ( Selects )
31import Rel8.Schema.Table ( TableSchema, ppTable )
32import Rel8.Statement.Returning ( Returning, decodeReturning, ppReturning )
33import Rel8.Statement.Using ( ppUsing )
34import Rel8.Statement.Where ( ppWhere )
36-- text
37import qualified Data.Text as Text
38import Data.Text.Encoding ( encodeUtf8 )
41-- | The constituent parts of a @DELETE@ statement.
42type Delete :: Type -> Type
43data Delete a where
44 Delete :: Selects names exprs =>
45 { from :: TableSchema names
46 -- ^ Which table to delete from.
47 , using :: Query using
48 -- ^ @USING@ clause — this can be used to join against other tables,
49 -- and its results can be referenced in the @WHERE@ clause
50 , deleteWhere :: using -> exprs -> Expr Bool
51 -- ^ Which rows should be selected for deletion.
52 , returning :: Returning names a
53 -- ^ What to return from the @DELETE@ statement.
54 }
55 -> Delete a
58ppDelete :: Delete a -> Doc
59ppDelete Delete {..} = case ppUsing using of
60 Nothing ->
61 text "DELETE FROM" <+> ppTable from $$
62 text "WHERE false"
63 Just (usingDoc, i) ->
64 text "DELETE FROM" <+> ppTable from $$
65 usingDoc $$
66 ppWhere from (deleteWhere i) $$
67 ppReturning from returning
70-- | Run a 'Delete' statement.
71delete :: Delete a -> Hasql.Statement () a
72delete d@Delete {returning} = Hasql.Statement bytes params decode prepare
73 where
74 bytes = encodeUtf8 $ Text.pack sql
75 params = Hasql.noParams
76 decode = decodeReturning returning
77 prepare = False
78 sql = show doc
79 doc = ppDelete d