git.iko.soy/rel8
on 134ddcf help sign in
rel8/src/Rel8/Statement/Delete.hs
111 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 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 )
45-- | The constituent parts of a @DELETE@ statement.
46type Delete :: Type -> Type
47data Delete a where
48 Delete :: Selects names exprs =>
49 { from :: TableSchema names
50 -- ^ Which table to delete from.
51 , deleteWhere :: exprs -> Expr Bool
52 -- ^ Which rows should be selected for deletion.
53 , returning :: Returning names a
54 -- ^ What to return from the @DELETE@ statement.
55 }
56 -> Delete a
59-- | Run a @DELETE@ statement.
60--
61-- >>> mapM_ print =<< select c (each projectSchema)
62-- Project {projectAuthorId = 1, projectName = "rel8"}
63-- Project {projectAuthorId = 2, projectName = "aeson"}
64-- Project {projectAuthorId = 2, projectName = "text"}
65--
66-- >>> :{
67-- delete c Delete
68-- { from = projectSchema
69-- , deleteWhere = \p -> projectName p ==. lit "rel8"
70-- , returning = Projection projectName
71-- }
72-- :}
73-- ["rel8"]
74--
75-- >>> mapM_ print =<< select c (each projectSchema)
76-- Project {projectAuthorId = 2, projectName = "aeson"}
77-- Project {projectAuthorId = 2, projectName = "text"}
78delete :: Delete a -> Connection -> IO a
79delete Delete {from, deleteWhere, returning} =
80 case returning of
81 NumberOfRowsAffected -> Hasql.run session >=> either throwIO pure
82 where
83 session = Hasql.statement () statement
84 statement = Hasql.Statement bytes params decode prepare
85 bytes = encodeUtf8 $ Text.pack sql
86 params = Hasql.noParams
87 decode = Hasql.rowsAffected
88 prepare = False
89 sql = Opaleye.arrangeDeleteSql from' where'
90 where
91 from' = table $ toColumns <$> from
92 where' = toColumn . toPrimExpr . deleteWhere . fromColumns
94 Projection project -> Hasql.run session >=> either throwIO pure
95 where
96 session = Hasql.statement () statement
97 statement = Hasql.Statement bytes params decode prepare
98 bytes = encodeUtf8 $ Text.pack sql
99 params = Hasql.noParams
100 decode = decoder project
101 prepare = False
102 sql =
103 Opaleye.arrangeDeleteReturningSql unpackspec from' where' project'
104 where
105 from' = table $ toColumns <$> from
106 where' = toColumn . toPrimExpr . deleteWhere . fromColumns
107 project' = toColumns . project . fromColumns
108 where
109 decoder :: forall exprs projection a. Serializable projection a
110 => (exprs -> projection) -> Hasql.Result [a]
111 decoder _ = Hasql.rowList (parse @projection @a)