git.iko.soy/rel8
on 00a36f5 help sign in
rel8/src/Rel8/Statement/Delete.hs
110 lines 3.6 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.Table ( TableSchema )
33import Rel8.Statement.Returning ( Returning( NumberOfRowsAffected, Projection ) )
34import Rel8.Table ( fromColumns, toColumns )
35import Rel8.Table.Opaleye ( table, unpackspec )
36import Rel8.Table.Recontextualize ( Selects )
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.
59--
60-- >>> mapM_ print =<< select c (each projectSchema)
61-- Project {projectAuthorId = 1, projectName = "rel8"}
62-- Project {projectAuthorId = 2, projectName = "aeson"}
63-- Project {projectAuthorId = 2, projectName = "text"}
64--
65-- >>> :{
66-- delete c Delete
67-- { from = projectSchema
68-- , deleteWhere = \p -> projectName p ==. lit "rel8"
69-- , returning = Projection projectName
70-- }
71-- :}
72-- ["rel8"]
73--
74-- >>> mapM_ print =<< select c (each projectSchema)
75-- Project {projectAuthorId = 2, projectName = "aeson"}
76-- Project {projectAuthorId = 2, projectName = "text"}
77delete :: Connection -> Delete a -> IO a
78delete c Delete {from, deleteWhere, returning} =
79 case returning of
80 NumberOfRowsAffected -> Hasql.run session c >>= either throwIO pure
81 where
82 session = Hasql.statement () statement
83 statement = Hasql.Statement bytes params decode prepare
84 bytes = encodeUtf8 $ Text.pack sql
85 params = Hasql.noParams
86 decode = Hasql.rowsAffected
87 prepare = False
88 sql = Opaleye.arrangeDeleteSql from' where'
89 where
90 from' = table $ toColumns <$> from
91 where' = toColumn . toPrimExpr . deleteWhere . fromColumns
93 Projection project -> Hasql.run session c >>= either throwIO pure
94 where
95 session = Hasql.statement () statement
96 statement = Hasql.Statement bytes params decode prepare
97 bytes = encodeUtf8 $ Text.pack sql
98 params = Hasql.noParams
99 decode = decoder project
100 prepare = False
101 sql =
102 Opaleye.arrangeDeleteReturningSql unpackspec from' where' project'
103 where
104 from' = table $ toColumns <$> from
105 where' = toColumn . toPrimExpr . deleteWhere . fromColumns
106 project' = toColumns . project . fromColumns
107 where
108 decoder :: forall exprs projection a. Serializable projection a
109 => (exprs -> projection) -> Hasql.Result [a]
110 decoder _ = Hasql.rowList (parse @projection @a)