f863b53 · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

on master help sign in

Remove "Status" type isomorphic to Either

f863b53Leon P Smith15 years ago

src/Database/PostgreSQL/Simple.hs+2−2

compare with master

unifiedsplit

@@ -387,8 +387,8 @@ finishQuery conn q result = do

387 forM' 0 (nrows-1) $ \row -> do

388 values <- forM' 0 (ncols-1) (\col -> PQ.getvalue' result row col)

389 case convertResults fields values of

390− Fail err -> throwIO err

390+ Left err -> throwIO err

391− Success a -> return a

391+ Right a -> return a

392 PQ.CopyIn -> fail "FIXME: postgresql-simple does not currently support COPY IN"

393 PQ.CopyOut -> fail "FIXME: postgresql-simple does not currently support COPY OUT"

394 _ -> do

src/Database/PostgreSQL/Simple/Implementation.hs+1−16

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

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

2−{-# LANGUAGE DeriveDataTypeable, DeriveFunctor #-}

2+{-# LANGUAGE DeriveDataTypeable #-}

3module Database.PostgreSQL.Simple.Implementation where

5import Prelude hiding (catch)

@@ -17,21 +17,6 @@ import qualified Database.PostgreSQL.LibPQ as PQ

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

18import System.IO.Unsafe (unsafePerformIO)

20−

21−data Status err a = Fail err | Success a deriving(Eq, Ord, Show, Functor)

22−

23−instance Applicative (Status err) where

24− pure = Success

25− (Success f) <*> (Success a) = Success (f a)

26− (Success _) <*> (Fail err) = Fail err

27− (Fail err) <*> _ = Fail err

28−

29−instance Monad (Status err) where

30− return = pure

31− (Success a) >>= f = f a

32− (Fail err) >>= _ = Fail err

33−

34−

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

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

36--

21--

37-- You don't particularly want to retain these structures for a long

22-- You don't particularly want to retain these structures for a long

src/Database/PostgreSQL/Simple/QueryResults.hs+6−5

@@ -21,11 +21,12 @@ module Database.PostgreSQL.Simple.QueryResults

21 , convertError

22 ) where

24−import Control.Exception (throw)

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

25import Data.ByteString (ByteString)

26import qualified Data.ByteString.Char8 as B

27+import Data.Either()

27import Database.PostgreSQL.Simple.Implementation

28import Database.PostgreSQL.Simple.Implementation

28−import Database.PostgreSQL.Simple.Result (ResultError(..), Result(..),Status(..))

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

29import Database.PostgreSQL.Simple.Types (Only(..))

30import Database.PostgreSQL.Simple.Types (Only(..))

31-- | A collection type that can be converted from a list of strings.

32-- | A collection type that can be converted from a list of strings.

@@ -70,7 +71,7 @@ import Database.PostgreSQL.Simple.Types (Only(..))

70-- @

71-- @

72class QueryResults a where

73class QueryResults a where

73− convertResults :: [Field] -> [Maybe ByteString] -> Status ResultError a

74+ convertResults :: [Field] -> [Maybe ByteString] -> Either SomeException a

74 -- ^ Convert values from a row into a Haskell collection.

75 -- ^ Convert values from a row into a Haskell collection.

75 --

76 --

76 -- This function will throw a 'ResultError' if conversion of the

77 -- This function will throw a 'ResultError' if conversion of the

@@ -206,8 +207,8 @@ convertError :: [Field]

206 -- ^ Number of columns expected for conversion. For

207 -- ^ Number of columns expected for conversion. For

207 -- instance, if converting to a 3-tuple, the number to

208 -- instance, if converting to a 3-tuple, the number to

208 -- provide here would be 3.

209 -- provide here would be 3.

209− -> Status ResultError a

210+ -> Either SomeException a

210−convertError fs vs n = Fail $ ConversionFailed

211+convertError fs vs n = Left . SomeException $ ConversionFailed

211 (show (length fs) ++ " values: " ++ show (zip (map typename fs)

212 (show (length fs) ++ " values: " ++ show (zip (map typename fs)

212 (map (fmap ellipsis) vs)))

213 (map (fmap ellipsis) vs)))

213 (show n ++ " slots in target type")

214 (show n ++ " slots in target type")

src/Database/PostgreSQL/Simple/Result.hs+21−17

@@ -26,13 +26,12 @@ module Database.PostgreSQL.Simple.Result

26 (

27 Result(..)

28 , ResultError(..)

29− , Status(..)

30 ) where

29 ) where

32#include "MachDeps.h"

31#include "MachDeps.h"

34import Control.Applicative (Applicative, (<$>), (<*>), (<*), pure)

33import Control.Applicative (Applicative, (<$>), (<*>), (<*), pure)

35−import Control.Exception (Exception, throw)

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

36import Data.Attoparsec.Char8 hiding (Result)

35import Data.Attoparsec.Char8 hiding (Result)

37import Data.Bits ((.&.), (.|.), shiftL)

36import Data.Bits ((.&.), (.|.), shiftL)

38import Data.ByteString (ByteString)

37import Data.ByteString (ByteString)

