From 09c9a4ae059e623bdffe6e43aa855332efa79d91 Mon Sep 17 00:00:00 2001 From: PHO Date: Sun, 4 Dec 2011 22:43:48 +0900 Subject: [PATCH] deriveAttempts should take pairs of Q Type rather than Name. With this change we can derive instances for non-nullary types (e.g. Map String Bool), not just for nullary ones (e.g. Int). It requires an API version bump though. --- Data/Convertible/Base.hs | 22 +++--- Data/Convertible/Instances/C.hs | 102 +++++++++++++------------- Data/Convertible/Instances/Num.hs | 104 +++++++++++++-------------- Data/Convertible/Instances/String.hs | 40 +++++------ Data/Convertible/Instances/Text.hs | 40 +++++------ Data/Convertible/Instances/Time.hs | 12 ++-- 6 files changed, 159 insertions(+), 161 deletions(-) diff --git a/Data/Convertible/Base.hs b/Data/Convertible/Base.hs index dbdaf25..84acc91 100644 --- a/Data/Convertible/Base.hs +++ b/Data/Convertible/Base.hs @@ -107,16 +107,14 @@ convertAttempt' = return . convertSuccess -- | Template Haskell to derive 'ConvertAttempt' instances from the -- corresponding 'ConvertSuccess' instances. -deriveAttempts :: [(Name, Name)] -> Q [Dec] -deriveAttempts pairs = do - ca' <- [|convertAttempt'|] - return $ map (helper ca') pairs - where - helper ca' (x, y) = - InstanceD - [] - (ConT (mkName "ConvertAttempt") `AppT` ConT x `AppT` ConT y) - [ FunD (mkName "convertAttempt") - [ Clause [] (NormalB ca') [] +deriveAttempts :: [(Q Type, Q Type)] -> Q [Dec] +deriveAttempts = mapM helper + where + helper (x, y) = + instanceD + (cxt []) + (conT ''ConvertAttempt `appT` x `appT` y) + [ funD 'convertAttempt + [ clause [] (normalB [| convertAttempt' |]) [] ] - ] + ] diff --git a/Data/Convertible/Instances/C.hs b/Data/Convertible/Instances/C.hs index 9fb58e3..68853bb 100644 --- a/Data/Convertible/Instances/C.hs +++ b/Data/Convertible/Instances/C.hs @@ -31,57 +31,57 @@ import Data.Word import Foreign.C.Types $(deriveAttempts - [ (''CChar, ''Integer) - , (''CDouble, ''CFloat) - , (''CDouble, ''Double) - , (''CDouble, ''Float) - , (''CDouble, ''Integer) - , (''CDouble, ''Rational) - , (''CFloat, ''CDouble) - , (''CFloat, ''Double) - , (''CFloat, ''Float) - , (''CFloat, ''Integer) - , (''CFloat, ''Rational) - , (''CInt, ''Integer) - , (''CLLong, ''Integer) - , (''CLong, ''Integer) - , (''CSChar, ''Integer) - , (''CShort, ''Integer) - , (''CSize, ''Integer) - , (''CUChar, ''Integer) - , (''CUInt, ''Integer) - , (''CULLong, ''Integer) - , (''CULong, ''Integer) - , (''CUShort, ''Integer) - , (''CWchar, ''Integer) - , (''Double, ''CDouble) - , (''Double, ''CFloat) - , (''Float, ''CDouble) - , (''Float, ''CFloat) - , (''Int16, ''CDouble) - , (''Int16, ''CFloat) - , (''Int32, ''CDouble) - , (''Int32, ''CFloat) - , (''Int64, ''CDouble) - , (''Int64, ''CFloat) - , (''Int8, ''CDouble) - , (''Int8, ''CFloat) - , (''Int, ''CDouble) - , (''Int, ''CFloat) - , (''Integer, ''CDouble) - , (''Integer, ''CFloat) - , (''Rational, ''CDouble) - , (''Rational, ''CFloat) - , (''Word16, ''CDouble) - , (''Word16, ''CFloat) - , (''Word32, ''CDouble) - , (''Word32, ''CFloat) - , (''Word64, ''CDouble) - , (''Word64, ''CFloat) - , (''Word8, ''CDouble) - , (''Word8, ''CFloat) - , (''Word, ''CDouble) - , (''Word, ''CFloat) + [ ([t| CChar |], [t| Integer |]) + , ([t| CDouble |], [t| CFloat |]) + , ([t| CDouble |], [t| Double |]) + , ([t| CDouble |], [t| Float |]) + , ([t| CDouble |], [t| Integer |]) + , ([t| CDouble |], [t| Rational |]) + , ([t| CFloat |], [t| CDouble |]) + , ([t| CFloat |], [t| Double |]) + , ([t| CFloat |], [t| Float |]) + , ([t| CFloat |], [t| Integer |]) + , ([t| CFloat |], [t| Rational |]) + , ([t| CInt |], [t| Integer |]) + , ([t| CLLong |], [t| Integer |]) + , ([t| CLong |], [t| Integer |]) + , ([t| CSChar |], [t| Integer |]) + , ([t| CShort |], [t| Integer |]) + , ([t| CSize |], [t| Integer |]) + , ([t| CUChar |], [t| Integer |]) + , ([t| CUInt |], [t| Integer |]) + , ([t| CULLong |], [t| Integer |]) + , ([t| CULong |], [t| Integer |]) + , ([t| CUShort |], [t| Integer |]) + , ([t| CWchar |], [t| Integer |]) + , ([t| Double |], [t| CDouble |]) + , ([t| Double |], [t| CFloat |]) + , ([t| Float |], [t| CDouble |]) + , ([t| Float |], [t| CFloat |]) + , ([t| Int16 |], [t| CDouble |]) + , ([t| Int16 |], [t| CFloat |]) + , ([t| Int32 |], [t| CDouble |]) + , ([t| Int32 |], [t| CFloat |]) + , ([t| Int64 |], [t| CDouble |]) + , ([t| Int64 |], [t| CFloat |]) + , ([t| Int8 |], [t| CDouble |]) + , ([t| Int8 |], [t| CFloat |]) + , ([t| Int |], [t| CDouble |]) + , ([t| Int |], [t| CFloat |]) + , ([t| Integer |], [t| CDouble |]) + , ([t| Integer |], [t| CFloat |]) + , ([t| Rational |], [t| CDouble |]) + , ([t| Rational |], [t| CFloat |]) + , ([t| Word16 |], [t| CDouble |]) + , ([t| Word16 |], [t| CFloat |]) + , ([t| Word32 |], [t| CDouble |]) + , ([t| Word32 |], [t| CFloat |]) + , ([t| Word64 |], [t| CDouble |]) + , ([t| Word64 |], [t| CFloat |]) + , ([t| Word8 |], [t| CDouble |]) + , ([t| Word8 |], [t| CFloat |]) + , ([t| Word |], [t| CDouble |]) + , ([t| Word |], [t| CFloat |]) ]) -- remainder of this file generated by utils/genCinstances.hs diff --git a/Data/Convertible/Instances/Num.hs b/Data/Convertible/Instances/Num.hs index 1376a50..544bbf1 100644 --- a/Data/Convertible/Instances/Num.hs +++ b/Data/Convertible/Instances/Num.hs @@ -51,58 +51,58 @@ instance ConvertAttempt Char Integer where convertAttempt = return . convertSuccess $(deriveAttempts - [ (''Double, ''Integer) - , (''Float, ''Integer) - , (''Rational, ''Integer) - , (''Int, ''Integer) - , (''Int8, ''Integer) - , (''Int16, ''Integer) - , (''Int32, ''Integer) - , (''Int64, ''Integer) - , (''Word, ''Integer) - , (''Word8, ''Integer) - , (''Word16, ''Integer) - , (''Word32, ''Integer) - , (''Word64, ''Integer) - , (''Integer, ''Double) - , (''Integer, ''Float) - , (''Integer, ''Rational) - , (''Int, ''Double) - , (''Int8, ''Double) - , (''Int16, ''Double) - , (''Int32, ''Double) - , (''Int64, ''Double) - , (''Word, ''Double) - , (''Word8, ''Double) - , (''Word16, ''Double) - , (''Word32, ''Double) - , (''Word64, ''Double) - , (''Int, ''Float) - , (''Int8, ''Float) - , (''Int16, ''Float) - , (''Int32, ''Float) - , (''Int64, ''Float) - , (''Word, ''Float) - , (''Word8, ''Float) - , (''Word16, ''Float) - , (''Word32, ''Float) - , (''Word64, ''Float) - , (''Int, ''Rational) - , (''Int8, ''Rational) - , (''Int16, ''Rational) - , (''Int32, ''Rational) - , (''Int64, ''Rational) - , (''Word, ''Rational) - , (''Word8, ''Rational) - , (''Word16, ''Rational) - , (''Word32, ''Rational) - , (''Word64, ''Rational) - , (''Double, ''Float) - , (''Double, ''Rational) - , (''Float, ''Double) - , (''Float, ''Rational) - , (''Rational, ''Double) - , (''Rational, ''Float) + [ ([t| Double |], [t| Integer |]) + , ([t| Float |], [t| Integer |]) + , ([t| Rational |], [t| Integer |]) + , ([t| Int |], [t| Integer |]) + , ([t| Int8 |], [t| Integer |]) + , ([t| Int16 |], [t| Integer |]) + , ([t| Int32 |], [t| Integer |]) + , ([t| Int64 |], [t| Integer |]) + , ([t| Word |], [t| Integer |]) + , ([t| Word8 |], [t| Integer |]) + , ([t| Word16 |], [t| Integer |]) + , ([t| Word32 |], [t| Integer |]) + , ([t| Word64 |], [t| Integer |]) + , ([t| Integer |], [t| Double |]) + , ([t| Integer |], [t| Float |]) + , ([t| Integer |], [t| Rational |]) + , ([t| Int |], [t| Double |]) + , ([t| Int8 |], [t| Double |]) + , ([t| Int16 |], [t| Double |]) + , ([t| Int32 |], [t| Double |]) + , ([t| Int64 |], [t| Double |]) + , ([t| Word |], [t| Double |]) + , ([t| Word8 |], [t| Double |]) + , ([t| Word16 |], [t| Double |]) + , ([t| Word32 |], [t| Double |]) + , ([t| Word64 |], [t| Double |]) + , ([t| Int |], [t| Float |]) + , ([t| Int8 |], [t| Float |]) + , ([t| Int16 |], [t| Float |]) + , ([t| Int32 |], [t| Float |]) + , ([t| Int64 |], [t| Float |]) + , ([t| Word |], [t| Float |]) + , ([t| Word8 |], [t| Float |]) + , ([t| Word16 |], [t| Float |]) + , ([t| Word32 |], [t| Float |]) + , ([t| Word64 |], [t| Float |]) + , ([t| Int |], [t| Rational |]) + , ([t| Int8 |], [t| Rational |]) + , ([t| Int16 |], [t| Rational |]) + , ([t| Int32 |], [t| Rational |]) + , ([t| Int64 |], [t| Rational |]) + , ([t| Word |], [t| Rational |]) + , ([t| Word8 |], [t| Rational |]) + , ([t| Word16 |], [t| Rational |]) + , ([t| Word32 |], [t| Rational |]) + , ([t| Word64 |], [t| Rational |]) + , ([t| Double |], [t| Float |]) + , ([t| Double |], [t| Rational |]) + , ([t| Float |], [t| Double |]) + , ([t| Float |], [t| Rational |]) + , ([t| Rational |], [t| Double |]) + , ([t| Rational |], [t| Float |]) ]) {- The following instances generated by util/genNumInstances.hs diff --git a/Data/Convertible/Instances/String.hs b/Data/Convertible/Instances/String.hs index 795c981..686fbbd 100644 --- a/Data/Convertible/Instances/String.hs +++ b/Data/Convertible/Instances/String.hs @@ -52,26 +52,26 @@ import Data.Char (isDigit) #endif $(deriveAttempts - [ (''Bool, ''BL.ByteString) - , (''Bool, ''BS.ByteString) - , (''Bool, ''String) - , (''Bool, ''LT.Text) - , (''Bool, ''ST.Text) - , (''Day, ''BL.ByteString) - , (''Day, ''BS.ByteString) - , (''Day, ''String) - , (''Day, ''LT.Text) - , (''Day, ''ST.Text) - , (''Int, ''BL.ByteString) - , (''Int, ''BS.ByteString) - , (''Int, ''String) - , (''Int, ''LT.Text) - , (''Int, ''ST.Text) - , (''Rational, ''BL.ByteString) - , (''Rational, ''BS.ByteString) - , (''Rational, ''String) - , (''Rational, ''LT.Text) - , (''Rational, ''ST.Text) + [ ([t| Bool |], [t| BL.ByteString |]) + , ([t| Bool |], [t| BS.ByteString |]) + , ([t| Bool |], [t| String |]) + , ([t| Bool |], [t| LT.Text |]) + , ([t| Bool |], [t| ST.Text |]) + , ([t| Day |], [t| BL.ByteString |]) + , ([t| Day |], [t| BS.ByteString |]) + , ([t| Day |], [t| String |]) + , ([t| Day |], [t| LT.Text |]) + , ([t| Day |], [t| ST.Text |]) + , ([t| Int |], [t| BL.ByteString |]) + , ([t| Int |], [t| BS.ByteString |]) + , ([t| Int |], [t| String |]) + , ([t| Int |], [t| LT.Text |]) + , ([t| Int |], [t| ST.Text |]) + , ([t| Rational |], [t| BL.ByteString |]) + , ([t| Rational |], [t| BS.ByteString |]) + , ([t| Rational |], [t| String |]) + , ([t| Rational |], [t| LT.Text |]) + , ([t| Rational |], [t| ST.Text |]) ]) {- Not needed yet diff --git a/Data/Convertible/Instances/Text.hs b/Data/Convertible/Instances/Text.hs index 59e0f51..2e64f76 100644 --- a/Data/Convertible/Instances/Text.hs +++ b/Data/Convertible/Instances/Text.hs @@ -29,26 +29,26 @@ import qualified Data.Text.Encoding as STE import qualified Data.Text.Encoding.Error as TEE $(deriveAttempts - [ (''BL.ByteString, ''BS.ByteString) - , (''BL.ByteString, ''String) - , (''BL.ByteString, ''LT.Text) - , (''BL.ByteString, ''ST.Text) - , (''BS.ByteString, ''BL.ByteString) - , (''BS.ByteString, ''String) - , (''BS.ByteString, ''LT.Text) - , (''BS.ByteString, ''ST.Text) - , (''String, ''BL.ByteString) - , (''String, ''BS.ByteString) - , (''String, ''LT.Text) - , (''String, ''ST.Text) - , (''LT.Text, ''BL.ByteString) - , (''LT.Text, ''BS.ByteString) - , (''LT.Text, ''String) - , (''LT.Text, ''ST.Text) - , (''ST.Text, ''BL.ByteString) - , (''ST.Text, ''BS.ByteString) - , (''ST.Text, ''String) - , (''ST.Text, ''LT.Text) + [ ([t| BL.ByteString |], [t| BS.ByteString |]) + , ([t| BL.ByteString |], [t| String |]) + , ([t| BL.ByteString |], [t| LT.Text |]) + , ([t| BL.ByteString |], [t| ST.Text |]) + , ([t| BS.ByteString |], [t| BL.ByteString |]) + , ([t| BS.ByteString |], [t| String |]) + , ([t| BS.ByteString |], [t| LT.Text |]) + , ([t| BS.ByteString |], [t| ST.Text |]) + , ([t| String |], [t| BL.ByteString |]) + , ([t| String |], [t| BS.ByteString |]) + , ([t| String |], [t| LT.Text |]) + , ([t| String |], [t| ST.Text |]) + , ([t| LT.Text |], [t| BL.ByteString |]) + , ([t| LT.Text |], [t| BS.ByteString |]) + , ([t| LT.Text |], [t| String |]) + , ([t| LT.Text |], [t| ST.Text |]) + , ([t| ST.Text |], [t| BL.ByteString |]) + , ([t| ST.Text |], [t| BS.ByteString |]) + , ([t| ST.Text |], [t| String |]) + , ([t| ST.Text |], [t| LT.Text |]) ]) toST :: ConvertSuccess a ST.Text => a -> ST.Text diff --git a/Data/Convertible/Instances/Time.hs b/Data/Convertible/Instances/Time.hs index 5f5c705..16f3fb5 100644 --- a/Data/Convertible/Instances/Time.hs +++ b/Data/Convertible/Instances/Time.hs @@ -43,12 +43,12 @@ import Data.Ratio import Foreign.C.Types $(deriveAttempts - [ (''NominalDiffTime, ''ST.TimeDiff) - , (''POSIXTime, ''ST.ClockTime) - , (''ST.CalendarTime, ''ZonedTime) - , (''ST.ClockTime, ''POSIXTime) - , (''ST.TimeDiff, ''NominalDiffTime) - , (''ZonedTime, ''ST.CalendarTime) + [ ([t| NominalDiffTime |], [t| ST.TimeDiff |]) + , ([t| POSIXTime |], [t| ST.ClockTime |]) + , ([t| ST.CalendarTime |], [t| ZonedTime |]) + , ([t| ST.ClockTime |], [t| POSIXTime |]) + , ([t| ST.TimeDiff |], [t| NominalDiffTime |]) + , ([t| ZonedTime |], [t| ST.CalendarTime |]) ]) ----------------------------------------------------------------------