f863b53 · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

Remove "Status" type isomorphic to Either

commitf863b5302dbb994a6ce078d4d29d7c2192537d7e authorLeon P Smith <leon@melding-monads.com> dateSun 25 Dec 2011, 02:06 (15 years ago) parent2bb457a

4 files changed+30−40

compare with master

unifiedsplit

src/Database/PostgreSQL/Simple.hs+2−2 src/Database/PostgreSQL/Simple/Implementation.hs+1−16 src/Database/PostgreSQL/Simple/QueryResults.hs+6−5 src/Database/PostgreSQL/Simple/Result.hs+21−17

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

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

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

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

389389 case convertResults fields values of

390− Fail err -> throwIO err

391− Success a -> return a

390+ Left err -> throwIO err

391+ Right a -> return a

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

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

394394 _ -> do

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

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

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

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

2+{-# LANGUAGE DeriveDataTypeable #-}

33module Database.PostgreSQL.Simple.Implementation where

55import Prelude hiding (catch)

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

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

1818import System.IO.Unsafe (unsafePerformIO)

1919

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−

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

3621--

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

2121 , convertError

2222 ) where

2323

24−import Control.Exception (throw)

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

2525import Data.ByteString (ByteString)

2626import qualified Data.ByteString.Char8 as B

27+import Data.Either()

2728import Database.PostgreSQL.Simple.Implementation

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

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

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

3031

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

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

7071-- @

7172

7273class QueryResults a where

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

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

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

7576 --

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

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

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

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

208209 -- provide here would be 3.

209− -> Status ResultError a

210−convertError fs vs n = Fail $ ConversionFailed

210+ -> Either SomeException a

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

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

212213 (map (fmap ellipsis) vs)))

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

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

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

2626 (

2727 Result(..)

2828 , ResultError(..)

29− , Status(..)

3029 ) where

3130

3231#include "MachDeps.h"

3332

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

35−import Control.Exception (Exception, throw)

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

3635import Data.Attoparsec.Char8 hiding (Result)

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

3837import Data.ByteString (ByteString)

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

8180

8281instance Exception ResultError

8382

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

84+left = Left . SomeException

85+

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

8587class Result a where

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

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

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

8890 --

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'.

9094{--

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

9296 convert _ Nothing = pure Nothing

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

155159

156160

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

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

160164 "attempt to mix binary and text" -}

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

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

170174instance Result UTCTime where

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

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

173− Just t -> Success t

177+ Just t -> Right t

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

175179 where ok = mkCompats [TimestampWithTimeZone]

176180{--

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

224228#endif

225229--}

226230doConvert :: forall a . (Typeable a)

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

228− -> Maybe ByteString -> Status ResultError a

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

232+ -> Maybe ByteString -> Either SomeException a

229233doConvert f types cvt (Just bs)

230234 | Just typ <- oid2builtin (typeOid f)

231235 , mkCompat typ `compat` types = cvt bs

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

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

235239

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

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

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

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

238242

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

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

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

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

241245

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

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

244248 where

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

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

246250 go dummy p s =

247251 case parseOnly p s of

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

249− Right v -> Success v

253+ Right v -> Right v

250254

251255instance Result RawResult where

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

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