{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Data.Connection.Ratio (
    Ratio (..),
    reduce,
    shiftd,

    -- * Rational
    ratf32,
    ratf64,
    rati08,
    rati16,
    rati32,
    rati64,
    ratixx,
    ratint,

    -- * Positive
    posw08,
    posw16,
    posw32,
    posw64,
    poswxx,
    posnat,
) where

import safe Data.Connection.Conn
import safe qualified Data.Connection.Float as Float
import safe Data.Int
import safe Data.Order
import safe Data.Order.Extended
import safe Data.Order.Syntax
import safe Data.Ratio
import safe Data.Word
import safe GHC.Real (Ratio (..), Rational)
import safe Numeric.Natural
import safe Prelude hiding (Ord (..), until)
import safe qualified Prelude as P

-- | A total version of 'GHC.Real.reduce'.
reduce :: Integral a => Ratio a -> Ratio a
reduce :: Ratio a -> Ratio a
reduce (a
x :% a
0) = a
x a -> a -> Ratio a
forall a. a -> a -> Ratio a
:% a
0
reduce (a
x :% a
y) = (a
x a -> a -> a
forall a. Integral a => a -> a -> a
`quot` a
d) a -> a -> Ratio a
forall a. a -> a -> Ratio a
:% (a
y a -> a -> a
forall a. Integral a => a -> a -> a
`quot` a
d) where d :: a
d = a -> a -> a
forall a. Integral a => a -> a -> a
gcd a
x a
y

-- | Shift by n 'units of least precision' where the ULP is determined by the denominator
--
-- This is an analog of 'Data.Connection.Float.shift32' for rationals.
shiftd :: Num a => a -> Ratio a -> Ratio a
shiftd :: a -> Ratio a -> Ratio a
shiftd a
n (a
x :% a
y) = (a
n a -> a -> a
forall a. Num a => a -> a -> a
+ a
x) a -> a -> Ratio a
forall a. a -> a -> Ratio a
:% a
y

---------------------------------------------------------------------
-- Ratio Integer
---------------------------------------------------------------------

rati08 :: Conn k Rational (Extended Int8)
rati08 :: Conn k Rational (Extended Int8)
rati08 = Conn k Rational (Extended Int8)
forall a (k :: Kan).
(Bounded a, Integral a) =>
Conn k Rational (Extended a)
signedTriple

rati16 :: Conn k Rational (Extended Int16)
rati16 :: Conn k Rational (Extended Int16)
rati16 = Conn k Rational (Extended Int16)
forall a (k :: Kan).
(Bounded a, Integral a) =>
Conn k Rational (Extended a)
signedTriple

rati32 :: Conn k Rational (Extended Int32)
rati32 :: Conn k Rational (Extended Int32)
rati32 = Conn k Rational (Extended Int32)
forall a (k :: Kan).
(Bounded a, Integral a) =>
Conn k Rational (Extended a)
signedTriple

rati64 :: Conn k Rational (Extended Int64)
rati64 :: Conn k Rational (Extended Int64)
rati64 = Conn k Rational (Extended Int64)
forall a (k :: Kan).
(Bounded a, Integral a) =>
Conn k Rational (Extended a)
signedTriple

ratixx :: Conn k Rational (Extended Int)
ratixx :: Conn k Rational (Extended Int)
ratixx = Conn k Rational (Extended Int)
forall a (k :: Kan).
(Bounded a, Integral a) =>
Conn k Rational (Extended a)
signedTriple

ratint :: Conn k Rational (Extended Integer)
ratint :: Conn k Rational (Extended Integer)
ratint = (Rational -> Extended Integer)
-> (Extended Integer -> Rational)
-> (Rational -> Extended Integer)
-> Conn k Rational (Extended Integer)
forall a b (k :: Kan).
(a -> b) -> (b -> a) -> (a -> b) -> Conn k a b
Conn Rational -> Extended Integer
f Extended Integer -> Rational
g Rational -> Extended Integer
h
  where
    f :: Rational -> Extended Integer
f = (Rational -> Bool)
-> (Rational -> Bool)
-> (Rational -> Integer)
-> Rational
-> Extended Integer
forall a b.
(a -> Bool) -> (a -> Bool) -> (a -> b) -> a -> Extended b
liftExtended (Rational -> Rational -> Bool
forall a. Preorder a => a -> a -> Bool
~~ Rational
forall a. Num a => Ratio a
ninf) (\Rational
x -> Rational
x Rational -> Rational -> Bool
forall a. Preorder a => a -> a -> Bool
~~ Rational
forall a. Num a => Ratio a
nan Bool -> Bool -> Bool
|| Rational
x Rational -> Rational -> Bool
forall a. Preorder a => a -> a -> Bool
~~ Rational
forall a. Num a => Ratio a
pinf) Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
P.ceiling

    g :: Extended Integer -> Rational
g = Rational
-> Rational
-> (Integer -> Rational)
-> Extended Integer
-> Rational
forall b a. b -> b -> (a -> b) -> Extended a -> b
extended Rational
forall a. Num a => Ratio a
ninf Rational
forall a. Num a => Ratio a
pinf Integer -> Rational
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral

    h :: Rational -> Extended Integer
h = (Rational -> Bool)
-> (Rational -> Bool)
-> (Rational -> Integer)
-> Rational
-> Extended Integer
forall a b.
(a -> Bool) -> (a -> Bool) -> (a -> b) -> a -> Extended b
liftExtended (\Rational
x -> Rational
x Rational -> Rational -> Bool
forall a. Preorder a => a -> a -> Bool
~~ Rational
forall a. Num a => Ratio a
nan Bool -> Bool -> Bool
|| Rational
x Rational -> Rational -> Bool
forall a. Preorder a => a -> a -> Bool
~~ Rational
forall a. Num a => Ratio a
ninf) (Rational -> Rational -> Bool
forall a. Preorder a => a -> a -> Bool
~~ Rational
forall a. Num a => Ratio a
pinf) Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
P.floor

ratf32 :: Conn k Rational Float
ratf32 :: Conn k Rational Float
ratf32 = (Rational -> Float)
-> (Float -> Rational)
-> (Rational -> Float)
-> Conn k Rational Float
forall a b (k :: Kan).
(a -> b) -> (b -> a) -> (a -> b) -> Conn k a b
Conn ((Rational -> Float) -> Rational -> Float
forall a. Fractional a => (Rational -> a) -> Rational -> a
toFloating Rational -> Float
f) ((Float -> Rational) -> Float -> Rational
forall a.
(Order a, Fractional a) =>
(a -> Rational) -> a -> Rational
fromFloating Float -> Rational
g) ((Rational -> Float) -> Rational -> Float
forall a. Fractional a => (Rational -> a) -> Rational -> a
toFloating Rational -> Float
h)
  where
    f :: Rational -> Float
f Rational
x =
        let est :: Float
est = Rational -> Float
forall a. Fractional a => Rational -> a
P.fromRational Rational
x
         in if (Float -> Rational) -> Float -> Rational
forall a.
(Order a, Fractional a) =>
(a -> Rational) -> a -> Rational
fromFloating Float -> Rational
g Float
est Rational -> Rational -> Bool
forall a. Preorder a => a -> a -> Bool
>~ Rational
x
                then Float
est
                else Float -> (Float -> Rational) -> Rational -> Float
forall a. Preorder a => Float -> (Float -> a) -> a -> Float
ascendf Float
est ((Float -> Rational) -> Float -> Rational
forall a.
(Order a, Fractional a) =>
(a -> Rational) -> a -> Rational
fromFloating Float -> Rational
g) Rational
x

    g :: Float -> Rational
g = (Float -> Float -> Rational) -> Float -> Float -> Rational
forall a b c. (a -> b -> c) -> b -> a -> c
flip Float -> Float -> Rational
forall a. RealFrac a => a -> a -> Rational
approxRational Float
0

    h :: Rational -> Float
h Rational
x =
        let est :: Float
est = Rational -> Float
forall a. Fractional a => Rational -> a
P.fromRational Rational
x
         in if (Float -> Rational) -> Float -> Rational
forall a.
(Order a, Fractional a) =>
(a -> Rational) -> a -> Rational
fromFloating Float -> Rational
g Float
est Rational -> Rational -> Bool
forall a. Preorder a => a -> a -> Bool
<~ Rational
x
                then Float
est
                else Float -> (Float -> Rational) -> Rational -> Float
forall a. Preorder a => Float -> (Float -> a) -> a -> Float
descendf Float
est ((Float -> Rational) -> Float -> Rational
forall a.
(Order a, Fractional a) =>
(a -> Rational) -> a -> Rational
fromFloating Float -> Rational
g) Rational
x

    ascendf :: Float -> (Float -> a) -> a -> Float
ascendf Float
z Float -> a
g1 a
y = (Float -> Bool)
-> (Float -> Float -> Bool) -> (Float -> Float) -> Float -> Float
forall a. (a -> Bool) -> (a -> a -> Bool) -> (a -> a) -> a -> a
Float.until (\Float
x -> Float -> a
g1 Float
x a -> a -> Bool
forall a. Preorder a => a -> a -> Bool
>~ a
y) Float -> Float -> Bool
forall a. Preorder a => a -> a -> Bool
(<~) (Int32 -> Float -> Float
Float.shift32 Int32
1) Float
z

    descendf :: Float -> (Float -> a) -> a -> Float
descendf Float
z Float -> a
f1 a
x = (Float -> Bool)
-> (Float -> Float -> Bool) -> (Float -> Float) -> Float -> Float
forall a. (a -> Bool) -> (a -> a -> Bool) -> (a -> a) -> a -> a
Float.until (\Float
y -> Float -> a
f1 Float
y a -> a -> Bool
forall a. Preorder a => a -> a -> Bool
<~ a
x) Float -> Float -> Bool
forall a. Preorder a => a -> a -> Bool
(>~) (Int32 -> Float -> Float
Float.shift32 (-Int32
1)) Float
z

ratf64 :: Conn k Rational Double
ratf64 :: Conn k Rational Double
ratf64 = (Rational -> Double)
-> (Double -> Rational)
-> (Rational -> Double)
-> Conn k Rational Double
forall a b (k :: Kan).
(a -> b) -> (b -> a) -> (a -> b) -> Conn k a b
Conn ((Rational -> Double) -> Rational -> Double
forall a. Fractional a => (Rational -> a) -> Rational -> a
toFloating Rational -> Double
f) ((Double -> Rational) -> Double -> Rational
forall a.
(Order a, Fractional a) =>
(a -> Rational) -> a -> Rational
fromFloating Double -> Rational
g) ((Rational -> Double) -> Rational -> Double
forall a. Fractional a => (Rational -> a) -> Rational -> a
toFloating Rational -> Double
h)
  where
    f :: Rational -> Double
f Rational
x =
        let est :: Double
est = Rational -> Double
forall a. Fractional a => Rational -> a
P.fromRational Rational
x
         in if (Double -> Rational) -> Double -> Rational
forall a.
(Order a, Fractional a) =>
(a -> Rational) -> a -> Rational
fromFloating Double -> Rational
g Double
est Rational -> Rational -> Bool
forall a. Preorder a => a -> a -> Bool
>~ Rational
x
                then Double
est
                else Double -> (Double -> Rational) -> Rational -> Double
forall a. Preorder a => Double -> (Double -> a) -> a -> Double
ascendf Double
est ((Double -> Rational) -> Double -> Rational
forall a.
(Order a, Fractional a) =>
(a -> Rational) -> a -> Rational
fromFloating Double -> Rational
g) Rational
x

    g :: Double -> Rational
g = (Double -> Double -> Rational) -> Double -> Double -> Rational
forall a b c. (a -> b -> c) -> b -> a -> c
flip Double -> Double -> Rational
forall a. RealFrac a => a -> a -> Rational
approxRational Double
0

    h :: Rational -> Double
h Rational
x =
        let est :: Double
est = Rational -> Double
forall a. Fractional a => Rational -> a
P.fromRational Rational
x
         in if (Double -> Rational) -> Double -> Rational
forall a.
(Order a, Fractional a) =>
(a -> Rational) -> a -> Rational
fromFloating Double -> Rational
g Double
est Rational -> Rational -> Bool
forall a. Preorder a => a -> a -> Bool
<~ Rational
x
                then Double
est
                else Double -> (Double -> Rational) -> Rational -> Double
forall a. Preorder a => Double -> (Double -> a) -> a -> Double
descendf Double
est ((Double -> Rational) -> Double -> Rational
forall a.
(Order a, Fractional a) =>
(a -> Rational) -> a -> Rational
fromFloating Double -> Rational
g) Rational
x

    ascendf :: Double -> (Double -> a) -> a -> Double
ascendf Double
z Double -> a
g1 a
y = (Double -> Bool)
-> (Double -> Double -> Bool)
-> (Double -> Double)
-> Double
-> Double
forall a. (a -> Bool) -> (a -> a -> Bool) -> (a -> a) -> a -> a
Float.until (\Double
x -> Double -> a
g1 Double
x a -> a -> Bool
forall a. Preorder a => a -> a -> Bool
>~ a
y) Double -> Double -> Bool
forall a. Preorder a => a -> a -> Bool
(<~) (Int64 -> Double -> Double
Float.shift64 Int64
1) Double
z

    descendf :: Double -> (Double -> a) -> a -> Double
descendf Double
z Double -> a
f1 a
x = (Double -> Bool)
-> (Double -> Double -> Bool)
-> (Double -> Double)
-> Double
-> Double
forall a. (a -> Bool) -> (a -> a -> Bool) -> (a -> a) -> a -> a
Float.until (\Double
y -> Double -> a
f1 Double
y a -> a -> Bool
forall a. Preorder a => a -> a -> Bool
<~ a
x) Double -> Double -> Bool
forall a. Preorder a => a -> a -> Bool
(>~) (Int64 -> Double -> Double
Float.shift64 (-Int64
1)) Double
z

---------------------------------------------------------------------
-- Ratio Natural
---------------------------------------------------------------------

posw08 :: Conn k Positive (Lowered Word8)
posw08 :: Conn k Positive (Lowered Word8)
posw08 = Conn k Positive (Lowered Word8)
forall a (k :: Kan).
(Bounded a, Integral a) =>
Conn k Positive (Lowered a)
unsignedTriple

posw16 :: Conn k Positive (Lowered Word16)
posw16 :: Conn k Positive (Lowered Word16)
posw16 = Conn k Positive (Lowered Word16)
forall a (k :: Kan).
(Bounded a, Integral a) =>
Conn k Positive (Lowered a)
unsignedTriple

posw32 :: Conn k Positive (Lowered Word32)
posw32 :: Conn k Positive (Lowered Word32)
posw32 = Conn k Positive (Lowered Word32)
forall a (k :: Kan).
(Bounded a, Integral a) =>
Conn k Positive (Lowered a)
unsignedTriple

posw64 :: Conn k Positive (Lowered Word64)
posw64 :: Conn k Positive (Lowered Word64)
posw64 = Conn k Positive (Lowered Word64)
forall a (k :: Kan).
(Bounded a, Integral a) =>
Conn k Positive (Lowered a)
unsignedTriple

poswxx :: Conn k Positive (Lowered Word)
poswxx :: Conn k Positive (Lowered Word)
poswxx = Conn k Positive (Lowered Word)
forall a (k :: Kan).
(Bounded a, Integral a) =>
Conn k Positive (Lowered a)
unsignedTriple

posnat :: Conn k Positive (Lowered Natural)
posnat :: Conn k Positive (Lowered Natural)
posnat = (Positive -> Lowered Natural)
-> (Lowered Natural -> Positive)
-> (Positive -> Lowered Natural)
-> Conn k Positive (Lowered Natural)
forall a b (k :: Kan).
(a -> b) -> (b -> a) -> (a -> b) -> Conn k a b
Conn Positive -> Lowered Natural
f Lowered Natural -> Positive
forall b. Either Natural b -> Positive
g Positive -> Lowered Natural
h
  where
    f :: Positive -> Lowered Natural
f = (Positive -> Bool)
-> (Positive -> Natural) -> Positive -> Lowered Natural
forall a b. (a -> Bool) -> (a -> b) -> a -> Lowered b
liftEitherR (\Positive
x -> Positive
x Positive -> Positive -> Bool
forall a. Preorder a => a -> a -> Bool
~~ Positive
forall a. Num a => Ratio a
nan Bool -> Bool -> Bool
|| Positive
x Positive -> Positive -> Bool
forall a. Preorder a => a -> a -> Bool
~~ Positive
forall a. Num a => Ratio a
pinf) Positive -> Natural
forall a b. (RealFrac a, Integral b) => a -> b
P.ceiling

    g :: Either Natural b -> Positive
g = (Natural -> Positive)
-> (b -> Positive) -> Either Natural b -> Positive
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Natural -> Positive
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Positive -> b -> Positive
forall a b. a -> b -> a
const Positive
forall a. Num a => Ratio a
pinf)

    h :: Positive -> Lowered Natural
