35cb038 · squeal · git.iko.soy

git.iko.soy/squeal

getRow

commit35cb038567155e7f13a8f32a228d0aee1b781f3a authorEitan Chatav <eitan.chatav@gmail.com> dateSat 1 Jul 2017, 00:09 (9 years ago) parent32b2836

3 files changed+45−74

compare with dev

unifiedsplit

squeel-postgresql/squeel-postgresql.cabal+1 squeel-postgresql/src/Squeel/PostgreSQL/Binary.hs−57 squeel-postgresql/src/Squeel/PostgreSQL/PQ.hs+44−17

squeel-postgresql/squeel-postgresql.cabal+1

@@ -34,6 +34,7 @@ library

3434 , scientific

3535 , text

3636 , time

37+ , transformers

3738 , transformers-base

3839 , uuid

3940

squeel-postgresql/src/Squeel/PostgreSQL/Binary.hs−57

@@ -82,18 +82,6 @@ instance HasDecoding 'PGTimestampTZ UTCTime where

8282instance HasDecoding 'PGInterval DiffTime where

8383 decoding _ = Decoder.interval_int

8484

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−

9785decodings

9886 :: AllZip HasDecoding pgs xs

9987 => proxy pgs

@@ -104,17 +92,6 @@ decodings (_ :: proxy pgs) (K bytestring :* bytestrings) =

10492 proxy :* proxies -> (:*)

10593 <$> (I <$> Decoder.valueParser (decoding proxy) bytestring)

10694 <*> 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

11895

11996class HasEncoding x pg where

12097 encoding :: proxy pg -> x -> Encoder.Encoding

@@ -171,37 +148,3 @@ encodings (_ :: proxy pgs) (I x :* xs) =

171148 case (hpure Proxy :: NP Proxy pgs) of

172149 proxy :* proxies -> Encoder.encodingBytes (encoding proxy x)

173150 : 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

2020

2121import Control.Exception.Lifted

2222import Control.Monad.Base

23−import Control.Monad.Trans

23+import Control.Monad.Except

24+import Control.Monad.Trans.Maybe

2425import Control.Monad.Trans.Control

2526import Data.ByteString (ByteString)

27+import Data.Maybe

2628import Data.Proxy (Proxy)

2729import Data.Text (Text)

2830import Generics.SOP

29−import GHC.Exts

31+import GHC.Exts hiding (fromList)

3032import GHC.TypeLits

3133

3234import qualified Database.PostgreSQL.LibPQ as LibPQ

@@ -205,19 +207,44 @@ colNum4 :: ColumnNumber (c0:c1:c2:c3:c4:cs) c4

205207colNum4 = colNum (proxy# :: Proxy# 4)

206208

207209newtype 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

208223

209−-- getValue

210−-- :: (HasDecoding pg x, MonadBase IO io)

211−-- => RowNumber

212−-- -> ColumnNumber pgs pg

213−-- -> Value pgs (ExceptT Text (MaybeT io)) x

214−

215−getvalue

216− :: (HasDecoding x y, MonadBase IO io)

217− => Result xs

218− -> RowNumber

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)))

223− (LibPQ.getvalue' result r c)

224+getValue

225+ :: (HasDecoding pg x, MonadBase IO io)

226+ => RowNumber

227+ -> ColumnNumber pgs pg

228+ -> Value pgs (ExceptT Text (MaybeT io)) x

229+getValue (RowNumber r) (ColumnNumber c :: ColumnNumber pgs pg) =

230+ Value $ \ (Result result) -> do

231+ maybeBytestring <- liftBase $ LibPQ.getvalue result r c

232+ case maybeBytestring of

233+ Nothing -> mzero

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

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