15ec0a6 · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

on master help sign in

First Draft at a FromRow module

15ec0a6Leon P Smith15 years ago

postgresql-simple.cabal+4−1

compare with master

unifiedsplit

@@ -21,6 +21,7 @@ Library

21 Database.PostgreSQL.Simple.BuiltinTypes

22 Database.PostgreSQL.Simple.Field

23 Database.PostgreSQL.Simple.FromField

24+ Database.PostgreSQL.Simple.FromRow

24 Database.PostgreSQL.Simple.LargeObjects

25 Database.PostgreSQL.Simple.LargeObjects

25 Database.PostgreSQL.Simple.Notification

26 Database.PostgreSQL.Simple.Notification

26 Database.PostgreSQL.Simple.Ok

27 Database.PostgreSQL.Simple.Ok

@@ -46,7 +47,9 @@ Library

46 old-locale,

47 old-locale,

47 template-haskell,

48 template-haskell,

48 text >= 0.11.1,

49 text >= 0.11.1,

49− time

50+ time,

51+ transformers,

52+ vector

51source-repository head

54source-repository head

52 type: git

55 type: git

src/Database/PostgreSQL/Simple/FromRow.hsnew file+162

@@ -0,0 +1,162 @@

1+{-# LANGUAGE RecordWildCards, BangPatterns #-}

3+module Database.PostgreSQL.Simple.FromRow

4+ ( FromRow(..)

5+ , RowParser

6+ , field

7+ , numFieldsRemaining

8+ ) where

10+import Control.Applicative (Applicative(..), (<$>))

11+import Control.Exception (SomeException(..), throw)

12+import Control.Monad (replicateM)

13+import Data.ByteString (ByteString)

14+import qualified Data.ByteString.Char8 as B

15+import Database.PostgreSQL.Simple.Internal

16+import Database.PostgreSQL.Simple.Result (ResultError(..), Result(..))

17+import Database.PostgreSQL.Simple.Types (Only(..))

18+import Database.PostgreSQL.Simple.Ok

19+import qualified Database.PostgreSQL.LibPQ as PQ

20+import Database.PostgreSQL.Simple.Internal

21+import Database.PostgreSQL.Simple.FromField

22+

23+import Control.Monad.Trans.State.Strict

24+import Control.Monad.Trans.Reader

25+import Control.Monad.Trans.Class

26+

27+import Data.Vector ((!))

28+

29+import System.IO.Unsafe ( unsafePerformIO )

30+

31+class FromRow a where

32+ fromRow :: RowParser a

33+

34+field :: FromField a => RowParser a

35+field = RP $ do

36+ Row{..} <- ask

37+ column <- lift get

38+ lift (put (column + 1))

39+ let typename = typenames ! (\(PQ.Col x) -> fromIntegral x) column

40+ result = rowresult

41+ field = Field{..}

42+ if (column > nfields rowresult) then lift (lift (Errors [])) else return ()

43+ lift (lift (fromField field (getvalue result row column)))

44+

45+numFieldsRemaining :: RowParser Int

46+numFieldsRemaining = RP $ do

47+ Row{..} <- ask

48+ column <- lift get

49+ return $! (\(PQ.Col x) -> fromIntegral x) (nfields rowresult - column)

50+

51+

52+instance (FromField a) => FromRow (Only a) where

53+ fromRow = do

54+ !a <- field

55+ return (Only a)

56+

57+instance (FromField a, FromField b) => FromRow (a,b) where

58+ fromRow = do

59+ !a <- field

60+ !b <- field

61+ return (a,b)

62+

63+instance (FromField a, FromField b, FromField c) => FromRow (a,b,c) where

64+ fromRow = do

65+ !a <- field

66+ !b <- field

67+ !c <- field

68+ return (a,b,c)

69+

70+instance (FromField a, FromField b, FromField c, FromField d) =>

71+ FromRow (a,b,c,d) where

72+ fromRow = do

73+ !a <- field

74+ !b <- field

75+ !c <- field

76+ !d <- field

77+ return (a,b,c,d)

78+

79+instance (FromField a, FromField b, FromField c, FromField d, FromField e) =>

80+ FromRow (a,b,c,d,e) where

81+ fromRow = do

82+ !a <- field

83+ !b <- field

84+ !c <- field

85+ !d <- field

86+ !e <- field

87+ return (a,b,c,d,e)

88+

89+instance (FromField a, FromField b, FromField c, FromField d, FromField e,

90+ FromField f) =>

91+ FromRow (a,b,c,d,e,f) where

92+ fromRow = do

93+ !a <- field

94+ !b <- field

95+ !c <- field

96+ !d <- field

97+ !e <- field

98+ !f <- field

99+ return (a,b,c,d,e,f)

100+

101+instance (FromField a, FromField b, FromField c, FromField d, FromField e,

102+ FromField f, FromField g) =>

103+ FromRow (a,b,c,d,e,f,g) where

104+ fromRow = do

105+ !a <- field

106+ !b <- field

107+ !c <- field

108+ !d <- field

109+ !e <- field

110+ !f <- field

111+ !g <- field

112+ return (a,b,c,d,e,f,g)

113+

114+instance (FromField a, FromField b, FromField c, FromField d, FromField e,

115+ FromField f, FromField g, FromField h) =>

116+ FromRow (a,b,c,d,e,f,g,h) where

117+ fromRow = do

118+ !a <- field

119+ !b <- field

120+ !c <- field

121+ !d <- field

122+ !e <- field

123+ !f <- field

124+ !g <- field

125+ !h <- field

126+ return (a,b,c,d,e,f,g,h)

127+

128+instance (FromField a, FromField b, FromField c, FromField d, FromField e,

129+ FromField f, FromField g, FromField h, FromField i) =>

130+ FromRow (a,b,c,d,e,f,g,h,i) where

131+ fromRow = do

132+ !a <- field

133+ !b <- field

134+ !c <- field

135+ !d <- field

136+ !e <- field

137+ !f <- field

138+ !g <- field

139+ !h <- field

140+ !i <- field

141+ return (a,b,c,d,e,f,g,h,i)

142+

143+instance (FromField a, FromField b, FromField c, FromField d, FromField e,

144+ FromField f, FromField g, FromField h, FromField i, FromField j) =>

145+ FromRow (a,b,c,d,e,f,g,h,i,j) where

146+ fromRow = do

147+ !a <- field

148+ !b <- field

149+ !c <- field

150+ !d <- field

151+ !e <- field

152+ !f <- field

153+ !g <- field

154+ !h <- field

155+ !i <- field

156+ !j <- field

157+ return (a,b,c,d,e,f,g,h,i,j)

158+

159+instance FromField a => FromRow [a] where

160+ fromRow = do

161+ n <- numFieldsRemaining

162+ replicateM n field

src/Database/PostgreSQL/Simple/Internal.hs+27−8

@@ -1,5 +1,5 @@

1{-# LANGUAGE OverloadedStrings, NamedFieldPuns, RecordWildCards #-}

2−{-# LANGUAGE DeriveDataTypeable #-}

2+{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}

3------------------------------------------------------------------------------

4-- |

5-- Module: Database.PostgreSQL.Simple.Internal

@@ -10,10 +10,10 @@

10-- Portability: portable

11--

12-- Internal bits. This interface is less stable and can change at any time.

13−-- In particular this means that while the rest of the postgresql-simple

13+-- In particular this means that while the rest of the postgresql-simple

14−-- package endeavors to follow the package versioning policy, this module

14+-- package endeavors to follow the package versioning policy, this module

15−-- does not. Also, at the moment there are things in here that aren't

15+-- does not. Also, at the moment there are things in here that aren't

16−-- particularly internal and are exported elsewhere; these will eventually

16+-- particularly internal and are exported elsewhere; these will eventually

17-- disappear from this module.

18--

19------------------------------------------------------------------------------

@@ -33,6 +33,10 @@ import Data.Word

33import Database.PostgreSQL.LibPQ(Oid(..))

34import qualified Database.PostgreSQL.LibPQ as PQ

35import Database.PostgreSQL.Simple.BuiltinTypes (BuiltinType)

36+import Database.PostgreSQL.Simple.Ok

37+import Control.Monad.Trans.State.Strict

38+import Control.Monad.Trans.Reader

39+import qualified Data.Vector as V

36import System.IO.Unsafe (unsafePerformIO)

40import System.IO.Unsafe (unsafePerformIO)

38-- | A Field represents metadata about a particular field

42-- | A Field represents metadata about a particular field

@@ -42,9 +46,9 @@ import System.IO.Unsafe (unsafePerformIO)

42-- just the field metadata

46-- just the field metadata

44data Field = Field {

48data Field = Field {

45− result :: PQ.Result

49+ result :: !PQ.Result

46− , column :: PQ.Column

50+ , column :: {-# UNPACK #-} !PQ.Column

47− , typename :: ByteString

51+ , typename :: !ByteString

48 }

52 }

50name :: Field -> Maybe ByteString

54name :: Field -> Maybe ByteString

@@ -225,3 +229,18 @@ newNullConnection = do

225 return Connection{..}

229 return Connection{..}

226

230

227data RawResult = RawResult { rawField :: Field, rawData :: Maybe ByteString }

231data RawResult = RawResult { rawField :: Field, rawData :: Maybe ByteString }

232+

233+data Row = Row {

234+ row :: {-# UNPACK #-} !PQ.Row

235+ , typenames :: !(V.Vector ByteString)

236+ , rowresult :: !PQ.Result

237+ }

238+

239+newtype RowParser a = RP { unRP :: ReaderT Row (StateT PQ.Column Ok) a }

240+ deriving ( Functor, Applicative, Alternative, Monad )

241+

242+getvalue :: PQ.Result -> PQ.Row -> PQ.Column -> Maybe ByteString

243+getvalue result row col = unsafePerformIO (PQ.getvalue result row col)

244+

245+nfields :: PQ.Result -> PQ.Column

246+nfields result = unsafePerformIO (PQ.nfields result)

src/Database/PostgreSQL/Simple/Ok.hs+6

@@ -5,6 +5,7 @@ module Database.PostgreSQL.Simple.Ok where

6import Control.Applicative

7import Control.Exception

8+import Control.Monad(MonadPlus(..))

8import Data.Typeable

9import Data.Typeable

10-- FIXME: [SomeException] should probably be a difference list

11-- FIXME: [SomeException] should probably be a difference list

@@ -31,6 +32,11 @@ instance Alternative Ok where

31 Errors _ <|> b@(Ok _) = b

32 Errors _ <|> b@(Ok _) = b

32 Errors as <|> Errors bs = Errors (as ++ bs)

33 Errors as <|> Errors bs = Errors (as ++ bs)

35+

36+instance MonadPlus Ok where

37+ mzero = empty

38+ mplus = (<|>)

39+

34instance Monad Ok where

40instance Monad Ok where

35 return = Ok

41 return = Ok