h = (Positive -> Bool)
-> (Positive -> Natural) -> Positive -> Lowered Natural
forall a b. (a -> Bool) -> (a -> b) -> a -> Lowered b
liftEitherR (Positive -> Positive -> Bool
forall a. Preorder a => a -> a -> Bool
~~ Positive
forall a. Num a => Ratio a
pinf) ((Positive -> Natural) -> Positive -> Lowered Natural)
-> (Positive -> Natural) -> Positive -> Lowered Natural
forall a b. (a -> b) -> a -> b
$ \Positive
x -> if Positive
x Positive -> Positive -> Bool
forall a. Preorder a => a -> a -> Bool
~~ Positive
forall a. Num a => Ratio a
nan then Natural
0 else Positive -> Natural
forall a b. (RealFrac a, Integral b) => a -> b
P.floor Positive
x

---------------------------------------------------------------------
-- Internal
---------------------------------------------------------------------

pinf :: Num a => Ratio a
pinf :: Ratio a
pinf = a
1 a -> a -> Ratio a
forall a. a -> a -> Ratio a
:% a
0

ninf :: Num a => Ratio a
ninf :: Ratio a
ninf = (-a
1) a -> a -> Ratio a
forall a. a -> a -> Ratio a
:% a
0

nan :: Num a => Ratio a
nan :: Ratio a
nan = a
0 a -> a -> Ratio a
forall a. a -> a -> Ratio a
:% a
0

