diff --git a/Data/Convertible/Base.hs b/Data/Convertible/Base.hs --- a/Data/Convertible/Base.hs +++ b/Data/Convertible/Base.hs @@ -1,10 +1,9 @@ {-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE OverlappingInstances #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE TemplateHaskell #-} {- Copyright (C) 2009 John Goerzen @@ -26,15 +25,20 @@ -} module Data.Convertible.Base( ConvertAttempt (..), + failure, ConvertSuccess (..), + cs, + ca, ConversionException (..), convertUnsafe, - convertAttemptWrap + convertAttemptWrap, + deriveAttempts ) where import Data.Attempt import Control.Exception (Exception) import Data.Typeable (Typeable) +import Language.Haskell.TH ---------------------------------------------------------------------- -- Conversions @@ -47,20 +51,27 @@ -} convertAttempt :: a -> Attempt b +-- | A convenience synonym for 'convertAttempt' +ca :: ConvertAttempt x y => x -> Attempt y +ca = convertAttempt + {- | A typeclass that represents something that guarantees a successful conversion. A @ConvertSuccess a b@ instance represents an @a@ that can be converted to a @b@. -} -class ConvertAttempt a b => ConvertSuccess a b where +class ConvertSuccess a b where {- | Convert @a@ to @b@. -} convertSuccess :: a -> b -instance ConvertSuccess a b => ConvertAttempt a b where - convertAttempt = return . convertSuccess +-- | A convenience synonym for 'convertSuccess' +cs :: ConvertSuccess x y => x -> y +cs = convertSuccess {- | Any type can be converted to itself. -} instance ConvertSuccess a a where convertSuccess = id +instance ConvertAttempt a a where + convertAttempt = return -{- +{- FIXME consider exposing this {- | Lists of any convertible type can be converted. -} instance Convertible a b => Convertible [a] [b] where safeConvert = mapM safeConvert @@ -90,3 +101,22 @@ -> m b convertAttemptWrap = attempt (failure . ConversionException) return . convertAttempt + +convertAttempt' :: ConvertSuccess x y => x -> Attempt y +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') [] + ] + ] diff --git a/Data/Convertible/Instances/C.hs b/Data/Convertible/Instances/C.hs --- a/Data/Convertible/Instances/C.hs +++ b/Data/Convertible/Instances/C.hs @@ -1,6 +1,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE TemplateHaskell #-} {- | Module : Data.Convertible.Instances.C Copyright : Copyright (C) 2009 John Goerzen @@ -28,6 +29,82 @@ import Data.Int import Data.Word import Foreign.C.Types + +$(deriveAttempts + [ (''CChar, ''Integer) + , (''CDouble, ''CFloat) + , (''CDouble, ''CLDouble) + , (''CDouble, ''Double) + , (''CDouble, ''Float) + , (''CDouble, ''Integer) + , (''CDouble, ''Rational) + , (''CFloat, ''CDouble) + , (''CFloat, ''CLDouble) + , (''CFloat, ''Double) + , (''CFloat, ''Float) + , (''CFloat, ''Integer) + , (''CFloat, ''Rational) + , (''CInt, ''Integer) + , (''CLDouble, ''CDouble) + , (''CLDouble, ''CFloat) + , (''CLDouble, ''Double) + , (''CLDouble, ''Float) + , (''CLDouble, ''Integer) + , (''CLDouble, ''Rational) + , (''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) + , (''Double, ''CLDouble) + , (''Float, ''CDouble) + , (''Float, ''CFloat) + , (''Float, ''CLDouble) + , (''Int16, ''CDouble) + , (''Int16, ''CFloat) + , (''Int16, ''CLDouble) + , (''Int32, ''CDouble) + , (''Int32, ''CFloat) + , (''Int32, ''CLDouble) + , (''Int64, ''CDouble) + , (''Int64, ''CFloat) + , (''Int64, ''CLDouble) + , (''Int8, ''CDouble) + , (''Int8, ''CFloat) + , (''Int8, ''CLDouble) + , (''Int, ''CDouble) + , (''Int, ''CFloat) + , (''Int, ''CLDouble) + , (''Integer, ''CDouble) + , (''Integer, ''CFloat) + , (''Integer, ''CLDouble) + , (''Rational, ''CDouble) + , (''Rational, ''CFloat) + , (''Rational, ''CLDouble) + , (''Word16, ''CDouble) + , (''Word16, ''CFloat) + , (''Word16, ''CLDouble) + , (''Word32, ''CDouble) + , (''Word32, ''CFloat) + , (''Word32, ''CLDouble) + , (''Word64, ''CDouble) + , (''Word64, ''CFloat) + , (''Word64, ''CLDouble) + , (''Word8, ''CDouble) + , (''Word8, ''CFloat) + , (''Word8, ''CLDouble) + , (''Word, ''CDouble) + , (''Word, ''CFloat) + , (''Word, ''CLDouble) + ]) -- remainder of this file generated by utils/genCinstances.hs diff --git a/Data/Convertible/Instances/Map.hs b/Data/Convertible/Instances/Map.hs --- a/Data/Convertible/Instances/Map.hs +++ b/Data/Convertible/Instances/Map.hs @@ -28,6 +28,10 @@ instance Ord k => ConvertSuccess [(k, a)] (Map.Map k a) where convertSuccess = Map.fromList +instance Ord k => ConvertAttempt [(k, a)] (Map.Map k a) where + convertAttempt = return . convertSuccess instance ConvertSuccess (Map.Map k a) [(k, a)] where convertSuccess = Map.toList +instance ConvertAttempt (Map.Map k a) [(k, a)] where + convertAttempt = return . convertSuccess diff --git a/Data/Convertible/Instances/Num.hs b/Data/Convertible/Instances/Num.hs --- a/Data/Convertible/Instances/Num.hs +++ b/Data/Convertible/Instances/Num.hs @@ -1,6 +1,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE TemplateHaskell #-} {- | Module : Data.Convertible.Instances.Num Copyright : Copyright (C) 2009 John Goerzen @@ -44,11 +45,65 @@ ------------------------------------------------------------ -instance ConvertSuccess Integer Integer where - convertSuccess = id - instance ConvertSuccess Char Integer where convertSuccess = fromIntegral . fromEnum +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) + ]) {- The following instances generated by util/genNumInstances.hs diff --git a/Data/Convertible/Instances/String.hs b/Data/Convertible/Instances/String.hs --- a/Data/Convertible/Instances/String.hs +++ b/Data/Convertible/Instances/String.hs @@ -2,6 +2,9 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} --------------------------------------------------------- -- @@ -20,6 +23,9 @@ module Data.Convertible.Instances.String ( InvalidDayException (..) , InvalidBoolException (..) +#if TEST + , testSuite +#endif ) where import Data.Convertible.Base @@ -36,8 +42,40 @@ import qualified Data.Text.Lazy as LT import Data.Time.Calendar -import Data.Ratio (Ratio) +#if TEST +import Test.Framework (testGroup, Test) +--import Test.Framework.Providers.HUnit +import Test.Framework.Providers.QuickCheck (testProperty) +--import Test.HUnit hiding (Test, path) +import Test.QuickCheck +import Data.Char (isDigit) +import Data.Ratio ((%)) +#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) + ]) + {- Not needed yet fromString :: ConvertSuccess String a => String -> a fromString = convertSuccess @@ -108,11 +146,32 @@ convertAttempt = SF.read -- Rational -instance ConvertSuccess (Ratio Integer) [Char] where - convertSuccess = show -instance ConvertAttempt [Char] (Ratio Integer) where - convertAttempt = SF.read +instance ConvertSuccess Rational [Char] where + convertSuccess = show . (fromRational :: Rational -> Double) +instance ConvertAttempt [Char] Rational where + convertAttempt = fmap realToFrac . (SF.read :: String -> Attempt Double) +#if TEST +instance Arbitrary Rational where + coarbitrary = undefined + arbitrary = do + n <- arbitrary + d' <- arbitrary + let d = if d' == 0 then 1 else d' + return (n % d) + +propRationalId :: Rational -> Bool +propRationalId r = convertAttempt (convertSuccess r :: String) `almostEquals` r + +almostEquals :: Attempt Rational -> Rational -> Bool +almostEquals (Failure _) _ = False +almostEquals (Success x) y = abs (x - y) < 0.0001 + +propRationalAllDigits :: Rational -> Bool +propRationalAllDigits = all (\c -> isDigit c || c `elem` ".-e") + . convertSuccess +#endif + -- Instances for bytestrings and text (generated by utils/StringHelper.hs) instance ConvertAttempt BS.ByteString Day where @@ -139,13 +198,13 @@ convertAttempt = fromStringA <=< convertAttempt instance ConvertAttempt LT.Text Int where convertAttempt = fromStringA <=< convertAttempt -instance ConvertAttempt BS.ByteString (Ratio Integer) where +instance ConvertAttempt BS.ByteString Rational where convertAttempt = fromStringA <=< convertAttempt -instance ConvertAttempt BL.ByteString (Ratio Integer) where +instance ConvertAttempt BL.ByteString Rational where convertAttempt = fromStringA <=< convertAttempt -instance ConvertAttempt ST.Text (Ratio Integer) where +instance ConvertAttempt ST.Text Rational where convertAttempt = fromStringA <=< convertAttempt -instance ConvertAttempt LT.Text (Ratio Integer) where +instance ConvertAttempt LT.Text Rational where convertAttempt = fromStringA <=< convertAttempt instance ConvertSuccess Day BS.ByteString where convertSuccess = convertSuccess . toString @@ -171,11 +230,19 @@ convertSuccess = convertSuccess . toString instance ConvertSuccess Int LT.Text where convertSuccess = convertSuccess . toString -instance ConvertSuccess (Ratio Integer) BS.ByteString where +instance ConvertSuccess Rational BS.ByteString where convertSuccess = convertSuccess . toString -instance ConvertSuccess (Ratio Integer) BL.ByteString where +instance ConvertSuccess Rational BL.ByteString where convertSuccess = convertSuccess . toString -instance ConvertSuccess (Ratio Integer) ST.Text where +instance ConvertSuccess Rational ST.Text where convertSuccess = convertSuccess . toString -instance ConvertSuccess (Ratio Integer) LT.Text where +instance ConvertSuccess Rational LT.Text where convertSuccess = convertSuccess . toString + +#if TEST +testSuite :: Test +testSuite = testGroup "Data.Convertible.Instances.String" + [ testProperty "propRationalId" propRationalId + , testProperty "propRationalAllDigits" propRationalAllDigits + ] +#endif diff --git a/Data/Convertible/Instances/Text.hs b/Data/Convertible/Instances/Text.hs --- a/Data/Convertible/Instances/Text.hs +++ b/Data/Convertible/Instances/Text.hs @@ -1,6 +1,8 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} --------------------------------------------------------- -- @@ -26,14 +28,35 @@ import qualified Data.Text.Encoding as STE import qualified Data.Text.Lazy.Encoding as LTE +$(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) + ]) + toST :: ConvertSuccess a ST.Text => a -> ST.Text toST = convertSuccess toLT :: ConvertSuccess a LT.Text => a -> LT.Text toLT = convertSuccess -instance ConvertSuccess [Char] [Char] where - convertSuccess = id instance ConvertSuccess [Char] BS.ByteString where convertSuccess = convertSuccess . toST instance ConvertSuccess [Char] BL.ByteString where @@ -44,8 +67,6 @@ convertSuccess = LT.pack instance ConvertSuccess BS.ByteString [Char] where convertSuccess = convertSuccess . toST -instance ConvertSuccess BS.ByteString BS.ByteString where - convertSuccess = id instance ConvertSuccess BS.ByteString BL.ByteString where convertSuccess = BL.fromChunks . return instance ConvertSuccess BS.ByteString ST.Text where @@ -56,8 +77,6 @@ convertSuccess = convertSuccess . toLT instance ConvertSuccess BL.ByteString BS.ByteString where convertSuccess = BS.concat . BL.toChunks -instance ConvertSuccess BL.ByteString BL.ByteString where - convertSuccess = id instance ConvertSuccess BL.ByteString ST.Text where convertSuccess = convertSuccess . BS.concat . BL.toChunks instance ConvertSuccess BL.ByteString LT.Text where @@ -68,8 +87,6 @@ convertSuccess = STE.encodeUtf8 instance ConvertSuccess ST.Text BL.ByteString where convertSuccess = convertSuccess . STE.encodeUtf8 -instance ConvertSuccess ST.Text ST.Text where - convertSuccess = id instance ConvertSuccess ST.Text LT.Text where convertSuccess = LT.fromChunks . return instance ConvertSuccess LT.Text [Char] where @@ -80,5 +97,3 @@ convertSuccess = LTE.encodeUtf8 instance ConvertSuccess LT.Text ST.Text where convertSuccess = ST.concat . LT.toChunks -instance ConvertSuccess LT.Text LT.Text where - convertSuccess = id diff --git a/Data/Convertible/Instances/Time.hs b/Data/Convertible/Instances/Time.hs --- a/Data/Convertible/Instances/Time.hs +++ b/Data/Convertible/Instances/Time.hs @@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE TemplateHaskell #-} {- | Module : Data.ConvertAttempt.Instances.Time Copyright : Copyright (C) 2009 John Goerzen @@ -40,6 +41,15 @@ #endif 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) + ]) ---------------------------------------------------------------------- -- Intra-System.Time stuff diff --git a/convertible-text.cabal b/convertible-text.cabal --- a/convertible-text.cabal +++ b/convertible-text.cabal @@ -1,5 +1,5 @@ Name: convertible-text -Version: 0.0.0 +Version: 0.2.0 License: LGPL Maintainer: Michael Snoyman Author: John Goerzen, Michael Snoyman @@ -22,17 +22,30 @@ Cabal-Version: >=1.2 +flag buildtests + description: Build the executable to run unit tests + default: False + +flag nolib + description: Skip building the library. + default: False + flag time_gte_113 description: time > 1.1.3 has defined some more instances so omit them here library + if flag(nolib) + Buildable: False + else + Buildable: True Build-Depends: base >= 4 && < 5, old-time >= 1.0.0.2 && < 1.1, containers >= 0.2.0.1 && < 0.3, text >= 0.5 && < 0.6, bytestring >= 0.9.1.4 && < 0.10, safe-failure >= 0.4 && < 0.5, - attempt >= 0.2.0 && < 0.3 + attempt >= 0.2.1 && < 0.3, + template-haskell if flag(time_gte_113) Build-Depends: time>=1.1.3 && <= 1.1.4 CPP-OPTIONS: -DTIME_GTE_113 @@ -51,3 +64,17 @@ Data.Convertible.Instances.Time, Data.Convertible.Instances.Text, Data.Convertible.Instances.String + +executable runtests + if flag(buildtests) + Buildable: True + cpp-options: -DTEST + build-depends: test-framework, + test-framework-quickcheck, + test-framework-hunit, + HUnit, + QuickCheck >= 1 && < 2 + else + Buildable: False + ghc-options: -Wall + main-is: runtests.hs diff --git a/runtests.hs b/runtests.hs new file mode 100644 --- /dev/null +++ b/runtests.hs @@ -0,0 +1,8 @@ +import Test.Framework (defaultMain) + +import qualified Data.Convertible.Instances.String + +main :: IO () +main = defaultMain + [ Data.Convertible.Instances.String.testSuite + ]