git.iko.soy/rel8
on cf03bcd help sign in
rel8/src/Rel8/Statement/Delete.hs
88 lines 2.8 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 Control.Monad ( (>=>) )
17import Data.Kind ( Type )
18import Prelude
20-- hasql
21import Hasql.Connection ( Connection )
22import qualified Hasql.Decoders as Hasql
23import qualified Hasql.Encoders as Hasql
24import qualified Hasql.Session as Hasql
25import qualified Hasql.Statement as Hasql
27-- opaleye
28import qualified Opaleye.Internal.Manipulation as Opaleye
30-- rel8
31import Rel8.Expr ( Expr )
32import Rel8.Expr.Opaleye ( toColumn, toPrimExpr )
33import Rel8.Schema.Table ( TableSchema )
34import Rel8.Statement.Returning ( Returning( NumberOfRowsAffected, Projection ) )
35import Rel8.Table ( fromColumns, toColumns )
36import Rel8.Table.Opaleye ( table, unpackspec )
37import Rel8.Table.Recontextualize ( Selects )
38import Rel8.Table.Serialize ( Serializable, parse )
40-- text
41import qualified Data.Text as Text
42import Data.Text.Encoding ( encodeUtf8 )
45type Delete :: Type -> Type
46data Delete a where
47 Delete :: Selects names exprs =>
48 { from :: TableSchema names
49 , deleteWhere :: exprs -> Expr Bool
50 , returning :: Returning names a
51 }
52 -> Delete a
55delete :: Delete a -> Connection -> IO a
56delete Delete {from, deleteWhere, returning} =
57 case returning of
58 NumberOfRowsAffected -> Hasql.run session >=> either throwIO pure
59 where
60 session = Hasql.statement () statement
61 statement = Hasql.Statement bytes params decode prepare
62 bytes = encodeUtf8 $ Text.pack sql
63 params = Hasql.noParams
64 decode = Hasql.rowsAffected
65 prepare = False
66 sql = Opaleye.arrangeDeleteSql from' where'
67 where
68 from' = table $ toColumns <$> from
69 where' = toColumn . toPrimExpr . deleteWhere . fromColumns
71 Projection project -> Hasql.run session >=> either throwIO pure
72 where
73 session = Hasql.statement () statement
74 statement = Hasql.Statement bytes params decode prepare
75 bytes = encodeUtf8 $ Text.pack sql
76 params = Hasql.noParams
77 decode = decoder project
78 prepare = False
79 sql =
80 Opaleye.arrangeDeleteReturningSql unpackspec from' where' project'
81 where
82 from' = table $ toColumns <$> from
83 where' = toColumn . toPrimExpr . deleteWhere . fromColumns
84 project' = toColumns . project . fromColumns
85 where
86 decoder :: forall exprs projection a. Serializable projection a
87 => (exprs -> projection) -> Hasql.Result [a]
88 decoder _ = Hasql.rowList (parse @projection @a)