unsignedTriple :: forall a k. (Bounded a, Integral a) => Conn k Positive (Lowered a)
unsignedTriple :: Conn k Positive (Lowered a)
unsignedTriple = (Positive -> Lowered a)
-> (Lowered a -> Positive)
-> (Positive -> Lowered a)
-> Conn k Positive (Lowered a)
forall a b (k :: Kan).
(a -> b) -> (b -> a) -> (a -> b) -> Conn k a b
Conn Positive -> Lowered a
forall b a. (Bounded b, Integral a) => Positive -> Either a b
f Lowered a -> Positive
forall b. Either a b -> Positive
g Positive -> Lowered a
forall a b.
(Bounded a, Bounded b, Integral a) =>
Positive -> Either a b
h
  where
    f :: Positive -> Either a b
f Positive
x
        | Positive
x Positive -> Positive -> Bool
forall a. Preorder a => a -> a -> Bool
~~ Positive
forall a. Num a => Ratio a
nan = b -> Either a b
forall a b. b -> Either a b
Right b
forall a. Bounded a => a
maxBound
        | Positive
x Positive -> Positive -> Bool
forall a. Preorder a => a -> a -> Bool
> Positive
high = b -> Either a b
forall a b. b -> Either a b
Right b
forall a. Bounded a => a
maxBound
        | Bool