@@ -81,12 +80,17 @@ data ResultError = Incompatible { errSQLType :: String

82instance Exception ResultError

81instance Exception ResultError

83+left :: Exception a => a -> Either SomeException b

84+left = Left . SomeException

85+

84-- | A type that may be converted from a SQL type.

86-- | A type that may be converted from a SQL type.

85class Result a where

87class Result a where

86− convert :: Field -> Maybe ByteString -> Status ResultError a

88+ convert :: Field -> Maybe ByteString -> Either SomeException a

87 -- ^ Convert a SQL value to a Haskell value.

89 -- ^ Convert a SQL value to a Haskell value.

88 --

90 --

89− -- Throws a 'ResultError' if conversion fails.

91+ -- Returns an exception if the conversion fails. In the case of

92+ -- library instances, this will usually be a 'ResultError', but may

93+ -- be a 'UnicodeError'.

90{--

94{--

91instance (Result a) => Result (Maybe a) where

95instance (Result a) => Result (Maybe a) where

92 convert _ Nothing = pure Nothing

96 convert _ Nothing = pure Nothing

@@ -155,7 +159,7 @@ instance Result LB.ByteString where

155

159

156

160

157instance Result ST.Text where

161instance Result ST.Text where

158− convert f {- | isText f -} = doConvert f okText $ (Success . ST.decodeUtf8)

162+ convert f {- | isText f -} = doConvert f okText $ (Right . ST.decodeUtf8)

159{- | otherwise = incompatible f (typeOf ST.empty)

163{- | otherwise = incompatible f (typeOf ST.empty)

160 "attempt to mix binary and text" -}

164 "attempt to mix binary and text" -}

161 -- FIXME: return a "Fail someUnicodeError" instead of throwing it

165 -- FIXME: return a "Fail someUnicodeError" instead of throwing it

@@ -170,7 +174,7 @@ instance Result [Char] where

170instance Result UTCTime where

174instance Result UTCTime where

171 convert f = doConvert f ok $ \bs ->

175 convert f = doConvert f ok $ \bs ->

172 case parseTime defaultTimeLocale "%F %T%Q%z" (B8.unpack bs ++ "00") of

176 case parseTime defaultTimeLocale "%F %T%Q%z" (B8.unpack bs ++ "00") of

173− Just t -> Success t

177+ Just t -> Right t

174 Nothing -> conversionFailed f "UTCTime" "could not parse"

178 Nothing -> conversionFailed f "UTCTime" "could not parse"

175 where ok = mkCompats [TimestampWithTimeZone]

179 where ok = mkCompats [TimestampWithTimeZone]

176{--

180{--

@@ -224,29 +228,29 @@ okInt = ok64

224#endif

228#endif

225--}

229--}

226doConvert :: forall a . (Typeable a)

230doConvert :: forall a . (Typeable a)

227− => Field -> Compat -> (ByteString -> Status ResultError a)

231+ => Field -> Compat -> (ByteString -> Either SomeException a)

228− -> Maybe ByteString -> Status ResultError a

232+ -> Maybe ByteString -> Either SomeException a

229doConvert f types cvt (Just bs)

233doConvert f types cvt (Just bs)

230 | Just typ <- oid2builtin (typeOid f)

234 | Just typ <- oid2builtin (typeOid f)

231 , mkCompat typ `compat` types = cvt bs

235 , mkCompat typ `compat` types = cvt bs

232 | otherwise = incompatible f (typeOf (undefined::a)) "types incompatible"

236 | otherwise = incompatible f (typeOf (undefined::a)) "types incompatible"

233−doConvert f _ cvt _ = Fail $ UnexpectedNull (B.unpack (typename f))

237+doConvert f _ cvt _ = left $ UnexpectedNull (B.unpack (typename f))

234 (show (typeOf (undefined::a))) ""

238 (show (typeOf (undefined::a))) ""

235

239

236−incompatible :: Field -> TypeRep -> String -> Status ResultError a

240+incompatible :: Field -> TypeRep -> String -> Either SomeException a

237−incompatible f r = Fail . Incompatible (B.unpack (typename f)) (show r)

241+incompatible f r = left . Incompatible (B.unpack (typename f)) (show r)

238

242

239−conversionFailed :: Field -> String -> String -> Status ResultError a

243+conversionFailed :: Field -> String -> String -> Either SomeException a

240−conversionFailed f s = Fail . ConversionFailed (B.unpack (typename f)) s

244+conversionFailed f s = left . ConversionFailed (B.unpack (typename f)) s

241

245

242−atto :: (Typeable a) => Compat -> Parser a -> Field -> Maybe ByteString -> Status ResultError a

246+atto :: (Typeable a) => Compat -> Parser a -> Field -> Maybe ByteString -> Either SomeException a

243atto types p0 f dat = doConvert f types (go undefined p0) dat

247atto types p0 f dat = doConvert f types (go undefined p0) dat

244 where

248 where

245− go :: (Typeable a) => a -> Parser a -> ByteString -> Status ResultError a

249+ go :: (Typeable a) => a -> Parser a -> ByteString -> Either SomeException a

246 go dummy p s =

250 go dummy p s =

247 case parseOnly p s of

251 case parseOnly p s of

248 Left err -> conversionFailed f (show (typeOf dummy)) err

252 Left err -> conversionFailed f (show (typeOf dummy)) err

249− Right v -> Success v

253+ Right v -> Right v

250

254

251instance Result RawResult where

255instance Result RawResult where

252− convert field rawData = Success (RawResult field rawData)

256+ convert field rawData = Right (RawResult field rawData)