git.iko.soy/squeal
on dev help sign in
remove AtkeyPQ class and add default instance for MonadPQ
fded823Eitan Chatav
squeel-postgresql/src/Squeel/PostgreSQL/PQ.hs+53−49
compare with dev
unifiedsplit
@@ -1,6 +1,7 @@
1{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
1{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
2{-# LANGUAGE
2{-# LANGUAGE
3 DataKinds
3 DataKinds
4+ , DefaultSignatures
4 , FunctionalDependencies
5 , FunctionalDependencies
5 , PolyKinds
6 , PolyKinds
6 , DeriveFunctor
7 , DeriveFunctor
@@ -55,67 +56,70 @@ evalPQ (PQ pq) = fmap fst . pq
55execPQ :: Functor m => PQ db0 db1 m x -> Connection db0 -> m (Connection db1)
56execPQ :: Functor m => PQ db0 db1 m x -> Connection db0 -> m (Connection db1)
56execPQ (PQ pq) = fmap snd . pq
57execPQ (PQ pq) = fmap snd . pq
57
58
58−class AtkeyPQ pq where
59+pqAp
59−
60− pqAp
61− :: Monad m
60+ :: Monad m
62− => pq db0 db1 m (x -> y)
61+ => PQ db0 db1 m (x -> y)
63− -> pq db1 db2 m x
62+ -> PQ db1 db2 m x
64− -> pq db0 db2 m y
63+ -> PQ db0 db2 m y
65−
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+
66− pqBind
69+pqBind
67− :: Monad m
70+ :: Monad m
68− => (x -> pq db1 db2 m y)
71+ => (x -> PQ db1 db2 m y)
69− -> pq db0 db1 m x
72+ -> PQ db0 db1 m x
70− -> pq db0 db2 m y
73+ -> PQ db0 db2 m y
71−
74+pqBind f (PQ x) = PQ $ \ conn -> do
75+ (x', conn') <- x conn
76+ runPQ (f x') conn'
77+
72− pqThen
78+pqThen
73− :: Monad m
79+ :: Monad m
74− => pq db1 db2 m y
80+ => PQ db1 db2 m y
75− -> pq db0 db1 m x
81+ -> PQ db0 db1 m x
76− -> pq db0 db2 m y
82+ -> PQ db0 db2 m y
77− pqThen pq2 pq1 = pq1 & pqBind (\ _ -> pq2)
83+pqThen pq2 pq1 = pq1 & pqBind (\ _ -> pq2)
78−
84+
79− pqExec
85+pqExec
80− :: MonadBase IO io
86+ :: MonadBase IO io
81− => Definition db0 db1
87+ => Definition db0 db1
82− -> pq db0 db1 io (Maybe (Result '[]))
88+ -> PQ db0 db1 io (Maybe (Result '[]))
83−
89+pqExec (UnsafeDefinition q) = PQ $ \ (Connection conn) -> do
90+ result <- liftBase $ LibPQ.exec conn q
91+ return (Result <$> result, Connection conn)
92+
84− pqThenExec
93+pqThenExec
85− :: MonadBase IO io
94+ :: MonadBase IO io
86− => Definition db1 db2
95+ => Definition db1 db2
87− -> pq db0 db1 io x
96+ -> PQ db0 db1 io x
88− -> pq db0 db2 io (Maybe (Result '[]))
97+ -> PQ db0 db2 io (Maybe (Result '[]))
89− pqThenExec = pqThen . pqExec
98+pqThenExec = pqThen . pqExec
90−
99+
91−class MonadPQ db m | m -> db where
100+class Monad m => MonadPQ db m | m -> db where
92
101
93 pqExecParams
102 pqExecParams
94 :: (ToOids ps, AllZip HasEncoding ps xs)
103 :: (ToOids ps, AllZip HasEncoding ps xs)
95 => Manipulation db ps ys
104 => Manipulation db ps ys
96 -> NP I xs
105 -> NP I xs
97 -> m (Maybe (Result ys))
106 -> 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
98
117
99 pqExecNil
118 pqExecNil
100 :: Manipulation db '[] ys
119 :: Manipulation db '[] ys
101 -> m (Maybe (Result ys))
120 -> m (Maybe (Result ys))
102 pqExecNil statement = pqExecParams statement Nil
121 pqExecNil statement = pqExecParams statement Nil
103
122
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−
119instance MonadBase IO io => MonadPQ db (PQ db db io) where
123instance MonadBase IO io => MonadPQ db (PQ db db io) where
120
124
121 pqExecParams (UnsafeManipulation q :: Manipulation db ps ys) params =
125 pqExecParams (UnsafeManipulation q :: Manipulation db ps ys) params =