otherwise = a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> a -> Either a b
forall a b. (a -> b) -> a -> b
$ Positive -> a
forall a b. (RealFrac a, Integral b) => a -> b
P.ceiling Positive
x

    g :: Either a b -> Positive
g = (a -> Positive) -> (b -> Positive) -> Either a b -> Positive
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> Positive
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Positive -> b -> Positive
forall a b. a -> b -> a
const Positive
forall a. Num a => Ratio a
pinf)

    h :: Positive -> Either a b
h Positive
x
        | Positive
x Positive -> Positive -> Bool
forall a. Preorder a => a -> a -> Bool
~~ Positive
forall a. Num a => Ratio a
nan = a -> Either a b
forall a b. a -> Either a b
Left a
forall a. Bounded a => a
minBound
        | Positive
x Positive -> Positive -> Bool
forall a. Preorder a => a -> a -> Bool
~~ Positive
forall a. Num a => Ratio a
pinf = b -> Either a b
forall a b. b -> Either a b
Right b
forall a. Bounded a => a
maxBound
        | Positive
x Positive -> Positive -> Bool
forall a. Preorder a => a -> a -> Bool
> Positive
high = a -> Either a b
forall a b. a -> Either a b
Left a
forall a. Bounded a => a
maxBound
        | Bool
