{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleInstances #-}-- |-- Module: Database.PostgreSQL.Simpe.QueryResults-- Copyright: (c) 2011 Chris Done, 2011 MailRank, Inc.-- License: BSD3-- Maintainer: Chris Done <chrisdone@gmail.com>-- 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.moduleDatabase.PostgreSQL.Simple.Result(Result(..),ResultError(..))where#include "MachDeps.h"importControl.Applicative((<$>),(<*>),(<*),(<|>))importControl.Exception(Exception,throw)importData.Attoparsec.Char8hiding(Result)importData.Bits((.&.),(.|.),shiftL)importData.ByteString(ByteString)importData.Int(Int16,Int32,Int64)importData.List(foldl')importData.Ratio(Ratio)importData.Time.Calendar(Day,fromGregorian)importData.Time.Clock(UTCTime)importData.Time.Format(parseTime)importData.Time.LocalTime(TimeOfDay,LocalTime,ZonedTime,makeTimeOfDayValid)importData.Typeable(TypeRep,Typeable,typeOf)importData.Word(Word,Word16,Word32,Word64)importDatabase.PostgreSQL.Base.Types(Field(..),Type(..),FormatCode(..))importSystem.Locale(defaultTimeLocale)importqualifiedData.ByteStringasSBimportqualifiedData.ByteString.Char8asB8importqualifiedData.ByteString.LazyasLBimportqualifiedData.TextasSTimportqualifiedData.Text.EncodingasSTimportqualifiedData.Text.LazyasLT-- | Exception thrown if conversion from a SQL value to a Haskell-- value fails.dataResultError=Incompatible{errSQLType::String,errHaskellType::String,errMessage::String}-- ^ The SQL and Haskell types are not compatible.|UnexpectedNull{errSQLType::String,errHaskellType::String,errMessage::String}-- ^ A SQL @NULL@ was encountered when the Haskell-- type did not permit it.|ConversionFailed{errSQLType::String,errHaskellType::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(Eq,Show,Typeable)instanceExceptionResultError-- | A type that may be converted from a SQL type.classResultawhereconvert::Field->MaybeByteString->a-- ^ Convert a SQL value to a Haskell value.---- Throws a 'ResultError' if conversion fails.instance(Resulta)=>Result(Maybea)whereconvert_Nothing=Nothingconvertfbs=Just(convertfbs)instanceResultBoolwhereconvert_(Justt)|str=="t"=True|str=="f"=Falsewherestr=B8.unpacktconvertf_=conversionFailedf"Bool""could not parse"instanceResultInt16whereconvert=attook16$signeddecimalinstanceResultInt32whereconvert=attook32$signeddecimalinstanceResultIntwhereconvert=attookWord$signeddecimalinstanceResultInt64whereconvert=attook64$signeddecimalinstanceResultIntegerwhereconvert=attook64$signeddecimalinstanceResultWord16whereconvert=attook16decimalinstanceResultWord32whereconvert=attook32decimalinstanceResultWordwhereconvert=attookWorddecimalinstanceResultWord64whereconvert=attook64decimalinstanceResultFloatwhereconvert=attook((fromRational.toRational)<$>double)whereok=mkCompats[Real,Short,Long]instanceResultDoublewhereconvert=attookdoublewhereok=mkCompats[Real,DoublePrecision,Short,Long]instanceResult(RatioInteger)whereconvert=attookrationalwhereok=mkCompats[Decimal,Numeric,Real,DoublePrecision]instanceResultSB.ByteStringwhereconvertf=doConvertfokText$idinstanceResultLB.ByteStringwhereconvertf=LB.fromChunks.(:[]).convertfinstanceResultST.Textwhereconvertf|isTextf=doConvertfokText$ST.decodeUtf8|otherwise=incompatiblef(typeOfST.empty)"attempt to mix binary and text"instanceResultLT.Textwhereconvertf=LT.fromStrict.convertfinstanceResult[Char]whereconvertf=ST.unpack.convertfinstanceResultLocalTimewhereconvertf=doConvertfok$\bs->caseparseLocalTime(B8.unpackbs)ofJustt->tNothing->conversionFailedf"UTCTime""could not parse"whereok=mkCompats[TimestampWithZone]parseLocalTime::String->MaybeLocalTimeparseLocalTimes=parseTimedefaultTimeLocale"%F %T%Q"s<|>parseTimedefaultTimeLocale"%F %T%Q%z"(s++"00")instanceResultZonedTimewhereconvertf=doConvertfok$\bs->caseparseZonedTime(B8.unpackbs)ofJustt->tNothing->conversionFailedf"UTCTime""could not parse"whereok=mkCompats[TimestampWithZone]parseZonedTime::String->MaybeZonedTimeparseZonedTimes=parseTimedefaultTimeLocale"%F %T%Q%z"(s++"00")instanceResultUTCTimewhereconvertf=doConvertfok$\bs->caseparseTimedefaultTimeLocale"%F %T%Q"(B8.unpackbs)ofJustt->tNothing->conversionFailedf"UTCTime""could not parse"whereok=mkCompats[Timestamp]instanceResultDaywhereconvertf=flip(attook)f$datewhereok=mkCompats[Date]date=fromGregorian<$>(decimal<*char'-')<*>(decimal<*char'-')<*>decimalinstanceResultTimeOfDaywhereconvertf=flip(attook)f$dohours<-decimal<*char':'mins<-decimal<*char':'secs<-decimal::ParserIntcasemakeTimeOfDayValidhoursmins(fromIntegralsecs)ofJustt->returnt_->conversionFailedf"TimeOfDay""could not parse"whereok=mkCompats[Time]isText::Field->BoolisTextf=fieldFormatCodef==TextCodenewtypeCompat=CompatWord32mkCompats::[Type]->CompatmkCompats=foldl'f(Compat0).mapmkCompatwheref(Compata)(Compatb)=Compat(a.|.b)mkCompat::Type->CompatmkCompat=Compat.shiftL1.fromEnumcompat::Compat->Compat->Boolcompat(Compata)(Compatb)=a.&.b/=0okText,ok16,ok32,ok64,okWord::CompatokText=mkCompats[CharVarying,Characters,Text]ok16=mkCompats[Short]ok32=mkCompats[Short,Long]ok64=mkCompats[Short,Long,LongLong]#if WORD_SIZE_IN_BITS < 64okWord=ok32#elseokWord=ok64#endifdoConvert::(Typeablea)=>Field->Compat->(ByteString->a)->MaybeByteString->adoConvertftypescvt(Justbs)|mkCompat(fieldTypef)`compat`types=cvtbs|otherwise=incompatiblef(typeOf(cvtundefined))"types incompatible"doConvertf_cvt_=throw$UnexpectedNull(show(fieldTypef))(show(typeOf(cvtundefined)))""incompatible::Field->TypeRep->String->aincompatiblefr=throw.Incompatible(show(fieldTypef))(showr)conversionFailed::Field->String->String->aconversionFailedfs=throw.ConversionFailed(show(fieldTypef))satto::(Typeablea)=>Compat->Parsera->Field->MaybeByteString->aattotypesp0f=doConvertftypes$go(error"atto")p0wherego::(Typeablea)=>a->Parsera->ByteString->agodummyps=caseparseOnlypsofLefterr->conversionFailedf(show(typeOfdummy))errRightv->v