{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
module Numeric.Data.Fraction.Internal
(
Fraction ((:%:), (:%!), UnsafeFraction),
unsafeFraction,
(%!),
numerator,
denominator,
reduce,
errMsg,
)
where
import Control.DeepSeq (NFData)
import Data.Bounds
( LowerBounded,
LowerBoundless,
UpperBounded,
UpperBoundless,
)
import Data.Kind (Type)
import Data.Text.Display (Display (displayBuilder))
import GHC.Generics (Generic)
import GHC.Natural (Natural)
import GHC.Real (Ratio ((:%)))
import GHC.Real qualified as R
import GHC.Records (HasField (getField))
import GHC.Stack (HasCallStack)
import Language.Haskell.TH.Syntax (Lift)
import Numeric.Algebra.Additive.AGroup (AGroup ((.-.)))
import Numeric.Algebra.Additive.AMonoid (AMonoid (zero))
import Numeric.Algebra.Additive.ASemigroup (ASemigroup ((.+.)))
import Numeric.Algebra.Field (Field)
import Numeric.Algebra.Multiplicative.MGroup (MGroup ((.%.)))
import Numeric.Algebra.Multiplicative.MMonoid (MMonoid (one))
import Numeric.Algebra.Multiplicative.MSemigroup (MSemigroup ((.*.)))
import Numeric.Algebra.Normed (Normed (norm))
import Numeric.Algebra.Ring (Ring)
import Numeric.Algebra.Semifield (Semifield)
import Numeric.Algebra.Semiring (Semiring)
import Numeric.Class.Division (Division (divide))
import Numeric.Literal.Integer (FromInteger (afromInteger))
import Numeric.Literal.Rational (FromRational (afromRational))
import Optics.Core
( A_Getter,
A_Lens,
LabelOptic (labelOptic),
lens,
to,
)
type Fraction :: Type -> Type
data Fraction a = UnsafeFraction !a !a
deriving stock
(
(forall x. Fraction a -> Rep (Fraction a) x)
-> (forall x. Rep (Fraction a) x -> Fraction a)
-> Generic (Fraction a)
forall x. Rep (Fraction a) x -> Fraction a
forall x. Fraction a -> Rep (Fraction a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Fraction a) x -> Fraction a
forall a x. Fraction a -> Rep (Fraction a) x
$cfrom :: forall a x. Fraction a -> Rep (Fraction a) x
from :: forall x. Fraction a -> Rep (Fraction a) x
$cto :: forall a x. Rep (Fraction a) x -> Fraction a
to :: forall x. Rep (Fraction a) x -> Fraction a
Generic,
(forall (m :: Type -> Type). Quote m => Fraction a -> m Exp)
-> (forall (m :: Type -> Type).
Quote m =>
Fraction a -> Code m (Fraction a))
-> Lift (Fraction a)
forall a (m :: Type -> Type).
(Lift a, Quote m) =>
Fraction a -> m Exp
forall a (m :: Type -> Type).
(Lift a, Quote m) =>
Fraction a -> Code m (Fraction a)
forall t.
(forall (m :: Type -> Type). Quote m => t -> m Exp)
-> (forall (m :: Type -> Type). Quote m => t -> Code m t) -> Lift t
forall (m :: Type -> Type). Quote m => Fraction a -> m Exp
forall (m :: Type -> Type).
Quote m =>
Fraction a -> Code m (Fraction a)
$clift :: forall a (m :: Type -> Type).
(Lift a, Quote m) =>
Fraction a -> m Exp
lift :: forall (m :: Type -> Type). Quote m => Fraction a -> m Exp
$cliftTyped :: forall a (m :: Type -> Type).
(Lift a, Quote m) =>
Fraction a -> Code m (Fraction a)
liftTyped :: forall (m :: Type -> Type).
Quote m =>
Fraction a -> Code m (Fraction a)
Lift,
Int -> Fraction a -> ShowS
[Fraction a] -> ShowS
Fraction a -> String
(Int -> Fraction a -> ShowS)
-> (Fraction a -> String)
-> ([Fraction a] -> ShowS)
-> Show (Fraction a)
forall a. Show a => Int -> Fraction a -> ShowS
forall a. Show a => [Fraction a] -> ShowS
forall a. Show a => Fraction a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Fraction a -> ShowS
showsPrec :: Int -> Fraction a -> ShowS
$cshow :: forall a. Show a => Fraction a -> String
show :: Fraction a -> String
$cshowList :: forall a. Show a => [Fraction a] -> ShowS
showList :: [Fraction a] -> ShowS
Show
)
deriving anyclass
(
Fraction a
Fraction a -> LowerBounded (Fraction a)
forall a. a -> LowerBounded a
forall a. (Bounded a, Num a) => Fraction a
$clowerBound :: forall a. (Bounded a, Num a) => Fraction a
lowerBound :: Fraction a
LowerBounded,
Fraction a -> ()
(Fraction a -> ()) -> NFData (Fraction a)
forall a. NFData a => Fraction a -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall a. NFData a => Fraction a -> ()
rnf :: Fraction a -> ()
NFData,
Fraction a
Fraction a -> UpperBounded (Fraction a)
forall a. a -> UpperBounded a
forall a. (Bounded a, Num a) => Fraction a
$cupperBound :: forall a. (Bounded a, Num a) => Fraction a
upperBound :: Fraction a
UpperBounded
)
instance HasField "numerator" (Fraction n) n where
getField :: Fraction n -> n
getField (UnsafeFraction n
n n
_) = n
n
instance HasField "denominator" (Fraction n) n where
getField :: Fraction n -> n
getField (UnsafeFraction n
_ n
d) = n
d
instance
( k ~ A_Lens,
a ~ n,
b ~ n
) =>
LabelOptic "numerator" k (Fraction n) (Fraction n) a b
where
labelOptic :: Optic k NoIx (Fraction n) (Fraction n) a b
labelOptic = (Fraction n -> a)
-> (Fraction n -> b -> Fraction n)
-> Lens (Fraction n) (Fraction n) a b
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Fraction n -> a
Fraction n -> n
forall n. Fraction n -> n
numerator (\(UnsafeFraction n
_ n
d) b
n' -> n -> n -> Fraction n
forall a. a -> a -> Fraction a
UnsafeFraction n
b
n' n
d)
{-# INLINE labelOptic #-}
instance
( k ~ A_Getter,
a ~ n,
b ~ n
) =>
LabelOptic "denominator" k (Fraction n) (Fraction n) a b
where
labelOptic :: Optic k NoIx (Fraction n) (Fraction n) a b
labelOptic = (Fraction n -> a) -> Getter (Fraction n) a
forall s a. (s -> a) -> Getter s a
to Fraction n -> a
Fraction n -> n
forall n. Fraction n -> n
denominator
{-# INLINE labelOptic #-}
pattern (:%:) :: a -> a -> Fraction a
pattern n $m:%: :: forall {r} {a}. Fraction a -> (a -> a -> r) -> ((# #) -> r) -> r
:%: d <- UnsafeFraction n d
{-# COMPLETE (:%:) #-}
infixr 5 :%:
pattern (:%!) ::
( HasCallStack,
Integral a,
UpperBoundless a
) =>
a ->
a ->
Fraction a
pattern n $m:%! :: forall {r} {a}.
(HasCallStack, Integral a, UpperBoundless a) =>
Fraction a -> (a -> a -> r) -> ((# #) -> r) -> r
$b:%! :: forall a.
(HasCallStack, Integral a, UpperBoundless a) =>
a -> a -> Fraction a
:%! d <- UnsafeFraction n d
where
a
n :%! a
d = a -> a -> Fraction a
forall a.
(HasCallStack, Integral a, UpperBoundless a) =>
a -> a -> Fraction a
unsafeFraction a
n a
d
{-# COMPLETE (:%!) #-}
infixr 5 :%!
instance (Bounded a, Num a) => Bounded (Fraction a) where
minBound :: Fraction a
minBound = a -> a -> Fraction a
forall a. a -> a -> Fraction a
UnsafeFraction a
forall a. Bounded a => a
minBound a
1
maxBound :: Fraction a
maxBound = a -> a -> Fraction a
forall a. a -> a -> Fraction a
UnsafeFraction a
forall a. Bounded a => a
maxBound a
1
{-# INLINEABLE minBound #-}
{-# INLINEABLE maxBound #-}
instance (LowerBoundless a) => LowerBoundless (Fraction a)
instance (UpperBoundless a) => UpperBoundless (Fraction a)
instance (Show a) => Display (Fraction a) where
displayBuilder :: Fraction a -> Builder
displayBuilder (UnsafeFraction a
n a
d) =
[Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
[ String -> Builder
forall a. Display a => a -> Builder
displayBuilder (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
n,
forall a. Display a => a -> Builder
displayBuilder @String String
" / ",
String -> Builder
forall a. Display a => a -> Builder
displayBuilder (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
d
]
instance (Eq a, Integral a, UpperBoundless a) => Eq (Fraction a) where
UnsafeFraction a
0 a
_ == :: Fraction a -> Fraction a -> Bool
== UnsafeFraction a
0 a
_ = Bool
True
Fraction a
x == Fraction a
y = a
n1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
n2 Bool -> Bool -> Bool
&& a
d1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
d2
where
UnsafeFraction a
n1 a
d1 = Fraction a -> Fraction a
forall a.
(Integral a, UpperBoundless a) =>
Fraction a -> Fraction a
reduce Fraction a
x
UnsafeFraction a
n2 a
d2 = Fraction a -> Fraction a
forall a.
(Integral a, UpperBoundless a) =>
Fraction a -> Fraction a
reduce Fraction a
y
{-# INLINEABLE (==) #-}
instance (Integral a, UpperBoundless a) => Ord (Fraction a) where
x :: Fraction a
x@(UnsafeFraction a
n1 a
d1) <= :: Fraction a -> Fraction a -> Bool
<= y :: Fraction a
y@(UnsafeFraction a
n2 a
d2)
| Fraction a
x Fraction a -> Fraction a -> Bool
forall a. Eq a => a -> a -> Bool
== Fraction a
y = Bool
True
| Bool
otherwise = a
n1 a -> a -> a
forall a. Num a => a -> a -> a
* a
d2 a -> a -> Bool
`comp` a
n2 a -> a -> a
forall a. Num a => a -> a -> a
* a
d1
where
isNeg :: Fraction a -> Bool
isNeg = (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0) (a -> Bool) -> (Fraction a -> a) -> Fraction a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fraction a -> a
forall n. Fraction n -> n
denominator
comp :: a -> a -> Bool
comp
| Fraction a -> Bool
isNeg Fraction a
x Bool -> Bool -> Bool
`xor` Fraction a -> Bool
isNeg Fraction a
y = a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=)
| Bool
otherwise = a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=)
infix 4 `comp`
{-# INLINEABLE (<=) #-}
instance (Integral a, UpperBoundless a) => Enum (Fraction a) where
toEnum :: Int -> Fraction a
toEnum Int
n = a -> a -> Fraction a
forall a. a -> a -> Fraction a
UnsafeFraction (Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) a
1
{-# INLINEABLE toEnum #-}
fromEnum :: Fraction a -> Int
fromEnum = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> (Fraction a -> Integer) -> Fraction a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fraction a -> Integer
forall b. Integral b => Fraction a -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate
{-# INLINEABLE fromEnum #-}
instance (Integral a, UpperBoundless a) => Fractional (Fraction a) where
(UnsafeFraction a
n1 a
d1) / :: Fraction a -> Fraction a -> Fraction a
/ (UnsafeFraction a
n2 a
d2) =
a -> a -> Fraction a
forall a.
(HasCallStack, Integral a, UpperBoundless a) =>
a -> a -> Fraction a
unsafeFraction (a
n1 a -> a -> a
forall a. Num a => a -> a -> a
* a
d2) (a
n2 a -> a -> a
forall a. Num a => a -> a -> a
* a
d1)
{-# INLINEABLE (/) #-}
recip :: Fraction a -> Fraction a
recip (UnsafeFraction a
0 a
_) =
String -> Fraction a
forall a. HasCallStack => String -> a
error String
"Numeric.Data.Fraction.recip: Fraction has zero numerator"
recip (UnsafeFraction a
n a
d) = a -> a -> Fraction a
forall a.
(HasCallStack, Integral a, UpperBoundless a) =>
a -> a -> Fraction a
unsafeFraction a
d a
n
{-# INLINEABLE recip #-}
fromRational :: Rational -> Fraction a
fromRational (Integer
n :% Integer
d) = a -> a -> Fraction a
forall a.
(HasCallStack, Integral a, UpperBoundless a) =>
a -> a -> Fraction a
unsafeFraction (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
n) (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
d)
{-# INLINEABLE fromRational #-}
instance (Integral a, UpperBoundless a) => Num (Fraction a) where
(UnsafeFraction a
n1 a
d1) + :: Fraction a -> Fraction a -> Fraction a
+ (UnsafeFraction a
n2 a
d2) =
a -> a -> Fraction a
forall a.
(HasCallStack, Integral a, UpperBoundless a) =>
a -> a -> Fraction a
unsafeFraction (a
n1 a -> a -> a
forall a. Num a => a -> a -> a
* a
d2 a -> a -> a
forall a. Num a => a -> a -> a
+ a
n2 a -> a -> a
forall a. Num a => a -> a -> a
* a
d1) (a
d1 a -> a -> a
forall a. Num a => a -> a -> a
* a
d2)
{-# INLINEABLE (+) #-}
(UnsafeFraction a
n1 a
d1) - :: Fraction a -> Fraction a -> Fraction a
- (UnsafeFraction a
n2 a
d2) =
a -> a -> Fraction a
forall a.
(HasCallStack, Integral a, UpperBoundless a) =>
a -> a -> Fraction a
unsafeFraction (a
n1 a -> a -> a
forall a. Num a => a -> a -> a
* a
d2 a -> a -> a
forall a. Num a => a -> a -> a
- a
n2 a -> a -> a
forall a. Num a => a -> a -> a
* a
d1) (a
d1 a -> a -> a
forall a. Num a => a -> a -> a
* a
d2)
{-# INLINEABLE (-) #-}
(UnsafeFraction a
n1 a
d1) * :: Fraction a -> Fraction a -> Fraction a
* (UnsafeFraction a
n2 a
d2) =
a -> a -> Fraction a
forall a.
(HasCallStack, Integral a, UpperBoundless a) =>
a -> a -> Fraction a
unsafeFraction (a
n1 a -> a -> a
forall a. Num a => a -> a -> a
* a
n2) (a
d1 a -> a -> a
forall a. Num a => a -> a -> a
* a
d2)
{-# INLINEABLE (*) #-}
negate :: Fraction a -> Fraction a
negate (UnsafeFraction a
n a
d) = a -> a -> Fraction a
forall a. a -> a -> Fraction a
UnsafeFraction (-a
n) a
d
{-# INLINEABLE negate #-}
abs :: Fraction a -> Fraction a
abs (UnsafeFraction a
n a
d) = a -> a -> Fraction a
forall a. a -> a -> Fraction a
UnsafeFraction (a -> a
forall a. Num a => a -> a
abs a
n) (a -> a
forall a. Num a => a -> a
abs a
d)
{-# INLINEABLE abs #-}
signum :: Fraction a -> Fraction a
signum (UnsafeFraction a
n a
d) = a -> a -> Fraction a
forall a. a -> a -> Fraction a
UnsafeFraction (a -> a
forall a. Num a => a -> a
signum a
n a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a. Num a => a -> a
signum a
d) a
1
{-# INLINEABLE signum #-}
fromInteger :: Integer -> Fraction a
fromInteger Integer
n1 = a -> a -> Fraction a
forall a. a -> a -> Fraction a
UnsafeFraction (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
n1) a
1
{-# INLINEABLE fromInteger #-}
instance (Integral a, UpperBoundless a) => Real (Fraction a) where
toRational :: Fraction a -> Rational
toRational (UnsafeFraction a
n a
d) = Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
R.reduce (a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n) (a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
d)
{-# INLINEABLE toRational #-}
instance (Integral a, UpperBoundless a) => RealFrac (Fraction a) where
properFraction :: forall b. Integral b => Fraction a -> (b, Fraction a)
properFraction (UnsafeFraction a
n a
d) =
(Integer -> b
forall a. Num a => Integer -> a
fromInteger (a -> Integer
forall a. Integral a => a -> Integer
toInteger a
q), a -> a -> Fraction a
forall a. a -> a -> Fraction a
UnsafeFraction a
r a
d)
where
(a
q, a
r) = a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
quotRem a
n a
d
{-# INLINEABLE properFraction #-}
instance Division (Fraction Integer) where
divide :: Fraction Integer -> Fraction Integer -> Fraction Integer
divide = Fraction Integer -> Fraction Integer -> Fraction Integer
forall a. Fractional a => a -> a -> a
(/)
{-# INLINEABLE divide #-}
instance Division (Fraction Natural) where
divide :: Fraction Natural -> Fraction Natural -> Fraction Natural
divide = Fraction Natural -> Fraction Natural -> Fraction Natural
forall a. Fractional a => a -> a -> a
(/)
{-# INLINEABLE divide #-}
instance ASemigroup (Fraction Integer) where
.+. :: Fraction Integer -> Fraction Integer -> Fraction Integer
(.+.) = Fraction Integer -> Fraction Integer -> Fraction Integer
forall a. Num a => a -> a -> a
(+)
{-# INLINEABLE (.+.) #-}
instance ASemigroup (Fraction Natural) where
.+. :: Fraction Natural -> Fraction Natural -> Fraction Natural
(.+.) = Fraction Natural -> Fraction Natural -> Fraction Natural
forall a. Num a => a -> a -> a
(+)
{-# INLINEABLE (.+.) #-}
instance AMonoid (Fraction Integer) where
zero :: Fraction Integer
zero = Integer -> Integer -> Fraction Integer
forall a. a -> a -> Fraction a
UnsafeFraction Integer
0 Integer
1
{-# INLINEABLE zero #-}
instance AMonoid (Fraction Natural) where
zero :: Fraction Natural
zero = Natural -> Natural -> Fraction Natural
forall a. a -> a -> Fraction a
UnsafeFraction Natural
0 Natural
1
{-# INLINEABLE zero #-}
instance AGroup (Fraction Integer) where
.-. :: Fraction Integer -> Fraction Integer -> Fraction Integer
(.-.) = (-)
{-# INLINEABLE (.-.) #-}
instance MSemigroup (Fraction Integer) where
.*. :: Fraction Integer -> Fraction Integer -> Fraction Integer
(.*.) = Fraction Integer -> Fraction Integer -> Fraction Integer
forall a. Num a => a -> a -> a
(*)
{-# INLINEABLE (.*.) #-}
instance MSemigroup (Fraction Natural) where
.*. :: Fraction Natural -> Fraction Natural -> Fraction Natural
(.*.) = Fraction Natural -> Fraction Natural -> Fraction Natural
forall a. Num a => a -> a -> a
(*)
{-# INLINEABLE (.*.) #-}
instance MMonoid (Fraction Integer) where
one :: Fraction Integer
one = Integer -> Integer -> Fraction Integer
forall a. a -> a -> Fraction a
UnsafeFraction Integer
1 Integer
1
{-# INLINEABLE one #-}
instance MMonoid (Fraction Natural) where
one :: Fraction Natural
one = Natural -> Natural -> Fraction Natural
forall a. a -> a -> Fraction a
UnsafeFraction Natural
1 Natural
1
{-# INLINEABLE one #-}
instance MGroup (Fraction Integer) where
Fraction Integer
x .%. :: Fraction Integer -> Fraction Integer -> Fraction Integer
.%. (UnsafeFraction Integer
n Integer
d) = Fraction Integer
x Fraction Integer -> Fraction Integer -> Fraction Integer
forall s. MSemigroup s => s -> s -> s
.*. Integer -> Integer -> Fraction Integer
forall a. a -> a -> Fraction a
UnsafeFraction Integer
d Integer
n
{-# INLINEABLE (.%.) #-}
instance MGroup (Fraction Natural) where
Fraction Natural
x .%. :: Fraction Natural -> Fraction Natural -> Fraction Natural
.%. (UnsafeFraction Natural
n Natural
d) = Fraction Natural
x Fraction Natural -> Fraction Natural -> Fraction Natural
forall s. MSemigroup s => s -> s -> s
.*. Natural -> Natural -> Fraction Natural
forall a. a -> a -> Fraction a
UnsafeFraction Natural
d Natural
n
{-# INLINEABLE (.%.) #-}
instance Normed (Fraction Integer) where
norm :: Fraction Integer -> Fraction Integer
norm = Fraction Integer -> Fraction Integer
forall a. Num a => a -> a
abs
{-# INLINEABLE norm #-}
instance Normed (Fraction Natural) where
norm :: Fraction Natural -> Fraction Natural
norm = Fraction Natural -> Fraction Natural
forall a. Num a => a -> a
abs
{-# INLINEABLE norm #-}
instance Semiring (Fraction Integer)
instance Semiring (Fraction Natural)
instance Ring (Fraction Integer)
instance Semifield (Fraction Natural)
instance Semifield (Fraction Integer)
instance Field (Fraction Integer)
instance FromInteger (Fraction Integer) where
afromInteger :: HasCallStack => Integer -> Fraction Integer
afromInteger = Integer -> Fraction Integer
forall a. Num a => Integer -> a
fromInteger
{-# INLINEABLE afromInteger #-}
instance FromInteger (Fraction Natural) where
afromInteger :: HasCallStack => Integer -> Fraction Natural
afromInteger = Integer -> Fraction Natural
forall a. Num a => Integer -> a
fromInteger
{-# INLINEABLE afromInteger #-}
instance FromRational (Fraction Integer) where
afromRational :: HasCallStack => Rational -> Fraction Integer
afromRational = Rational -> Fraction Integer
forall a. Fractional a => Rational -> a
fromRational
{-# INLINEABLE afromRational #-}
instance FromRational (Fraction Natural) where
afromRational :: HasCallStack => Rational -> Fraction Natural
afromRational = Rational -> Fraction Natural
forall a. Fractional a => Rational -> a
fromRational
{-# INLINEABLE afromRational #-}
numerator :: Fraction a -> a
numerator :: forall n. Fraction n -> n
numerator (UnsafeFraction a
n a
_) = a
n
denominator :: Fraction a -> a
denominator :: forall n. Fraction n -> n
denominator (UnsafeFraction a
_ a
d) = a
d
unsafeFraction ::
( HasCallStack,
Integral a,
UpperBoundless a
) =>
a ->
a ->
Fraction a
unsafeFraction :: forall a.
(HasCallStack, Integral a, UpperBoundless a) =>
a -> a -> Fraction a
unsafeFraction a
_ a
0 = String -> Fraction a
forall a. HasCallStack => String -> a
error (String -> Fraction a) -> String -> Fraction a
forall a b. (a -> b) -> a -> b
$ ShowS
errMsg String
"unsafeFraction"
unsafeFraction a
n a
d = Fraction a -> Fraction a
forall a.
(Integral a, UpperBoundless a) =>
Fraction a -> Fraction a
reduce (Fraction a -> Fraction a) -> Fraction a -> Fraction a
forall a b. (a -> b) -> a -> b
$ a -> a -> Fraction a
forall a. a -> a -> Fraction a
UnsafeFraction a
n a
d
{-# INLINEABLE unsafeFraction #-}
(%!) ::
( HasCallStack,
Integral a,
UpperBoundless a
) =>
a ->
a ->
Fraction a
a
n %! :: forall a.
(HasCallStack, Integral a, UpperBoundless a) =>
a -> a -> Fraction a
%! a
d = a -> a -> Fraction a
forall a.
(HasCallStack, Integral a, UpperBoundless a) =>
a -> a -> Fraction a
unsafeFraction a
n a
d
{-# INLINE (%!) #-}
infixl 7 %!
reduce :: (Integral a, UpperBoundless a) => Fraction a -> Fraction a
reduce :: forall a.
(Integral a, UpperBoundless a) =>
Fraction a -> Fraction a
reduce (UnsafeFraction a
0 a
_) = a -> a -> Fraction a
forall a. a -> a -> Fraction a
UnsafeFraction a
0 a
1
reduce (UnsafeFraction a
n a
d) = a -> a -> Fraction a
forall a. a -> a -> Fraction a
UnsafeFraction (a
n' a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a. Num a => a -> a
signum a
d) (a -> a
forall a. Num a => a -> a
abs a
d')
where
n' :: a
n' = a
n a -> a -> a
forall a. Integral a => a -> a -> a
`quot` a
g
d' :: a
d' = a
d a -> a -> a
forall a. Integral a => a -> a -> a
`quot` a
g
g :: a
g = a -> a -> a
forall a. Integral a => a -> a -> a
gcd a
n a
d
{-# INLINEABLE reduce #-}
xor :: Bool -> Bool -> Bool
xor :: Bool -> Bool -> Bool
xor Bool
True Bool
False = Bool
True
xor Bool
False Bool
True = Bool
True
xor Bool
_ Bool
_ = Bool
False
{-# INLINEABLE xor #-}
infixr 2 `xor`
errMsg :: String -> String
errMsg :: ShowS
errMsg String
fn =
[String] -> String
forall a. Monoid a => [a] -> a
mconcat
[ String
"Numeric.Data.Fraction.",
String
fn,
String
": Fraction has zero denominator"
]