{-# 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
-- Copyright:   (c) 2011 MailRank, Inc.
-- License:     BSD3
-- Maintainer:  Paul Rouse <pyr@doynton.org>
-- Stability:   experimental
-- Portability: portable
--
-- The 'Result' typeclass, for converting a single value in a row
-- returned by a SQL query into a more useful Haskell representation.
--
-- A Haskell numeric type is considered to be compatible with all
-- MySQL numeric types that are less accurate than it. For instance,
-- the Haskell 'Double' type is compatible with the MySQL 'Long' type
-- because it can represent a 'Long' exactly. On the other hand, since
-- a 'Double' might lose precision if representing a 'LongLong', the
-- two are /not/ considered compatible.

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

-- | Exception thrown if conversion from a SQL value to a Haskell
-- value fails.
data ResultError = Incompatible { ResultError -> String
errSQLType :: String
                                , ResultError -> String
errHaskellType :: String
                                , ResultError -> String
errFieldName :: String
                                , ResultError -> String
errMessage :: String }
                 -- ^ The SQL and Haskell types are not compatible.
                 | UnexpectedNull { errSQLType :: String
                                  , errHaskellType :: String
                                  , errFieldName :: String
                                  , errMessage :: String }
                 -- ^ A SQL @NULL@ was encountered when the Haskell
                 -- type did not permit it.
                 | ConversionFailed { errSQLType :: String
                                    , errHaskellType :: String
                                    , errFieldName :: String
                                    , errMessage :: String }
                 -- ^ The SQL value could not be parsed, or could not
                 -- be represented as a valid Haskell value, or an
                 -- unexpected low-level error occurred (e.g. mismatch
                 -- between metadata and actual data in a row).
                   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

-- | A type that can be converted from a 'ByteString'.  Any type which is
-- an instance of this class, and is 'Typeable', can use the default
-- implementation of 'Result'.  This provides a method of implementing
-- a decoder for any text-like column, such as @TEXT@, @BLOB@, or @JSON@,
-- instead of implementing 'Result' directly.
--
-- The first component of the tuple returned by 'fromField' is a list of
-- acceptable column types, expressed in terms of
-- 'Database.MySQL.Base.Types.Type'.
--
-- @since 0.4.8
--
class FromField a where
    fromField :: ([Type], ByteString -> Either String a)

-- | A type that may be converted from a SQL type.
--
-- A default implementation is provided for any type which is an instance
-- of both 'FromField' and 'Typeable', providing a simple mechanism for
-- user-defined decoding from text- or blob-like fields (including @JSON@).
--
class Result a where
    convert :: Field -> Maybe ByteString -> a
    -- ^ Convert a SQL value to a Haskell value.
    --
    -- Throws a 'ResultError' if conversion fails.
    --
    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
                     -- https://dev.mysql.com/doc/refman/8.0/en/datetime.html
                     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

-- A specialised version of parseTimeM which builds in the defaults we want,
-- and produces an Either result.  For the latter provide a wrapper for Either,
-- local to this module, to add a MonadFail instance.
--
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