git.iko.soy/squeal
on dev help sign in
getRow
35cb038Eitan Chatav
squeel-postgresql/squeel-postgresql.cabal+1
compare with dev
unifiedsplit
@@ -34,6 +34,7 @@ library
34 , scientific
34 , scientific
35 , text
35 , text
36 , time
36 , time
37+ , transformers
37 , transformers-base
38 , transformers-base
38 , uuid
39 , uuid
39
40
squeel-postgresql/src/Squeel/PostgreSQL/Binary.hs−57
@@ -82,18 +82,6 @@ instance HasDecoding 'PGTimestampTZ UTCTime where
82instance HasDecoding 'PGInterval DiffTime where
82instance HasDecoding 'PGInterval DiffTime where
83 decoding _ = Decoder.interval_int
83 decoding _ = Decoder.interval_int
84
84
85−{-
86−encodings
87− :: AllZip HasEncoding xs pgs
88− => proxy pgs
89− -> NP I xs
90− -> [ByteString]
91−encodings _ Nil = []
92−encodings (_ :: proxy pgs) (I x :* xs) =
93− case (hpure Proxy :: NP Proxy pgs) of
94− proxy :* proxies -> undefined (encoding proxy x) : encodings proxies xs
95−-}
96−
97decodings
85decodings
98 :: AllZip HasDecoding pgs xs
86 :: AllZip HasDecoding pgs xs
99 => proxy pgs
87 => proxy pgs
@@ -104,17 +92,6 @@ decodings (_ :: proxy pgs) (K bytestring :* bytestrings) =
104 proxy :* proxies -> (:*)
92 proxy :* proxies -> (:*)
105 <$> (I <$> Decoder.valueParser (decoding proxy) bytestring)
93 <$> (I <$> Decoder.valueParser (decoding proxy) bytestring)
106 <*> decodings proxies bytestrings
94 <*> decodings proxies bytestrings
107−-- instance HasDecoding pg ty => HasDecoding (column ::: 'Required ('NotNull pg)) ty where
108−-- decoding _ = decoding (proxy# :: Proxy# pg)
109−
110−-- class HasDecodings pgs xs where
111−-- decodeValues :: Proxy# pgs -> NP (K ByteString) xs -> NP (Either Text) xs
112−-- instance HasDecodings '[] '[] where decodeValues _ _ = Nil
113−-- instance (HasDecoding pg x, HasDecodings pgs xs)
114−-- => HasDecodings (pg ': pgs) (x ': xs) where
115−-- decodeValues _ (K result :* results) =
116−-- decodeValue (proxy# :: Proxy# pg) result
117−-- :* decodeValues (proxy# :: Proxy# pgs) results
118
95
119class HasEncoding x pg where
96class HasEncoding x pg where
120 encoding :: proxy pg -> x -> Encoder.Encoding
97 encoding :: proxy pg -> x -> Encoder.Encoding
@@ -171,37 +148,3 @@ encodings (_ :: proxy pgs) (I x :* xs) =
171 case (hpure Proxy :: NP Proxy pgs) of
148 case (hpure Proxy :: NP Proxy pgs) of
172 proxy :* proxies -> Encoder.encodingBytes (encoding proxy x)
149 proxy :* proxies -> Encoder.encodingBytes (encoding proxy x)
173 : encodings proxies xs
150 : encodings proxies xs
174−
175−-- class HasEncodings xs pgs where
176−-- encodings :: Proxy# pgs -> NP I xs -> [ByteString]
177−-- instance HasEncodings '[] '[] where encodings _ _ = []
178−-- instance (HasEncoding x pg, HasEncodings xs pgs)
179−-- => HasEncodings (x ': xs) (pg ': pgs) where
180−-- encodings _ (I x :* xs)
181−-- = Encoder.encodingBytes ((encoding (proxy# :: Proxy# pg)) x)
182−-- : encodings (proxy# :: Proxy# pgs) xs
183−
184−-- newtype Encoding x = Encoding { unEncoding :: x -> Encoder.Encoding }
185−-- class ToEncoding pg x where toEncoding :: Proxy pg -> Encoding x
186−
187−-- toEncodings
188−-- :: AllZip ToEncoding pgs xs
189−-- => NP Proxy pgs
190−-- -> NP Encoding xs
191−-- toEncodings = \case
192−-- Nil -> Nil
193−-- proxy :* proxies -> toEncoding proxy :* toEncodings proxies
194−--
195−-- encodeParameters' :: NP (Encoding :*: I) xs -> NP (K ByteString) xs
196−-- encodeParameters' = \case
197−-- Nil -> Nil
198−-- (Encoding enc :*: I x) :* parameters ->
199−-- K (Encoder.encodingBytes (enc x)) :* encodeParameters' parameters
200−--
201−-- encodeParameters
202−-- :: AllZip ToEncoding pgs xs
203−-- => NP Proxy pgs
204−-- -> NP I xs
205−-- -> NP (K ByteString) xs
206−-- encodeParameters proxies parameters = encodeParameters' $
207−-- hzipWith (:*:) (toEncodings proxies) parameters
squeel-postgresql/src/Squeel/PostgreSQL/PQ.hs+44−17
@@ -20,13 +20,15 @@ module Squeel.PostgreSQL.PQ where
20
20
21import Control.Exception.Lifted
21import Control.Exception.Lifted
22import Control.Monad.Base
22import Control.Monad.Base
23−import Control.Monad.Trans
23+import Control.Monad.Except
24+import Control.Monad.Trans.Maybe
24import Control.Monad.Trans.Control
25import Control.Monad.Trans.Control
25import Data.ByteString (ByteString)
26import Data.ByteString (ByteString)
27+import Data.Maybe
26import Data.Proxy (Proxy)
28import Data.Proxy (Proxy)
27import Data.Text (Text)
29import Data.Text (Text)
28import Generics.SOP
30import Generics.SOP
29−import GHC.Exts
31+import GHC.Exts hiding (fromList)
30import GHC.TypeLits
32import GHC.TypeLits
31
33
32import qualified Database.PostgreSQL.LibPQ as LibPQ
34import qualified Database.PostgreSQL.LibPQ as LibPQ
@@ -205,19 +207,44 @@ colNum4 :: ColumnNumber (c0:c1:c2:c3:c4:cs) c4
205colNum4 = colNum (proxy# :: Proxy# 4)
207colNum4 = colNum (proxy# :: Proxy# 4)
206
208
207newtype Value pgs m x = Value { runValue :: Result pgs -> m x }
209newtype Value pgs m x = Value { runValue :: Result pgs -> m x }
210+ deriving (Functor)
211+instance Applicative m => Applicative (Value pgs m) where
212+ pure x = Value $ \ _result -> pure x
213+ mf <*> mx = Value $ \ result -> runValue mf result <*> runValue mx result
214+instance Monad m => Monad (Value pgs m) where
215+ return = pure
216+ mx >>= f = Value $ \ result -> do
217+ x <- runValue mx result
218+ runValue (f x) result
219+instance MonadTrans (Value pgs) where
220+ lift m = Value $ \ _result -> m
221+instance MonadBase b m => MonadBase b (Value pgs m) where
222+ liftBase = lift . liftBase
208
223
209−-- getValue
224+getValue
210−-- :: (HasDecoding pg x, MonadBase IO io)
225+ :: (HasDecoding pg x, MonadBase IO io)
211−-- => RowNumber
226+ => RowNumber
212−-- -> ColumnNumber pgs pg
227+ -> ColumnNumber pgs pg
213−-- -> Value pgs (ExceptT Text (MaybeT io)) x
228+ -> Value pgs (ExceptT Text (MaybeT io)) x
214−
229+getValue (RowNumber r) (ColumnNumber c :: ColumnNumber pgs pg) =
215−getvalue
230+ Value $ \ (Result result) -> do
216− :: (HasDecoding x y, MonadBase IO io)
231+ maybeBytestring <- liftBase $ LibPQ.getvalue result r c
217− => Result xs
232+ case maybeBytestring of
218− -> RowNumber
233+ Nothing -> mzero
219− -> ColumnNumber xs x
220− -> io (Maybe (Either Text y))
221−getvalue (Result result) (RowNumber r) (ColumnNumber c :: ColumnNumber xs x) =
222− liftBase $ fmap (fmap (decodeValue (Proxy :: Proxy x)))
234+ Just bytestring -> case decodeValue (Proxy :: Proxy pg) bytestring of
235+ Left err -> throwError err
236+ Right val -> return val
237+
238+getRow
239+ :: (AllZip HasDecoding pgs xs, MonadBase IO io)
240+ => RowNumber
241+ -> proxy pgs
242+ -> Value pgs (ExceptT Text (MaybeT io)) (NP I xs)
243+getRow (RowNumber r) (_ :: proxy pgs) = Value $ \ (Result result) -> do
223− (LibPQ.getvalue' result r c)
244+ maybeBytestrings <- traverse (liftBase . LibPQ.getvalue result r)
245+ [1 .. fromIntegral (lengthSList (Proxy :: Proxy pgs))]
246+ case fromList (catMaybes maybeBytestrings) of
247+ Nothing -> mzero
248+ Just bytestrings -> case decodings (Proxy :: Proxy pgs) bytestrings of
249+ Left err -> throwError err
250+ Right row -> return row