@@ -1,6 +1,7 @@
11{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
22{-# LANGUAGE
33 DataKinds
4+ , DefaultSignatures
45 , FunctionalDependencies
56 , PolyKinds
67 , DeriveFunctor
@@ -55,67 +56,70 @@ evalPQ (PQ pq) = fmap fst . pq
5556execPQ :: Functor m => PQ db0 db1 m x -> Connection db0 -> m (Connection db1)
5657execPQ (PQ pq) = fmap snd . pq
5758
58−class AtkeyPQ pq where
59−
60− pqAp
61− :: Monad m
62− => pq db0 db1 m (x -> y)
63− -> pq db1 db2 m x
64− -> pq db0 db2 m y
65−
66− pqBind
67− :: Monad m
68− => (x -> pq db1 db2 m y)
69− -> pq db0 db1 m x
70− -> pq db0 db2 m y
71−
72− pqThen
73− :: Monad m
74− => pq db1 db2 m y
75− -> pq db0 db1 m x
76− -> pq db0 db2 m y
77− pqThen pq2 pq1 = pq1 & pqBind (\ _ -> pq2)
78−
79− pqExec
80− :: MonadBase IO io
81− => Definition db0 db1
82− -> pq db0 db1 io (Maybe (Result '[]))
83−
84− pqThenExec
85− :: MonadBase IO io
86− => Definition db1 db2
87− -> pq db0 db1 io x
88− -> pq db0 db2 io (Maybe (Result '[]))
89− pqThenExec = pqThen . pqExec
90−
91−class MonadPQ db m | m -> db where
59+pqAp
60+ :: Monad m
61+ => PQ db0 db1 m (x -> y)
62+ -> PQ db1 db2 m x
63+ -> PQ db0 db2 m y
64+pqAp (PQ f) (PQ x) = PQ $ \ conn -> do
65+ (f', conn') <- f conn
66+ (x', conn'') <- x conn'
67+ return (f' x', conn'')
68+
69+pqBind
70+ :: Monad m
71+ => (x -> PQ db1 db2 m y)
72+ -> PQ db0 db1 m x
73+ -> PQ db0 db2 m y
74+pqBind f (PQ x) = PQ $ \ conn -> do
75+ (x', conn') <- x conn
76+ runPQ (f x') conn'
77+
78+pqThen
79+ :: Monad m
80+ => PQ db1 db2 m y
81+ -> PQ db0 db1 m x
82+ -> PQ db0 db2 m y
83+pqThen pq2 pq1 = pq1 & pqBind (\ _ -> pq2)
84+
85+pqExec
86+ :: MonadBase IO io
87+ => Definition db0 db1
88+ -> PQ db0 db1 io (Maybe (Result '[]))
89+pqExec (UnsafeDefinition q) = PQ $ \ (Connection conn) -> do
90+ result <- liftBase $ LibPQ.exec conn q
91+ return (Result <$> result, Connection conn)
92+
93+pqThenExec
94+ :: MonadBase IO io
95+ => Definition db1 db2
96+ -> PQ db0 db1 io x
97+ -> PQ db0 db2 io (Maybe (Result '[]))
98+pqThenExec = pqThen . pqExec
99+
100+class Monad m => MonadPQ db m | m -> db where
92101
93102 pqExecParams
94103 :: (ToOids ps, AllZip HasEncoding ps xs)
95104 => Manipulation db ps ys
96105 -> NP I xs
97106 -> m (Maybe (Result ys))
107+ default pqExecParams
108+ :: ( MonadTrans t
109+ , MonadPQ db m1
110+ , m ~ t m1
111+ , ToOids ps
112+ , AllZip HasEncoding ps xs )
113+ => Manipulation db ps ys
114+ -> NP I xs
115+ -> m (Maybe (Result ys))
116+ pqExecParams manipulation params = lift $ pqExecParams manipulation params
98117
99118 pqExecNil
100119 :: Manipulation db '[] ys
101120 -> m (Maybe (Result ys))
102121 pqExecNil statement = pqExecParams statement Nil
103122
104−instance AtkeyPQ PQ where
105−
106− pqAp (PQ f) (PQ x) = PQ $ \ conn -> do
107− (f', conn') <- f conn
108− (x', conn'') <- x conn'
109− return (f' x', conn'')
110−
111− pqBind f (PQ x) = PQ $ \ conn -> do
112− (x', conn') <- x conn
113− runPQ (f x') conn'
114−
115− pqExec (UnsafeDefinition q) = PQ $ \ (Connection conn) -> do
116− result <- liftBase $ LibPQ.exec conn q
117− return (Result <$> result, Connection conn)
118−
119123instance MonadBase IO io => MonadPQ db (PQ db db io) where
120124
121125 pqExecParams (UnsafeManipulation q :: Manipulation db ps ys) params =