git.iko.soy/rel8
on bc275dc help sign in
rel8/src/Rel8/Statement/Delete.hs
92 lines 3.0 kB history raw
1{-# language DuplicateRecordFields #-}
2{-# language GADTs #-}
3{-# language NamedFieldPuns #-}
4{-# language ScopedTypeVariables #-}
5{-# language StandaloneKindSignatures #-}
6{-# language TypeApplications #-}
8module Rel8.Statement.Delete
9 ( Delete(..)
10 , delete
11 )
12where
14-- base
15import Control.Exception ( throwIO )
16import Data.Kind ( Type )
17import Prelude
19-- hasql
20import Hasql.Connection ( Connection )
21import qualified Hasql.Decoders as Hasql
22import qualified Hasql.Encoders as Hasql
23import qualified Hasql.Session as Hasql
24import qualified Hasql.Statement as Hasql
26-- opaleye
27import qualified Opaleye.Internal.Manipulation as Opaleye
29-- rel8
30import Rel8.Expr ( Expr )
31import Rel8.Expr.Opaleye ( toColumn, toPrimExpr )
32import Rel8.Schema.Name ( Selects )
33import Rel8.Schema.Table ( TableSchema )
34import Rel8.Statement.Returning ( Returning( NumberOfRowsAffected, Projection ) )
35import Rel8.Table ( fromColumns, toColumns )
36import Rel8.Table.Opaleye ( castTable, table, unpackspec )
37import Rel8.Table.Serialize ( Serializable, parse )
39-- text
40import qualified Data.Text as Text
41import Data.Text.Encoding ( encodeUtf8 )
44-- | The constituent parts of a @DELETE@ statement.
45type Delete :: Type -> Type
46data Delete a where
47 Delete :: Selects names exprs =>
48 { from :: TableSchema names
49 -- ^ Which table to delete from.
50 , deleteWhere :: 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
58-- | Run a @DELETE@ statement.
59delete :: Connection -> Delete a -> IO a
60delete c Delete {from, deleteWhere, returning} =
61 case returning of
62 NumberOfRowsAffected -> Hasql.run session c >>= either throwIO pure
63 where
64 session = Hasql.statement () statement
65 statement = Hasql.Statement bytes params decode prepare
66 bytes = encodeUtf8 $ Text.pack sql
67 params = Hasql.noParams
68 decode = Hasql.rowsAffected
69 prepare = False
70 sql = Opaleye.arrangeDeleteSql from' where'
71 where
72 from' = table $ toColumns <$> from
73 where' = toColumn . toPrimExpr . deleteWhere . fromColumns
75 Projection project -> Hasql.run session c >>= either throwIO pure
76 where
77 session = Hasql.statement () statement
78 statement = Hasql.Statement bytes params decode prepare
79 bytes = encodeUtf8 $ Text.pack sql
80 params = Hasql.noParams
81 decode = decoder project
82 prepare = False
83 sql =
84 Opaleye.arrangeDeleteReturningSql unpackspec from' where' project'
85 where
86 from' = table $ toColumns <$> from
87 where' = toColumn . toPrimExpr . deleteWhere . fromColumns
88 project' = castTable . toColumns . project . fromColumns
89 where
90 decoder :: forall exprs projection a. Serializable projection a
91 => (exprs -> projection) -> Hasql.Result [a]
92 decoder _ = Hasql.rowList (parse @projection @a)