otherwise = a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> a -> Either a b
forall a b. (a -> b) -> a -> b
$ Positive -> a
forall a b. (RealFrac a, Integral b) => a -> b
P.floor Positive
x

    high :: Positive
high = a -> Positive
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral @a a
forall a. Bounded a => a
maxBound

signedTriple :: forall a k. (Bounded a, Integral a) => Conn k Rational (Extended a)
signedTriple :: Conn k Rational (Extended a)
signedTriple = (Rational -> Extended a)
-> (Extended a -> Rational)
-> (Rational -> Extended a)
-> Conn k Rational (Extended a)
forall a b (k :: Kan).
(a -> b) -> (b -> a) -> (a -> b) -> Conn k a b
Conn Rational -> Extended a
f Extended a -> Rational
g Rational -> Extended a
h
  where
    f :: Rational -> Extended a
f = (Rational -> Bool)
-> (Rational -> Bool) -> (Rational -> a) -> Rational -> Extended a
forall a b.
(a -> Bool) -> (a -> Bool) -> (a -> b) -> a -> Extended b
liftExtended (Rational -> Rational -> Bool
forall a. Preorder a => a -> a -> Bool
~~ Rational
forall a. Num a => Ratio a
ninf) (\Rational
x -> Rational
x Rational -> Rational -> Bool
forall a. Preorder a => a -> a -> Bool
~~ Rational
forall a. Num a => Ratio a
nan Bool -> Bool -> Bool
|| Rational
x Rational -> Rational -> Bool
forall a. Preorder a => a -> a -> Bool
> Rational
high) ((Rational -> a) -> Rational -> Extended a)
-> (Rational -> a) -> Rational -> Extended a
forall a b. (a -> b) -> a -> b
$ \Rational
x -> if Rational
x Rational -> Rational -> Bool
forall a. Preorder a => a -> a -> Bool
< Rational
low then a
forall a. Bounded a => a
minBound else Rational -> a
forall a b. (RealFrac a, Integral b) => a -> b
P.ceiling Rational
x

    g :: Extended a -> Rational
