{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleInstances, OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving, DefaultSignatures #-}
#if MIN_VERSION_time(1,5,0)
{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
#endif
module Database.MySQL.Simple.Result
( FromField(..)
, Result(..)
, ResultError(..)
) where
#include "MachDeps.h"
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail (MonadFail(..))
#endif
import Control.Applicative ((<$>), (<*>), (<*), pure)
import Control.Exception (Exception, throw)
import Data.Attoparsec.ByteString.Char8 hiding (Result)
import Data.Bits ((.&.), (.|.), shiftL)
import Data.ByteString (ByteString)
import Data.Int (Int8, Int16, Int32, Int64)
import Data.List (foldl')
import Data.Ratio (Ratio)
import Data.Time.Calendar (Day, fromGregorian)
import Data.Time.Clock (UTCTime(..))
import Data.Time.Format (parseTimeM, ParseTime)
import Data.Time.LocalTime (TimeOfDay, makeTimeOfDayValid)
import Data.Typeable (TypeRep, Typeable, typeOf)
import Data.Word (Word, Word8, Word16, Word32, Word64)
import Database.MySQL.Base.Types (Field(..), Type(..))
import qualified Data.ByteString as SB
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Lazy as LB
import qualified Data.Text as ST
import qualified Data.Text.Encoding as ST
import qualified Data.Text.Lazy as LT
#if MIN_VERSION_time(1,5,0)
import Data.Time.Format (defaultTimeLocale)
#else
import System.Locale (defaultTimeLocale)
#endif
data ResultError = Incompatible { ResultError -> String
errSQLType :: String
, ResultError -> String
errHaskellType :: String
, ResultError -> String
errFieldName :: String
, ResultError -> String
errMessage :: String }
| UnexpectedNull { errSQLType :: String
, errHaskellType :: String
, errFieldName :: String
, errMessage :: String }
| ConversionFailed { errSQLType :: String
, errHaskellType :: String
, errFieldName :: String
, errMessage :: String }
deriving (ResultError -> ResultError -> Bool
(ResultError -> ResultError -> Bool)
-> (ResultError -> ResultError -> Bool) -> Eq ResultError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResultError -> ResultError -> Bool
$c/= :: ResultError -> ResultError -> Bool
== :: ResultError -> ResultError -> Bool
$c== :: ResultError -> ResultError -> Bool
Eq, Int -> ResultError -> ShowS
[ResultError] -> ShowS
ResultError -> String
(Int -> ResultError -> ShowS)
-> (ResultError -> String)
-> ([ResultError] -> ShowS)
-> Show ResultError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResultError] -> ShowS
$cshowList :: [ResultError] -> ShowS
show :: ResultError -> String
$cshow :: ResultError -> String
showsPrec :: Int -> ResultError -> ShowS
$cshowsPrec :: Int -> ResultError -> ShowS
Show, Typeable)
instance Exception ResultError
class FromField a where
fromField :: ([Type], ByteString -> Either String a)
class Result a where
convert :: Field -> Maybe ByteString -> a
default convert :: (Typeable a, FromField a)
=> Field -> Maybe ByteString -> a
convert Field
f =
Field -> Compat -> (ByteString -> a) -> Maybe ByteString -> a
forall a.
Typeable a =>
Field -> Compat -> (ByteString -> a) -> Maybe ByteString -> a
doConvert Field
f ([Type] -> Compat
mkCompats [Type]
allowTypes) ((ByteString -> a) -> Maybe ByteString -> a)
-> (ByteString -> a) -> Maybe ByteString -> a
forall a b. (a -> b) -> a -> b
$ \ByteString
bs ->
case ByteString -> Either String a
cvt ByteString
bs of
Right a
x -> a
x
Left String
err -> Field -> String -> String -> a
forall a. Field -> String -> String -> a
conversionFailed Field
f (TypeRep -> String
forall a. Show a => a -> String
show (Either String a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (ByteString -> Either String a
cvt ByteString
forall a. HasCallStack => a
undefined))) String
err
where
([Type]
allowTypes, ByteString -> Either String a
cvt) = ([Type], ByteString -> Either String a)
forall a. FromField a => ([Type], ByteString -> Either String a)
fromField
instance (Result a) => Result (Maybe a) where
convert :: Field -> Maybe ByteString -> Maybe a
convert Field
_ Maybe ByteString
Nothing = Maybe a
forall a. Maybe a
Nothing
convert Field
f Maybe ByteString
bs = a -> Maybe a
forall a. a -> Maybe a
Just (Field -> Maybe ByteString -> a
forall a. Result a => Field -> Maybe ByteString -> a
convert Field
f Maybe ByteString
bs)
instance Result Bool where
convert :: Field -> Maybe ByteString -> Bool
convert = Compat -> Parser Bool -> Field -> Maybe ByteString -> Bool
forall a.
Typeable a =>
Compat -> Parser a -> Field -> Maybe ByteString -> a
atto Compat
ok8 ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=(Int
0::Int)) (Int -> Bool) -> Parser ByteString Int -> Parser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int
forall a. Integral a => Parser a
decimal)
instance Result Int8 where
convert :: Field -> Maybe ByteString -> Int8
convert = Compat -> Parser Int8 -> Field -> Maybe ByteString -> Int8
forall a.
Typeable a =>
Compat -> Parser a -> Field -> Maybe ByteString -> a
atto Compat
ok8 (Parser Int8 -> Field -> Maybe ByteString -> Int8)
-> Parser Int8 -> Field -> Maybe ByteString -> Int8
forall a b. (a -> b) -> a -> b
$ Parser Int8 -> Parser Int8
forall a. Num a => Parser a -> Parser a
signed Parser Int8
forall a. Integral a => Parser a
decimal
instance Result Int16 where
convert :: Field -> Maybe ByteString -> Int16
convert = Compat -> Parser Int16 -> Field -> Maybe ByteString -> Int16
forall a.
Typeable a =>
Compat -> Parser a -> Field -> Maybe ByteString -> a
atto Compat
ok16 (Parser Int16 -> Field -> Maybe ByteString -> Int16)
-> Parser Int16 -> Field -> Maybe ByteString -> Int16
forall a b. (a -> b) -> a -> b
$ Parser Int16 -> Parser Int16
forall a. Num a => Parser a -> Parser a
signed Parser Int16
forall a. Integral a => Parser a
decimal
instance Result Int32 where
convert :: Field -> Maybe ByteString -> Int32
convert = Compat -> Parser Int32 -> Field -> Maybe ByteString -> Int32
forall a.
Typeable a =>
Compat -> Parser a -> Field -> Maybe ByteString -> a
atto Compat
ok32 (Parser Int32 -> Field -> Maybe ByteString -> Int32)
-> Parser Int32 -> Field -> Maybe ByteString -> Int32
forall a b. (a -> b) -> a -> b
$ Parser Int32 -> Parser Int32
forall a. Num a => Parser a -> Parser a
signed Parser Int32
forall a. Integral a => Parser a
decimal
instance Result Int where
convert :: Field -> Maybe ByteString -> Int
convert = Compat -> Parser ByteString Int -> Field -> Maybe ByteString -> Int
forall a.
Typeable a =>
Compat -> Parser a -> Field -> Maybe ByteString -> a
atto Compat
okWord (Parser ByteString Int -> Field -> Maybe ByteString -> Int)
-> Parser ByteString Int -> Field -> Maybe ByteString -> Int
forall a b. (a -> b) -> a -> b
$ Parser ByteString Int -> Parser ByteString Int
forall a. Num a => Parser a -> Parser a
signed Parser ByteString Int
forall a. Integral a => Parser a
decimal
instance Result Int64 where
convert :: Field -> Maybe ByteString -> Int64
convert = Compat -> Parser Int64 -> Field -> Maybe ByteString -> Int64
forall a.
Typeable a =>
Compat -> Parser a -> Field -> Maybe ByteString -> a
atto Compat
ok64 (Parser Int64 -> Field -> Maybe ByteString -> Int64)
-> Parser Int64 -> Field -> Maybe ByteString -> Int64
forall a b. (a -> b) -> a -> b
$ Parser Int64 -> Parser Int64
forall a. Num a => Parser a -> Parser a
signed Parser Int64
forall a. Integral a => Parser a
decimal
instance Result Integer where
convert :: Field -> Maybe ByteString -> Integer
convert = Compat -> Parser Integer -> Field -> Maybe ByteString -> Integer
forall a.
Typeable a =>
Compat -> Parser a -> Field -> Maybe ByteString -> a
atto Compat
ok64 (Parser Integer -> Field -> Maybe ByteString -> Integer)
-> Parser Integer -> Field -> Maybe ByteString -> Integer
forall a b. (a -> b) -> a -> b
$ Parser Integer -> Parser Integer
forall a. Num a => Parser a -> Parser a
signed Parser Integer
forall a. Integral a => Parser a
decimal
instance Result Word8 where
convert :: Field -> Maybe ByteString -> Word8
convert = Compat -> Parser Word8 -> Field -> Maybe ByteString -> Word8
forall a.
Typeable a =>
Compat -> Parser a -> Field -> Maybe ByteString -> a
atto Compat
ok8 Parser Word8
forall a. Integral a => Parser a
decimal
instance Result Word16 where
convert :: Field -> Maybe ByteString -> Word16
convert = Compat -> Parser Word16 -> Field -> Maybe ByteString -> Word16
forall a.
Typeable a =>
Compat -> Parser a -> Field -> Maybe ByteString -> a
atto Compat
ok16 Parser Word16
forall a. Integral a => Parser a
decimal
instance Result Word32 where
convert :: Field -> Maybe ByteString -> Word32
convert = Compat -> Parser Word32 -> Field -> Maybe ByteString -> Word32
forall a.
Typeable a =>
Compat -> Parser a -> Field -> Maybe ByteString -> a
atto Compat
ok32 Parser Word32
forall a. Integral a => Parser a
decimal
instance Result Word where
convert :: Field -> Maybe ByteString -> Word
convert = Compat -> Parser Word -> Field -> Maybe ByteString -> Word
forall a.
Typeable a =>
Compat -> Parser a -> Field -> Maybe ByteString -> a
atto Compat
okWord Parser Word
forall a. Integral a => Parser a
decimal
instance Result Word64 where
convert :: Field -> Maybe ByteString -> Word64
convert = Compat -> Parser Word64 -> Field -> Maybe ByteString -> Word64
forall a.
Typeable a =>
Compat -> Parser a -> Field -> Maybe ByteString -> a
atto Compat
ok64 Parser Word64
forall a. Integral a => Parser a
decimal
instance Result Float where
convert :: Field -> Maybe ByteString -> Float
convert = Compat -> Parser Float -> Field -> Maybe ByteString -> Float
forall a.
Typeable a =>
Compat -> Parser a -> Field -> Maybe ByteString -> a
atto Compat
ok (Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> Float) -> Parser ByteString Double -> Parser Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Double
double)
where ok :: Compat
ok = [Type] -> Compat
mkCompats [Type
Float,Type
Double,Type
Decimal,Type
NewDecimal,Type
Tiny,Type
Short,Type
Int24]
instance Result Double where
convert :: Field -> Maybe ByteString -> Double
convert = Compat
-> Parser ByteString Double -> Field -> Maybe ByteString -> Double
forall a.
Typeable a =>
Compat -> Parser a -> Field -> Maybe ByteString -> a
atto Compat
ok Parser ByteString Double
double
where ok :: Compat
ok = [Type] -> Compat
mkCompats [Type
Float,Type
Double,Type
Decimal,Type
NewDecimal,Type
Tiny,Type
Short,Type
Int24,
Type
Long]
instance Result (Ratio Integer) where
convert :: Field -> Maybe ByteString -> Ratio Integer
convert = Compat
-> Parser (Ratio Integer)
-> Field
-> Maybe ByteString
-> Ratio Integer
forall a.
Typeable a =>
Compat -> Parser a -> Field -> Maybe ByteString -> a
atto Compat
ok Parser (Ratio Integer)
forall a. Fractional a => Parser a
rational
where ok :: Compat
ok = [Type] -> Compat
mkCompats [Type
Float,Type
Double,Type
Decimal,Type
NewDecimal,Type
Tiny,Type
Short,Type
Int24,
Type
Long,Type
LongLong]
instance Result SB.ByteString where
convert :: Field -> Maybe ByteString -> ByteString
convert Field
f = Field
-> Compat
-> (ByteString -> ByteString)
-> Maybe ByteString
-> ByteString
forall a.
Typeable a =>
Field -> Compat -> (ByteString -> a) -> Maybe ByteString -> a
doConvert Field
f Compat
okText ((ByteString -> ByteString) -> Maybe ByteString -> ByteString)
-> (ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
forall a. a -> a
id
instance Result LB.ByteString where
convert :: Field -> Maybe ByteString -> ByteString
convert Field
f = [ByteString] -> ByteString
LB.fromChunks ([ByteString] -> ByteString)
-> (Maybe ByteString -> [ByteString])
-> Maybe ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[]) (ByteString -> [ByteString])
-> (Maybe ByteString -> ByteString)
-> Maybe ByteString
-> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field -> Maybe ByteString -> ByteString
forall a. Result a => Field -> Maybe ByteString -> a
convert Field
f
instance Result ST.Text where
convert :: Field -> Maybe ByteString -> Text
convert Field
f | Field -> Bool
isText Field
f = Field -> Compat -> (ByteString -> Text) -> Maybe ByteString -> Text
forall a.
Typeable a =>
Field -> Compat -> (ByteString -> a) -> Maybe ByteString -> a
doConvert Field
f Compat
okText ((ByteString -> Text) -> Maybe ByteString -> Text)
-> (ByteString -> Text) -> Maybe ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
ST.decodeUtf8
| Bool
otherwise = Field -> TypeRep -> String -> Maybe ByteString -> Text
forall a. Field -> TypeRep -> String -> a
incompatible Field
f (Text -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf Text
ST.empty)
String
"attempt to mix binary and text"
instance Result LT.Text where
convert :: Field -> Maybe ByteString -> Text
convert Field
f = Text -> Text
LT.fromStrict (Text -> Text)
-> (Maybe ByteString -> Text) -> Maybe ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field -> Maybe ByteString -> Text
forall a. Result a => Field -> Maybe ByteString -> a
convert Field
f
instance Result [Char] where
convert :: Field -> Maybe ByteString -> String
convert Field
f = Text -> String
ST.unpack (Text -> String)
-> (Maybe ByteString -> Text) -> Maybe ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field -> Maybe ByteString -> Text
forall a. Result a => Field -> Maybe ByteString -> a
convert Field
f
instance FromField UTCTime where
fromField :: ([Type], ByteString -> Either String UTCTime)
fromField =
( [Type
DateTime, Type
Timestamp]
, \ByteString
bs -> if ByteString
"0000-00-00" ByteString -> ByteString -> Bool
`SB.isPrefixOf` ByteString
bs then
UTCTime -> Either String UTCTime
forall a b. b -> Either a b
Right (UTCTime -> Either String UTCTime)
-> UTCTime -> Either String UTCTime
forall a b. (a -> b) -> a -> b
$ Day -> DiffTime -> UTCTime
UTCTime (Integer -> Int -> Int -> Day
fromGregorian Integer
0 Int
0 Int
0) DiffTime
0
else
String -> String -> Either String UTCTime
forall t. ParseTime t => String -> String -> Either String t
parseTimeField String
"%F %T%Q" (ByteString -> String
B8.unpack ByteString
bs)
)
instance Result UTCTime
instance Result Day where
convert :: Field -> Maybe ByteString -> Day
convert Field
f = (Parser Day -> Field -> Maybe ByteString -> Day)
-> Field -> Parser Day -> Maybe ByteString -> Day
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Compat -> Parser Day -> Field -> Maybe ByteString -> Day
forall a.
Typeable a =>
Compat -> Parser a -> Field -> Maybe ByteString -> a
atto Compat
ok) Field
f (Parser Day -> Maybe ByteString -> Day)
-> Parser Day -> Maybe ByteString -> Day
forall a b. (a -> b) -> a -> b
$ case Field -> Type
fieldType Field
f of
Type
Year -> Parser Day
year
Type
_ -> Parser Day
date
where ok :: Compat
ok = [Type] -> Compat
mkCompats [Type
Year,Type
Date,Type
NewDate]
year :: Parser Day
year = Integer -> Int -> Int -> Day
fromGregorian (Integer -> Int -> Int -> Day)
-> Parser Integer -> Parser ByteString (Int -> Int -> Day)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Integer
forall a. Integral a => Parser a
decimal Parser ByteString (Int -> Int -> Day)
-> Parser ByteString Int -> Parser ByteString (Int -> Day)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Parser ByteString Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
1 Parser ByteString (Int -> Day)
-> Parser ByteString Int -> Parser Day
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Parser ByteString Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
1
date :: Parser Day
date = Integer -> Int -> Int -> Day
fromGregorian (Integer -> Int -> Int -> Day)
-> Parser Integer -> Parser ByteString (Int -> Int -> Day)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Integer
forall a. Integral a => Parser a
decimal Parser Integer -> Parser ByteString Char -> Parser Integer
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
char Char
'-')
Parser ByteString (Int -> Int -> Day)
-> Parser ByteString Int -> Parser ByteString (Int -> Day)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString Int
forall a. Integral a => Parser a
decimal Parser ByteString Int
-> Parser ByteString Char -> Parser ByteString Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
char Char
'-')
Parser ByteString (Int -> Day)
-> Parser ByteString Int -> Parser Day
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int
forall a. Integral a => Parser a
decimal
instance FromField TimeOfDay where
fromField :: ([Type], ByteString -> Either String TimeOfDay)
fromField = ([Type
Time], String -> String -> Either String TimeOfDay
forall t. ParseTime t => String -> String -> Either String t
parseTimeField String
"%T%Q" (String -> Either String TimeOfDay)
-> (ByteString -> String) -> ByteString -> Either String TimeOfDay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
B8.unpack)
instance Result TimeOfDay
newtype Failable a = Failable { forall a. Failable a -> Either String a
failable :: Either String a }
deriving ((forall a b. (a -> b) -> Failable a -> Failable b)
-> (forall a b. a -> Failable b -> Failable a) -> Functor Failable
forall a b. a -> Failable b -> Failable a
forall a b. (a -> b) -> Failable a -> Failable b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Failable b -> Failable a
$c<$ :: forall a b. a -> Failable b -> Failable a
fmap :: forall a b. (a -> b) -> Failable a -> Failable b
$cfmap :: forall a b. (a -> b) -> Failable a -> Failable b
Functor, Functor Failable
Functor Failable
-> (forall a. a -> Failable a)
-> (forall a b. Failable (a -> b) -> Failable a -> Failable b)
-> (forall a b c.
(a -> b -> c) -> Failable a -> Failable b -> Failable c)
-> (forall a b. Failable a -> Failable b -> Failable b)
-> (forall a b. Failable a -> Failable b -> Failable a)
-> Applicative Failable
forall a. a -> Failable a
forall a b. Failable a -> Failable b -> Failable a
forall a b. Failable a -> Failable b -> Failable b
forall a b. Failable (a -> b) -> Failable a -> Failable b
forall a b c.
(a -> b -> c) -> Failable a -> Failable b -> Failable c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Failable a -> Failable b -> Failable a
$c<* :: forall a b. Failable a -> Failable b -> Failable a
*> :: forall a b. Failable a -> Failable b -> Failable b
$c*> :: forall a b. Failable a -> Failable b -> Failable b
liftA2 :: forall a b c.
(a -> b -> c) -> Failable a -> Failable b -> Failable c
$cliftA2 :: forall a b c.
(a -> b -> c) -> Failable a -> Failable b -> Failable c
<*> :: forall a b. Failable (a -> b) -> Failable a -> Failable b
$c<*> :: forall a b. Failable (a -> b) -> Failable a -> Failable b
pure :: forall a. a -> Failable a
$cpure :: forall a. a -> Failable a
Applicative, Applicative Failable
Applicative Failable
-> (forall a b. Failable a -> (a -> Failable b) -> Failable b)
-> (forall a b. Failable a -> Failable b -> Failable b)
-> (forall a. a -> Failable a)
-> Monad Failable
forall a. a -> Failable a
forall a b. Failable a -> Failable b -> Failable b
forall a b. Failable a -> (a -> Failable b) -> Failable b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Failable a
$creturn :: forall a. a -> Failable a
>> :: forall a b. Failable a -> Failable b -> Failable b
$c>> :: forall a b. Failable a -> Failable b -> Failable b
>>= :: forall a b. Failable a -> (a -> Failable b) -> Failable b
$c>>= :: forall a b. Failable a -> (a -> Failable b) -> Failable b
Monad)
instance MonadFail Failable where
fail :: forall a. String -> Failable a
fail String
err = Either String a -> Failable a
forall a. Either String a -> Failable a
Failable (String -> Either String a
forall a b. a -> Either a b
Left String
err)
parseTimeField :: ParseTime t => String -> String -> Either String t
parseTimeField :: forall t. ParseTime t => String -> String -> Either String t
parseTimeField String
fmt String
s = Failable t -> Either String t
forall a. Failable a -> Either String a
failable (Failable t -> Either String t) -> Failable t -> Either String t
forall a b. (a -> b) -> a -> b
$ Bool -> TimeLocale -> String -> String -> Failable t
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
fmt String
s
isText :: Field -> Bool
isText :: Field -> Bool
isText Field
f = Field -> Word
fieldCharSet Field
f Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
63
newtype Compat = Compat Word32
mkCompats :: [Type] -> Compat
mkCompats :: [Type] -> Compat
mkCompats = (Compat -> Compat -> Compat) -> Compat -> [Compat] -> Compat
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Compat -> Compat -> Compat
f (Word32 -> Compat
Compat Word32
0) ([Compat] -> Compat) -> ([Type] -> [Compat]) -> [Type] -> Compat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type -> Compat) -> [Type] -> [Compat]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Compat
mkCompat
where f :: Compat -> Compat -> Compat
f (Compat Word32
a) (Compat Word32
b) = Word32 -> Compat
Compat (Word32
a Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
b)
mkCompat :: Type -> Compat
mkCompat :: Type -> Compat
mkCompat = Word32 -> Compat
Compat (Word32 -> Compat) -> (Type -> Word32) -> Type -> Compat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftL Word32
1 (Int -> Word32) -> (Type -> Int) -> Type -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Int
forall a. Enum a => a -> Int
fromEnum
compat :: Compat -> Compat -> Bool
compat :: Compat -> Compat -> Bool
compat (Compat Word32
a) (Compat Word32
b) = Word32
a Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
b Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0
okText, ok8, ok16, ok32, ok64, okWord :: Compat
okText :: Compat
okText = [Type] -> Compat
mkCompats [Type
VarChar,Type
TinyBlob,Type
MediumBlob,Type
LongBlob,Type
Blob,Type
VarString,Type
String,
Type
Set,Type
Enum,Type
Json]
ok8 :: Compat
ok8 = [Type] -> Compat
mkCompats [Type
Tiny]
ok16 :: Compat
ok16 = [Type] -> Compat
mkCompats [Type
Tiny,Type
Short]
ok32 :: Compat
ok32 = [Type] -> Compat
mkCompats [Type
Tiny,Type
Short,Type
Int24,Type
Long]
ok64 :: Compat
ok64 = [Type] -> Compat
mkCompats [Type
Tiny,Type
Short,Type
Int24,Type
Long,Type
LongLong]
#if WORD_SIZE_IN_BITS < 64
okWord = ok32
#else
okWord :: Compat
okWord = Compat
ok64
#endif
doConvert :: (Typeable a) =>
Field -> Compat -> (ByteString -> a) -> Maybe ByteString -> a
doConvert :: forall a.
Typeable a =>
Field -> Compat -> (ByteString -> a) -> Maybe ByteString -> a
doConvert Field
f Compat
types ByteString -> a
cvt (Just ByteString
bs)
| Type -> Compat
mkCompat (Field -> Type
fieldType Field
f) Compat -> Compat -> Bool
`compat` Compat
types = ByteString -> a
cvt ByteString
bs
| Bool
otherwise = Field -> TypeRep -> String -> a
forall a. Field -> TypeRep -> String -> a
incompatible Field
f (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (ByteString -> a
cvt ByteString
forall a. HasCallStack => a
undefined)) String
"types incompatible"
doConvert Field
f Compat
_ ByteString -> a
cvt Maybe ByteString
_ = ResultError -> a
forall a e. Exception e => e -> a
throw (ResultError -> a) -> ResultError -> a
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String -> ResultError
UnexpectedNull (Type -> String
forall a. Show a => a -> String
show (Field -> Type
fieldType Field
f))
(TypeRep -> String
forall a. Show a => a -> String
show (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (ByteString -> a
cvt ByteString
forall a. HasCallStack => a
undefined)))
(ByteString -> String
B8.unpack (Field -> ByteString
fieldName Field
f))
(String
"unexpected null in table "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
B8.unpack (Field -> ByteString
fieldTable Field
f)
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" of database "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
B8.unpack (Field -> ByteString
fieldDB Field
f)
)
incompatible :: Field -> TypeRep -> String -> a
incompatible :: forall a. Field -> TypeRep -> String -> a
incompatible Field
f TypeRep
r = ResultError -> a
forall a e. Exception e => e -> a
throw (ResultError -> a) -> (String -> ResultError) -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String -> String -> ResultError
Incompatible (Type -> String
forall a. Show a => a -> String
show (Field -> Type
fieldType Field
f))
(TypeRep -> String
forall a. Show a => a -> String
show TypeRep
r)
(ByteString -> String
B8.unpack (Field -> ByteString
fieldName Field
f))
conversionFailed :: Field -> String -> String -> a
conversionFailed :: forall a. Field -> String -> String -> a
conversionFailed Field
f String
s = ResultError -> a
forall a e. Exception e => e -> a
throw (ResultError -> a) -> (String -> ResultError) -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String -> String -> ResultError
ConversionFailed (Type -> String
forall a. Show a => a -> String
show (Field -> Type
fieldType Field
f)) String
s
(ByteString -> String
B8.unpack (Field -> ByteString
fieldName Field
f))
atto :: (Typeable a) => Compat -> Parser a -> Field -> Maybe ByteString -> a
atto :: forall a.
Typeable a =>
Compat -> Parser a -> Field -> Maybe ByteString -> a
atto Compat
types Parser a
p0 Field
f = Field -> Compat -> (ByteString -> a) -> Maybe ByteString -> a
forall a.
Typeable a =>
Field -> Compat -> (ByteString -> a) -> Maybe ByteString -> a
doConvert Field
f Compat
types ((ByteString -> a) -> Maybe ByteString -> a)
-> (ByteString -> a) -> Maybe ByteString -> a
forall a b. (a -> b) -> a -> b
$ a -> Parser a -> ByteString -> a
forall a. Typeable a => a -> Parser a -> ByteString -> a
go a
forall a. HasCallStack => a
undefined Parser a
p0
where
go :: (Typeable a) => a -> Parser a -> ByteString -> a
go :: forall a. Typeable a => a -> Parser a -> ByteString -> a
go a
dummy Parser a
p ByteString
s =
case Parser a -> ByteString -> Either String a
forall a. Parser a -> ByteString -> Either String a
parseOnly Parser a
p ByteString
s of
Left String
err -> Field -> String -> String -> a
forall a. Field -> String -> String -> a
conversionFailed Field
f (TypeRep -> String
forall a. Show a => a -> String
show (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
dummy)) String
err
Right a
v -> a
v