content: -- | Discrimination of floating-point numbers via their IEEE754 representation.
  --
  -- This technique is described by http://stereopsis.com/radix.html.
  --
  -- This orders floating-point numbers according to the IEEE754 floating-point
  -- total order.  -NaN < -Infinity < ... < -0 < 0 < ... < +Infinity < +NaN.
  -- NaNs with positive sign are ordered by the value of their payload, and NaNs
  -- with negative sign are reverse-ordered by the value of their payload.
  
  module Data.Discrimination.IEEE754
    (
    -- * Groups
    -- $groups
      groupingFloat, groupingDouble
    -- * Sorts
    -- $sorts
    , sortingFloat, sortingDouble
    ) where
  
  import Data.Binary.IEEE754 (floatToWord, doubleToWord)
  import Data.Bits (xor, setBit, shift)
  import Data.Discrimination (Grouping(..), Group, Sorting(..), Sort)
  import Data.Functor.Contravariant (Contravariant(contramap))
  import Data.Word (Word32, Word64)
  
  sortableFloat32 :: Float -> Word32
  sortableFloat32 x = w `xor` mask
    where
      w = floatToWord x
      mask = setBit (negate (shift w (-31))) 31
  
  sortableFloat64 :: Double -> Word64
  sortableFloat64 x = w `xor` mask
    where
      w = doubleToWord x
      mask = setBit (negate (shift w (-63))) 63
  
  discFloat :: Contravariant f => f Word32 -> f Float
  discFloat = contramap sortableFloat32
  
  discDouble :: Contravariant f => f Word64 -> f Double
  discDouble = contramap sortableFloat64
  
  -- $groups
  -- Group values according to the IEEE754 total order.
  --
  -- This means that values will be in the same group if and only if they compare
  -- equal under the IEEE754 total order.  In particular, bit-wise-identical NaNs
  -- will be grouped together.
  
  groupingFloat :: Group Float
  groupingFloat = discFloat grouping
  
  groupingDouble :: Group Double
  groupingDouble = discDouble grouping
  
  -- $sorts
  -- Sort values according to the IEEE754 total order.
  --
  -- This matches the 'Ord' instance for non-NaN values, but orders NaNs
  -- according to their sign bit and mantissa (negated if the sign bit is set).
  -- Positive NaNs are greater than +Infinity, and negative NaNs are less than
  -- -Infinity.
  
  sortingFloat :: Sort Float
  sortingFloat = discFloat sorting
  
  sortingDouble :: Sort Double
  sortingDouble = discDouble sorting
  