Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Removed overlapping and undecidable.

Now providing a Template Haskell function to generate ConvertAttempt
instances from ConvertSuccess ones. Also, ConvertAttempt is not a
superclass of ConvertSuccess, so users of the library won't be irritated
by having to generate the instances by default.
  • Loading branch information...
commit e6cf344bd748ceb9d328e3bd5fe1a8917002f12a 1 parent 4b1343c
@snoyberg authored
View
33 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 <jgoerzen@complete.org>
@@ -32,12 +31,14 @@ module Data.Convertible.Base( ConvertAttempt (..),
ca,
ConversionException (..),
convertUnsafe,
- convertAttemptWrap
+ convertAttemptWrap,
+ deriveAttempts
)
where
import Data.Attempt
import Control.Exception (Exception)
import Data.Typeable (Typeable)
+import Language.Haskell.TH
----------------------------------------------------------------------
-- Conversions
@@ -64,14 +65,13 @@ class ConvertSuccess a b where
cs :: ConvertSuccess x y => x -> y
cs = convertSuccess
-instance ConvertSuccess a b => ConvertAttempt a b where
- convertAttempt = return . 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
@@ -101,3 +101,22 @@ convertAttemptWrap :: (ConvertAttempt a b,
-> 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') []
+ ]
+ ]
View
77 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
@@ -29,6 +30,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
-- Section 1
View
4 Data/Convertible/Instances/Map.hs
@@ -28,6 +28,10 @@ import qualified Data.Map as Map
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
View
61 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 @@ import Data.Word
------------------------------------------------------------
-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
View
49 Data/Convertible/Instances/String.hs
@@ -2,7 +2,9 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE CPP #-}
+{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
---------------------------------------------------------
--
@@ -40,7 +42,6 @@ import qualified Data.Text as ST
import qualified Data.Text.Lazy as LT
import Data.Time.Calendar
-import Data.Ratio (Ratio)
#if TEST
import Test.Framework (testGroup, Test)
@@ -50,9 +51,31 @@ import Test.Framework.Providers.QuickCheck (testProperty)
import Test.QuickCheck
import Data.Char (isDigit)
import Data.Ratio ((%))
-import Debug.Trace
#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
@@ -123,13 +146,13 @@ instance ConvertAttempt [Char] Int where
convertAttempt = SF.read
-- Rational
-instance ConvertSuccess (Ratio Integer) [Char] where
+instance ConvertSuccess Rational [Char] where
convertSuccess = show . (fromRational :: Rational -> Double)
-instance ConvertAttempt [Char] (Ratio Integer) where
+instance ConvertAttempt [Char] Rational where
convertAttempt = fmap realToFrac . (SF.read :: String -> Attempt Double)
#if TEST
-instance Arbitrary (Ratio Integer) where
+instance Arbitrary Rational where
coarbitrary = undefined
arbitrary = do
n <- arbitrary
@@ -175,13 +198,13 @@ instance ConvertAttempt ST.Text Int where
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
@@ -207,13 +230,13 @@ instance ConvertSuccess Int ST.Text where
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
View
25 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,6 +28,29 @@ import qualified Data.Text.Lazy as LT
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
View
10 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
@@ -41,6 +42,15 @@ import Data.Typeable
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
----------------------------------------------------------------------
View
11 convertible-text.cabal
@@ -1,5 +1,5 @@
Name: convertible-text
-Version: 0.0.1
+Version: 0.2.0
License: LGPL
Maintainer: Michael Snoyman <michael@snoyman.com>
Author: John Goerzen, Michael Snoyman
@@ -26,11 +26,15 @@ 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(buildtests)
+ if flag(nolib)
Buildable: False
else
Buildable: True
@@ -40,7 +44,8 @@ library
text >= 0.5 && < 0.6,
bytestring >= 0.9.1.4 && < 0.10,
safe-failure >= 0.4 && < 0.5,
- attempt >= 0.2.1 && < 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
Please sign in to comment.
Something went wrong with that request. Please try again.