Skip to content

Commit

Permalink
Merge pull request #1 from phonohawk/type-based-derivation
Browse files Browse the repository at this point in the history
deriveAttempts should take pairs of Q Type rather than Name.
  • Loading branch information
snoyberg committed Dec 5, 2011
2 parents c645740 + 09c9a4a commit 122928f
Show file tree
Hide file tree
Showing 6 changed files with 159 additions and 161 deletions.
22 changes: 10 additions & 12 deletions Data/Convertible/Base.hs
Expand Up @@ -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' |]) []
]
]
]
102 changes: 51 additions & 51 deletions Data/Convertible/Instances/C.hs
Expand Up @@ -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
Expand Down
104 changes: 52 additions & 52 deletions Data/Convertible/Instances/Num.hs
Expand Up @@ -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
Expand Down
40 changes: 20 additions & 20 deletions Data/Convertible/Instances/String.hs
Expand Up @@ -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
Expand Down
40 changes: 20 additions & 20 deletions Data/Convertible/Instances/Text.hs
Expand Up @@ -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
Expand Down
12 changes: 6 additions & 6 deletions Data/Convertible/Instances/Time.hs
Expand Up @@ -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 |])
])

----------------------------------------------------------------------
Expand Down

0 comments on commit 122928f

Please sign in to comment.