[commit: packages/binary] master: Add Binary (Data.Fixed a) instance (0b40acc)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/binary

On branch  : master
Link       : http://git.haskell.org/packages/binary.git/commitdiff/0b40accf9ddf27b5dfbb27cfc621abd789641d3e

>---------------------------------------------------------------

commit 0b40accf9ddf27b5dfbb27cfc621abd789641d3e
Author: Oleg Grenrus <oleg.grenrus at iki.fi>
Date:   Tue Aug 25 23:08:25 2015 +0300

    Add Binary (Data.Fixed a) instance


>---------------------------------------------------------------

0b40accf9ddf27b5dfbb27cfc621abd789641d3e
 src/Data/Binary/Class.hs | 23 +++++++++++++++++++++++
 tests/QC.hs              |  3 +++
 2 files changed, 26 insertions(+)

diff --git a/src/Data/Binary/Class.hs b/src/Data/Binary/Class.hs
index a022a42..28445c9 100644
--- a/src/Data/Binary/Class.hs
+++ b/src/Data/Binary/Class.hs
@@ -11,10 +11,18 @@
 #define HAS_VOID
 #endif
 
+#if MIN_VERSION_base(4,7,0)
+#define HAS_FIXED_CONSTRUCTOR
+#endif
+
 #if __GLASGOW_HASKELL__ >= 704
 #define HAS_GHC_FINGERPRINT
 #endif
 
+#ifndef HAS_FIXED_CONSTRUCTOR
+{-# LANGUAGE ScopedTypeVariables #-}
+#endif
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      : Data.Binary.Class
@@ -78,6 +86,9 @@ import GHC.Generics
 #ifdef HAS_NATURAL
 import Numeric.Natural
 #endif
+
+import qualified Data.Fixed as Fixed
+
 --
 -- This isn't available in older Hugs or older GHC
 --
@@ -251,6 +262,18 @@ instance Binary Integer where
                     let v = roll bytes
                     return $! if sign == (1 :: Word8) then v else - v
 
+-- | /Since: 0.8.0.0/
+#ifdef HAS_FIXED_CONSTRUCTOR
+instance Binary (Fixed.Fixed a) where
+  put (Fixed.MkFixed a) = put a
+  get = Fixed.MkFixed `liftM` get
+#else
+instance forall a. Fixed.HasResolution a => Binary (Fixed.Fixed a) where
+  -- Using undefined :: Maybe a as a proxy, as Data.Proxy is introduced only in base-4.7
+  put x = put (truncate (x * fromInteger (Fixed.resolution (undefined :: Maybe a))) :: Integer)
+  get = (\x -> fromInteger x / fromInteger (Fixed.resolution (undefined :: Maybe a))) `liftM` get
+#endif
+
 --
 -- Fold and unfold an Integer to and from a list of its bytes
 --
diff --git a/tests/QC.hs b/tests/QC.hs
index 493d2aa..99f919c 100644
--- a/tests/QC.hs
+++ b/tests/QC.hs
@@ -28,6 +28,8 @@ import           Numeric.Natural
 import           GHC.Fingerprint
 #endif
 
+import qualified Data.Fixed as Fixed
+
 import           Test.Framework
 import           Test.Framework.Providers.QuickCheck2
 import           Test.QuickCheck
@@ -475,6 +477,7 @@ tests =
             , ("Word",       p (test :: T Word                   ))
             , ("Int",        p (test :: T Int                    ))
             , ("Integer",    p (test :: T Integer                ))
+            , ("Fixed",      p (test :: T (Fixed.Fixed Fixed.E3) ))
 #ifdef HAS_NATURAL
             , ("Natural",         prop_test_Natural               )
 #endif