g = Rational -> Rational -> (a -> Rational) -> Extended a -> Rational
forall b a. b -> b -> (a -> b) -> Extended a -> b
extended Rational
forall a. Num a => Ratio a
ninf Rational
forall a. Num a => Ratio a
pinf a -> Rational
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral

    h :: Rational -> Extended a
h = (Rational -> Bool)
-> (Rational -> Bool) -> (Rational -> a) -> Rational -> Extended a
forall a b.
(a -> Bool) -> (a -> Bool) -> (a -> b) -> a -> Extended b
liftExtended (\Rational
x -> Rational
x Rational -> Rational -> Bool
forall a. Preorder a => a -> a -> Bool
~~ Rational
forall a. Num a => Ratio a
nan Bool -> Bool -> Bool
|| Rational
x Rational -> Rational -> Bool
forall a. Preorder a => a -> a -> Bool
< Rational
low) (Rational -> Rational -> Bool
forall a. Preorder a => a -> a -> Bool
~~ Rational
forall a. Num a => Ratio a
pinf) ((Rational -> a) -> Rational -> Extended a)
-> (Rational -> a) -> Rational -> Extended a
forall a b. (a -> b) -> a -> b
$ \Rational
x -> if Rational
x Rational -> Rational -> Bool
forall a. Preorder a => a -> a -> Bool
> Rational
high then a
forall a. Bounded a => a
maxBound else Rational -> a
forall a b. (RealFrac a, Integral b) => a -> b
P.floor Rational
x

    high :: Rational
