{-# LANGUAGE Safe              #-}
module Data.Connection.Ordering (
    ordbin
  , binord
) where

import safe Data.Connection.Type
import safe Data.Lattice
import safe Data.Order
import safe GHC.Real (Ratio)
import safe Prelude hiding (Ord(..), Bounded, until)

ordbin :: Conn Ordering Bool
ordbin = Conn f g where
  f GT = True
  f _  = False

  g True = GT
  g _    = EQ

binord :: Conn Bool Ordering
binord = Conn f g where
  f False = LT
  f _     = EQ

  g LT = False
  g _  = True

{-
ratord :: Conn (Ratio Integer) (Lowered Ordering)
ratord = fldord

ordrat :: Conn (Lifted Ordering) (Ratio Integer)
ordrat = ordfld 

f32ord :: Conn Float (Lowered Ordering)
f32ord = fldord

ordf32 :: Conn (Lifted Ordering) Float
ordf32 = ordfld

f64ord :: Conn Double (Lowered Ordering)
f64ord = fldord

ordf64 :: Conn (Lifted Ordering) Double
ordf64 = ordfld

fldord :: (Bounded a, Fractional a) => Conn a (Lowered Ordering)
fldord = Conn (Left . f) (lowered g) where
  g GT = top
  g EQ = 0
  g LT = bottom
  
  f x | x ~~ bottom = LT
      | x <~ 0      = EQ
      | otherwise   = GT

ordfld :: (Bounded a, Fractional a) => Conn (Lifted Ordering) a
ordfld = Conn (lifted g) (Right . h) where
  g GT = top
  g EQ = 0
  g LT = bottom

  h x | x ~~ top  = GT
      | x >~ 0    = EQ
      | otherwise = LT
-}