From 36135290c70321dab13c04163977c21d5278c63a Mon Sep 17 00:00:00 2001
From: Sam Truzjan <pxqr.sta@gmail.com>
Date: Sat, 28 Sep 2013 02:34:32 +0400
Subject: Guarantee zero overhead for native types

---
 src/Data/BEncode.hs | 92 ++++++++++++++++++++++++++++++++---------------------
 1 file changed, 55 insertions(+), 37 deletions(-)

(limited to 'src')

diff --git a/src/Data/BEncode.hs b/src/Data/BEncode.hs
index 1601fd1..267d4b2 100644
--- a/src/Data/BEncode.hs
+++ b/src/Data/BEncode.hs
@@ -339,55 +339,72 @@ instance GBEncodable f e
 #endif
 
 {--------------------------------------------------------------------
-  Basic instances
+--  Native instances
 --------------------------------------------------------------------}
 
 instance BEncodable BEncode where
-  {-# SPECIALIZE instance BEncodable BEncode #-}
   toBEncode = id
   {-# INLINE toBEncode #-}
 
-  fromBEncode = Right
+  fromBEncode = pure
   {-# INLINE fromBEncode #-}
 
-instance BEncodable Int where
-  {-# SPECIALIZE instance BEncodable Int #-}
-  toBEncode = BInteger . fromIntegral
+instance BEncodable BInteger where
+  toBEncode = BInteger
   {-# INLINE toBEncode #-}
 
-  fromBEncode (BInteger i) = Right (fromIntegral i)
-  fromBEncode _            = decodingError "integer"
+  fromBEncode (BInteger i) = pure i
+  fromBEncode _            = decodingError "BInteger"
   {-# INLINE fromBEncode #-}
 
-instance BEncodable Bool where
-  toBEncode = toBEncode . fromEnum
+instance BEncodable BString where
+  toBEncode = BString
   {-# INLINE toBEncode #-}
 
-  fromBEncode b = do
-    i <- fromBEncode b
-    case i :: Int of
-      0 -> return False
-      1 -> return True
-      _ -> decodingError "bool"
+  fromBEncode (BString s) = pure s
+  fromBEncode _           = decodingError "BString"
   {-# INLINE fromBEncode #-}
 
+instance BEncodable BList where
+  toBEncode = BList
+  {-# INLINE toBEncode #-}
 
-instance BEncodable Integer where
-  toBEncode = BInteger . fromIntegral
+  fromBEncode (BList xs) = pure xs
+  fromBEncode _          = decodingError "BList"
+  {-# INLINE fromBEncode #-}
+
+instance BEncodable BDict where
+  toBEncode = BDict
   {-# INLINE toBEncode #-}
 
-  fromBEncode b = fromIntegral <$> (fromBEncode b :: Result Int)
+  fromBEncode (BDict d) = pure d
+  fromBEncode _         = decodingError "BDict"
   {-# INLINE fromBEncode #-}
 
+{--------------------------------------------------------------------
+--  Derived instances
+--------------------------------------------------------------------}
 
-instance BEncodable ByteString where
-  toBEncode = BString
+instance BEncodable Int where
+  {-# SPECIALIZE instance BEncodable Int #-}
+  toBEncode = BInteger . fromIntegral
   {-# INLINE toBEncode #-}
 
-  fromBEncode (BString s) = Right s
-  fromBEncode _           = decodingError "string"
+  fromBEncode (BInteger i) = Right (fromIntegral i)
+  fromBEncode _            = decodingError "Int"
   {-# INLINE fromBEncode #-}
 
+instance BEncodable Bool where
+  toBEncode = toBEncode . fromEnum
+  {-# INLINE toBEncode #-}
+
+  fromBEncode b = do
+    i <- fromBEncode b
+    case i :: Int of
+      0 -> return False
+      1 -> return True
+      _ -> decodingError "Bool"
+  {-# INLINE fromBEncode #-}
 
 instance BEncodable Text where
   toBEncode = toBEncode . T.encodeUtf8
@@ -398,7 +415,6 @@ instance BEncodable Text where
 
 instance BEncodable a => BEncodable [a] where
   {-# SPECIALIZE instance BEncodable [BEncode] #-}
-
   toBEncode = BList . map toBEncode
   {-# INLINE toBEncode #-}
 
@@ -406,10 +422,8 @@ instance BEncodable a => BEncodable [a] where
   fromBEncode _          = decodingError "list"
   {-# INLINE fromBEncode #-}
 
-
 instance BEncodable a => BEncodable (Map ByteString a) where
   {-# SPECIALIZE instance BEncodable (Map ByteString BEncode) #-}
-
   toBEncode = BDict . M.map toBEncode
   {-# INLINE toBEncode #-}
 
@@ -426,6 +440,21 @@ instance (Eq a, BEncodable a) => BEncodable (Set a) where
   fromBEncode _          = decodingError "Data.Set"
   {-# INLINE fromBEncode #-}
 
+instance BEncodable Version where
+  {-# SPECIALIZE instance BEncodable Version #-}
+  {-# INLINE toBEncode #-}
+  toBEncode = toBEncode . BC.pack . showVersion
+
+  fromBEncode (BString bs)
+    | [(v, _)] <- ReadP.readP_to_S parseVersion (BC.unpack bs)
+    = return v
+  fromBEncode _ = decodingError "Data.Version"
+  {-# INLINE fromBEncode #-}
+
+{--------------------------------------------------------------------
+--  Tuple instances
+--------------------------------------------------------------------}
+
 instance BEncodable () where
   {-# SPECIALIZE instance BEncodable () #-}
   toBEncode () = BList []
@@ -488,17 +517,6 @@ instance (BEncodable a, BEncodable b, BEncodable c, BEncodable d, BEncodable e)
   fromBEncode _ = decodingError "Unable to decode a tuple5"
   {-# INLINE fromBEncode #-}
 
-instance BEncodable Version where
-  {-# SPECIALIZE instance BEncodable Version #-}
-  {-# INLINE toBEncode #-}
-  toBEncode = toBEncode . BC.pack . showVersion
-
-  fromBEncode (BString bs)
-    | [(v, _)] <- ReadP.readP_to_S parseVersion (BC.unpack bs)
-    = return v
-  fromBEncode _ = decodingError "Data.Version"
-  {-# INLINE fromBEncode #-}
-
 {--------------------------------------------------------------------
   Building dictionaries
 --------------------------------------------------------------------}
-- 
cgit v1.2.3