high = a -> Rational
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral @a a
forall a. Bounded a => a
maxBound
    low :: Rational
low = -Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
high

toFloating :: Fractional a => (Rational -> a) -> Rational -> a
toFloating :: (Rational -> a) -> Rational -> a
toFloating Rational -> a
f Rational
x
    | Rational
x Rational -> Rational -> Bool
forall a. Preorder a => a -> a -> Bool
~~ Rational
forall a. Num a => Ratio a
nan = a
0 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
0
    | Rational
x Rational -> Rational -> Bool
forall a. Preorder a => a -> a -> Bool
~~ Rational
forall a. Num a => Ratio a
ninf = (-a
1) a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
0
    | Rational
x Rational -> Rational -> Bool
forall a. Preorder a => a -> a -> Bool
~~ Rational
forall a. Num a => Ratio a
pinf = a
1 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
0
    | Bool
otherwise = Rational -> a
f Rational
x

fromFloating :: (Order a, Fractional a) => (a -> Rational) -> a -> Rational
fromFloating :: (a -> Rational) -> a -> Rational
fromFloating a -> Rational
f a
x
    | a
x a -> a -> Bool
forall a. Preorder a => a -> a -> Bool
~~ a
0 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
0 = Rational
forall a. Num a => Ratio a
nan
    | a
x a -> a -> Bool
forall a. Preorder a => a -> a -> Bool
~~ (-a
1) a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
0 = Rational
forall a. Num a => Ratio a
ninf
    | a
x a -> a -> Bool
forall a. Preorder a => a -> a -> Bool
~~ a
1 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
0 = Rational
forall a. Num a => Ratio a
pinf
    | Bool
otherwise = a -> Rational
f a
x

{-
pabs :: (Lattice a, Eq a, Num a) => a -> a
pabs x = if 0 <~ x then x else negate x

cancel :: (Lattice a, Eq a, Num a) => Ratio a -> Ratio a
cancel (x :% y) = if x < 0 && y < 0 then (pabs x) :% (pabs y) else x :% y

-- | An exception-safe version of 'nanf' for rationals.
--
nanr :: Integral b => (a -> Ratio b) -> Maybe a -> Ratio b
nanr f = maybe (0 :% 0) f

ratpos :: Conn k Rational Positive
ratpos = Conn k f g h where

  f = liftExtended (~~ ninf) (\x -> x ~~ nan || x ~~ pinf) P.ceiling

  g = extended minBound maxBound P.fromIntegral

  h = liftExtended (\x -> x ~~ nan || x ~~ ninf) (~~ pinf) P.floor
-}