{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- | Provides the 'Fraction' type, a safer alternative to 'Ratio'.
--
-- @since 0.1
module Numeric.Data.Fraction.Internal
  ( -- * Type
    Fraction ((:%:), (:%!), UnsafeFraction),

    -- * Creation
    unsafeFraction,
    (%!),

    -- * Elimination
    numerator,
    denominator,

    -- * Functions
    reduce,

    -- * Misc
    errMsg,
  )
where

import Control.DeepSeq (NFData)
import Data.Bounds
  ( LowerBounded (lowerBound),
    LowerBoundless,
    MaybeLowerBounded (maybeLowerBound),
    UpperBoundless,
  )
import Data.Kind (Type)
import Data.Text.Display (Display (displayBuilder))
import GHC.Generics (Generic)
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 ((.-.)), anegate)
import Numeric.Algebra.Additive.AMonoid
  ( AMonoid (zero),
    pattern NonZero,
    pattern Zero,
  )
import Numeric.Algebra.Additive.ASemigroup (ASemigroup ((.+.)))
import Numeric.Algebra.Field (Field)
import Numeric.Algebra.MetricSpace (MetricSpace (diffR))
import Numeric.Algebra.Multiplicative.MEuclidean (MEuclidean (mdivMod), mdiv, mgcd)
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, sgn))
import Numeric.Algebra.Ring (Ring)
import Numeric.Algebra.Semifield (Semifield)
import Numeric.Algebra.Semiring (Semiring)
import Numeric.Class.Division (Division (divide))
import Numeric.Convert.Integer (FromInteger (fromZ), ToInteger (toZ))
import Numeric.Convert.Rational (FromRational (fromQ), ToRational (toQ))
import Numeric.Convert.Real (FromReal (fromR), ToReal (toR))
import Optics.Core
  ( A_Getter,
    A_Lens,
    LabelOptic (labelOptic),
    lens,
    to,
  )

-- $setup
-- >>> :set -XTemplateHaskell

-- | Type for representing fractions. Designed to be similar to 'Ratio' with
-- the primary difference that it does __not__ require the following invariants
-- for its instances (e.g. 'Eq') to be sensible:
--
-- 1. @n / d@ is maximally reduced.
--
-- 2. @d > 0@.
--
-- This has a number of consequences.
--
-- 1. Fraction's 'Eq' is based on an equivalence class, in contrast to
--    'Ratio', which compares the numerator and denominator directly:
--
--        * Fractions are reduced first, e.g., @2 :%: 4 === 1 :%: 2@.
--        * Negative denominators are considered:
--        @1 :%: 1 === -1 :%: -1@.
--
-- 2. The denominator is given more consideration:
--
--        * 'abs' operates on the numerator /and/ the denominator.
--        * 'signum' is positive if /both/ are negative.
--
-- 3. @'Show' x@ does __not__ reduce @x@ first. This is to make debugging
-- easier.
--
-- @'Fraction' 'Integer'@ is a 'Numeric.Algebra.Field.Field', and @'Fraction'
-- 'GHC.Natural.Natural'@ is a 'Numeric.Algebra.Semiring.Semiring'.
--
-- ==== __Examples__
--
-- >>> 2 %! 6 == 1 %! 3
-- True
--
-- >>> 1 %! 1 == -1 %! -1
-- True
--
-- >>> 1 %! 7 >= 1 %! -2
-- True
--
-- >>> -1 %! 7 >= 1 %! -2
-- True
--
-- >>> import Data.Text.Display (display)
-- >>> display $ 2 %! 6
-- "1 / 3"
--
-- @since 0.1
type Fraction :: Type -> Type
data Fraction a = UnsafeFraction !a !a
  deriving stock
    ( -- | @since 0.1
      (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,
      -- | @since 0.1
      (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,
      -- @since 0.1
      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
    ( -- | @since 0.1
      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
    )

-- | @since 0.1
instance HasField "numerator" (Fraction n) n where
  getField :: Fraction n -> n
getField (UnsafeFraction n
n n
_) = n
n

-- | @since 0.1
instance HasField "denominator" (Fraction n) n where
  getField :: Fraction n -> n
getField (UnsafeFraction n
_ n
d) = n
d

-- | @since 0.1
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 #-}

-- | @since 0.1
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 #-}

-- | Unidirectional pattern synonym for 'Fraction'. This allows us to pattern
-- match on a fraction term without exposing the unsafe internal details.
--
-- @since 0.1
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 :%:

-- | Bidirectional pattern synonym for 'Fraction'. Note that this is __not__
-- safe in general, as construction with a zero denominator with throw an
-- error.
--
-- __WARNING: Partial__
--
-- @since 0.1
pattern (:%!) ::
  ( HasCallStack,
    MEuclidean a,
    Normed a,
    Ord a,
    Semiring a,
    UpperBoundless a
  ) =>
  a ->
  a ->
  Fraction a
pattern n $m:%! :: forall {r} {a}.
(HasCallStack, MEuclidean a, Normed a, Ord a, Semiring a,
 UpperBoundless a) =>
Fraction a -> (a -> a -> r) -> ((# #) -> r) -> r
$b:%! :: forall a.
(HasCallStack, MEuclidean a, Normed a, Ord a, Semiring a,
 UpperBoundless a) =>
a -> a -> Fraction a
:%! d <- UnsafeFraction n d
  where
    a
n :%! a
d = a -> a -> Fraction a
forall a.
(HasCallStack, MEuclidean a, Normed a, Ord a, Semiring a,
 UpperBoundless a) =>
a -> a -> Fraction a
unsafeFraction a
n a
d

{-# COMPLETE (:%!) #-}

infixr 5 :%!

-- NOTE: No UpperBounded (consequently no Bounded) instance because we intend
-- for Fraction to only be used with types w/o an upper bound.

-- | @since 0.1
instance (LowerBounded a, MMonoid a) => LowerBounded (Fraction a) where
  lowerBound :: Fraction a
lowerBound = a -> a -> Fraction a
forall a. a -> a -> Fraction a
UnsafeFraction a
forall a. LowerBounded a => a
lowerBound a
forall m. MMonoid m => m
one
  {-# INLINEABLE lowerBound #-}

-- | @since 0.1
instance (MaybeLowerBounded a, MMonoid a) => MaybeLowerBounded (Fraction a) where
  maybeLowerBound :: Maybe (Fraction a)
maybeLowerBound = (\a
n -> a -> a -> Fraction a
forall a. a -> a -> Fraction a
UnsafeFraction a
n a
forall m. MMonoid m => m
one) (a -> Fraction a) -> Maybe a -> Maybe (Fraction a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
forall a. MaybeLowerBounded a => Maybe a
maybeLowerBound
  {-# INLINEABLE maybeLowerBound #-}

-- | @since 0.1
instance (LowerBoundless a) => LowerBoundless (Fraction a)

-- | @since 0.1
instance (UpperBoundless a) => UpperBoundless (Fraction a)

-- | @since 0.1
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
      ]

-- | @since 0.1
instance
  ( MEuclidean a,
    Normed a,
    Ord a,
    Semiring a,
    UpperBoundless a
  ) =>
  Eq (Fraction a)
  where
  UnsafeFraction a
Zero a
_ == :: Fraction a -> Fraction a -> Bool
== UnsafeFraction a
Zero 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.
(MEuclidean a, Normed a, Ord a, Semiring a, UpperBoundless a) =>
Fraction a -> Fraction a
reduce Fraction a
x
      UnsafeFraction a
n2 a
d2 = Fraction a -> Fraction a
forall a.
(MEuclidean a, Normed a, Ord a, Semiring a, UpperBoundless a) =>
Fraction a -> Fraction a
reduce Fraction a
y
  {-# INLINEABLE (==) #-}

-- | @since 0.1
instance
  ( MEuclidean a,
    Normed a,
    Ord a,
    Semiring 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 s. MSemigroup s => s -> s -> s
.*. a
d2 a -> a -> Bool
`comp` a
n2 a -> a -> a
forall s. MSemigroup s => s -> s -> s
.*. a
d1
    where
      isNeg :: Fraction a -> Bool
isNeg = (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
forall m. AMonoid m => m
zero) (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 (<=) #-}

-- | @since 0.1
instance
  ( FromInteger a,
    MEuclidean a,
    Normed a,
    Ord a,
    Ring a,
    ToInteger a,
    UpperBoundless a
  ) =>
  Enum (Fraction a)
  where
  toEnum :: Int -> Fraction a
toEnum = Integer -> Fraction a
forall a. (FromInteger a, HasCallStack) => Integer -> a
fromZ (Integer -> Fraction a) -> (Int -> Integer) -> Int -> Fraction a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. (ToInteger a, HasCallStack) => a -> Integer
toZ
  {-# INLINEABLE toEnum #-}
  fromEnum :: Fraction a -> Int
fromEnum Fraction a
x = Int
m
    where
      (Int
m, Fraction a
_) = Fraction a -> (Int, Fraction a)
forall b. Integral b => Fraction a -> (b, Fraction a)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction Fraction a
x
  {-# INLINEABLE fromEnum #-}

-- | @since 0.1
instance
  ( FromInteger a,
    MEuclidean a,
    Normed a,
    Ord a,
    Ring a,
    ToInteger a,
    UpperBoundless a
  ) =>
  Fractional (Fraction a)
  where
  / :: Fraction a -> Fraction a -> Fraction a
(/) = Fraction a -> Fraction a -> Fraction a
forall a. Division a => a -> a -> a
divide
  {-# INLINEABLE (/) #-}

  recip :: Fraction a -> Fraction a
recip = Fraction a -> Fraction a
forall a.
(HasCallStack, MEuclidean a, Normed a, Ord a, Semiring a,
 UpperBoundless a) =>
Fraction a -> Fraction a
reciprocal
  {-# INLINEABLE recip #-}
  fromRational :: Rational -> Fraction a
fromRational (Integer
n :% Integer
d) = a -> a -> Fraction a
forall a.
(HasCallStack, MEuclidean a, Normed a, Ord a, Semiring a,
 UpperBoundless a) =>
a -> a -> Fraction a
unsafeFraction (Integer -> a
forall a. (FromInteger a, HasCallStack) => Integer -> a
fromZ Integer
n) (Integer -> a
forall a. (FromInteger a, HasCallStack) => Integer -> a
fromZ Integer
d)
  {-# INLINEABLE fromRational #-}

-- | @since 0.1
instance
  ( FromInteger a,
    MEuclidean a,
    Normed a,
    Ord a,
    Ring a,
    UpperBoundless a
  ) =>
  Num (Fraction a)
  where
  + :: Fraction a -> Fraction a -> Fraction a
(+) = Fraction a -> Fraction a -> Fraction a
forall s. ASemigroup s => s -> s -> s
(.+.)
  {-# INLINEABLE (+) #-}
  (-) = Fraction a -> Fraction a -> Fraction a
forall g. AGroup g => g -> g -> g
(.-.)
  {-# INLINEABLE (-) #-}
  * :: Fraction a -> Fraction a -> Fraction a
(*) = Fraction a -> Fraction a -> Fraction a
forall s. MSemigroup s => s -> s -> s
(.*.)
  {-# INLINEABLE (*) #-}
  negate :: Fraction a -> Fraction a
negate = Fraction a -> Fraction a
forall g. AGroup g => g -> g
anegate
  {-# INLINEABLE negate #-}
  abs :: Fraction a -> Fraction a
abs = Fraction a -> Fraction a
forall s. Normed s => s -> s
norm
  {-# INLINEABLE abs #-}
  signum :: Fraction a -> Fraction a
signum = Fraction a -> Fraction a
forall s. Normed s => s -> s
sgn
  {-# INLINEABLE signum #-}
  fromInteger :: Integer -> Fraction a
fromInteger = Integer -> Fraction a
forall a. (FromInteger a, HasCallStack) => Integer -> a
fromZ
  {-# INLINEABLE fromInteger #-}

-- | @since 0.1
instance
  ( FromInteger a,
    MEuclidean a,
    Normed a,
    Ord a,
    Ring a,
    ToInteger 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. (ToInteger a, HasCallStack) => a -> Integer
toZ a
n) (a -> Integer
forall a. (ToInteger a, HasCallStack) => a -> Integer
toZ a
d)
  {-# INLINEABLE toRational #-}

-- | @since 0.1
instance
  ( FromInteger a,
    MEuclidean a,
    Normed a,
    Ord a,
    Ring a,
    ToInteger 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. (ToInteger a, HasCallStack) => a -> Integer
toZ a
q), a -> a -> Fraction a
forall a. a -> a -> Fraction a
UnsafeFraction a
r a
d)
    where
      (a
q, a
r) = a
n a -> a -> (a, a)
forall g. MEuclidean g => g -> g -> (g, g)
`mdivMod` a
d
  {-# INLINEABLE properFraction #-}

-- | @since 0.1
instance
  ( FromInteger a,
    MEuclidean a,
    Normed a,
    Ord a,
    Semiring a,
    ToInteger a,
    UpperBoundless a
  ) =>
  Division (Fraction a)
  where
  divide :: Fraction a -> Fraction a -> Fraction a
divide Fraction a
x Fraction a
y = Fraction a
x Fraction a -> Fraction a -> Fraction a
forall s. MSemigroup s => s -> s -> s
.*. Fraction a -> Fraction a
forall a.
(HasCallStack, MEuclidean a, Normed a, Ord a, Semiring a,
 UpperBoundless a) =>
Fraction a -> Fraction a
reciprocal Fraction a
y
  {-# INLINEABLE divide #-}

-- | @since 0.1
instance
  ( MEuclidean a,
    Normed a,
    Ord a,
    Semiring a,
    UpperBoundless a
  ) =>
  ASemigroup (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, MEuclidean a, Normed a, Ord a, Semiring a,
 UpperBoundless a) =>
a -> a -> Fraction a
unsafeFraction (a
n1 a -> a -> a
forall s. MSemigroup s => s -> s -> s
.*. a
d2 a -> a -> a
forall s. ASemigroup s => s -> s -> s
.+. a
n2 a -> a -> a
forall s. MSemigroup s => s -> s -> s
.*. a
d1) (a
d1 a -> a -> a
forall s. MSemigroup s => s -> s -> s
.*. a
d2)
  {-# INLINEABLE (.+.) #-}

-- | @since 0.1
instance
  ( MEuclidean a,
    Normed a,
    Ord a,
    Semiring a,
    UpperBoundless a
  ) =>
  AMonoid (Fraction a)
  where
  zero :: Fraction a
zero = a -> a -> Fraction a
forall a. a -> a -> Fraction a
UnsafeFraction a
forall m. AMonoid m => m
zero a
forall m. MMonoid m => m
one
  {-# INLINEABLE zero #-}

-- | @since 0.1
instance
  ( MEuclidean a,
    Normed a,
    Ord a,
    Ring a,
    UpperBoundless a
  ) =>
  AGroup (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, MEuclidean a, Normed a, Ord a, Semiring a,
 UpperBoundless a) =>
a -> a -> Fraction a
unsafeFraction (a
n1 a -> a -> a
forall s. MSemigroup s => s -> s -> s
.*. a
d2 a -> a -> a
forall g. AGroup g => g -> g -> g
.-. a
n2 a -> a -> a
forall s. MSemigroup s => s -> s -> s
.*. a
d1) (a
d1 a -> a -> a
forall s. MSemigroup s => s -> s -> s
.*. a
d2)
  {-# INLINEABLE (.-.) #-}

-- | @since 0.1
instance
  ( MEuclidean a,
    Normed a,
    Ord a,
    Semiring a,
    UpperBoundless a
  ) =>
  MSemigroup (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, MEuclidean a, Normed a, Ord a, Semiring a,
 UpperBoundless a) =>
a -> a -> Fraction a
unsafeFraction (a
n1 a -> a -> a
forall s. MSemigroup s => s -> s -> s
.*. a
n2) (a
d1 a -> a -> a
forall s. MSemigroup s => s -> s -> s
.*. a
d2)
  {-# INLINEABLE (.*.) #-}

-- | @since 0.1
instance
  ( MEuclidean a,
    Normed a,
    Ord a,
    Semiring a,
    UpperBoundless a
  ) =>
  MMonoid (Fraction a)
  where
  one :: Fraction a
one = a -> a -> Fraction a
forall a. a -> a -> Fraction a
UnsafeFraction a
forall m. MMonoid m => m
one a
forall m. MMonoid m => m
one
  {-# INLINEABLE one #-}

-- | @since 0.1
instance
  ( MEuclidean a,
    Normed a,
    Ord a,
    Semiring a,
    UpperBoundless a
  ) =>
  MGroup (Fraction a)
  where
  Fraction a
x .%. :: Fraction a -> Fraction a -> Fraction a
.%. (UnsafeFraction a
n a
d) = Fraction a
x Fraction a -> Fraction a -> Fraction a
forall s. MSemigroup s => s -> s -> s
.*. a -> a -> Fraction a
forall a. a -> a -> Fraction a
UnsafeFraction a
d a
n
  {-# INLINEABLE (.%.) #-}

-- | @since 0.1
instance (ToInteger a, UpperBoundless a) => MetricSpace (Fraction a) where
  Fraction a
x diffR :: Fraction a -> Fraction a -> Double
`diffR` Fraction a
y = Fraction a -> Double
forall a. (ToReal a, HasCallStack) => a -> Double
toR Fraction a
x Double -> Double -> Double
forall s. MetricSpace s => s -> s -> Double
`diffR` Fraction a -> Double
forall a. (ToReal a, HasCallStack) => a -> Double
toR Fraction a
y
  {-# INLINEABLE diffR #-}

-- | @since 0.1
instance (MMonoid a, Normed a, UpperBoundless a) => Normed (Fraction a) where
  norm :: Fraction a -> Fraction a
norm (UnsafeFraction a
n a
d) = a -> a -> Fraction a
forall a. a -> a -> Fraction a
UnsafeFraction (a -> a
forall s. Normed s => s -> s
norm a
n) (a -> a
forall s. Normed s => s -> s
norm a
d)
  {-# INLINEABLE norm #-}

  sgn :: Fraction a -> Fraction a
sgn (UnsafeFraction a
n a
_) = a -> a -> Fraction a
forall a. a -> a -> Fraction a
UnsafeFraction (a -> a
forall s. Normed s => s -> s
sgn a
n) a
forall m. MMonoid m => m
one
  {-# INLINEABLE sgn #-}

-- | @since 0.1
instance
  ( MEuclidean a,
    Normed a,
    Ord a,
    Semiring a,
    UpperBoundless a
  ) =>
  Semiring (Fraction a)

-- | @since 0.1
instance
  ( MEuclidean a,
    Normed a,
    Ord a,
    Ring a,
    UpperBoundless a
  ) =>
  Ring (Fraction a)

-- | @since 0.1
instance
  ( MEuclidean a,
    Normed a,
    Ord a,
    Semiring a,
    UpperBoundless a
  ) =>
  Semifield (Fraction a)

-- | @since 0.1
instance
  ( MEuclidean a,
    Normed a,
    Ord a,
    Ring a,
    UpperBoundless a
  ) =>
  Field (Fraction a)

-- | @since 0.1
instance
  ( FromInteger a,
    MMonoid a,
    UpperBoundless a
  ) =>
  FromInteger (Fraction a)
  where
  fromZ :: HasCallStack => Integer -> Fraction a
fromZ Integer
n = a -> a -> Fraction a
forall a. a -> a -> Fraction a
UnsafeFraction (Integer -> a
forall a. (FromInteger a, HasCallStack) => Integer -> a
fromZ Integer
n) a
forall m. MMonoid m => m
one
  {-# INLINEABLE fromZ #-}

-- | @since 0.1
instance
  ( FromInteger a,
    MEuclidean a,
    Normed a,
    Ord a,
    Semiring a,
    UpperBoundless a
  ) =>
  FromRational (Fraction a)
  where
  fromQ :: HasCallStack => Rational -> Fraction a
fromQ (Integer
n :% Integer
d) = Fraction a -> Fraction a
forall a.
(MEuclidean a, Normed a, Ord a, Semiring 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 (Integer -> a
forall a. (FromInteger a, HasCallStack) => Integer -> a
fromZ Integer
n) (Integer -> a
forall a. (FromInteger a, HasCallStack) => Integer -> a
fromZ Integer
d)
  {-# INLINEABLE fromQ #-}

-- | @since 0.1
instance (ToInteger a, UpperBoundless a) => ToRational (Fraction a) where
  toQ :: HasCallStack => Fraction a -> Rational
toQ (UnsafeFraction a
n a
d) = a -> Integer
forall a. (ToInteger a, HasCallStack) => a -> Integer
toZ a
n Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% a -> Integer
forall a. (ToInteger a, HasCallStack) => a -> Integer
toZ a
d
  {-# INLINEABLE toQ #-}

-- | @since 0.1
instance
  ( FromInteger a,
    MEuclidean a,
    Normed a,
    Ord a,
    Semiring a,
    UpperBoundless a
  ) =>
  FromReal (Fraction a)
  where
  fromR :: HasCallStack => Double -> Fraction a
fromR Double
x = Fraction a -> Fraction a
forall a.
(MEuclidean a, Normed a, Ord a, Semiring 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 (Integer -> a
forall a. (FromInteger a, HasCallStack) => Integer -> a
fromZ Integer
n) (Integer -> a
forall a. (FromInteger a, HasCallStack) => Integer -> a
fromZ Integer
d)
    where
      Integer
n :% Integer
d = Double -> Rational
forall a. (FromReal a, HasCallStack) => Double -> a
fromR Double
x
  {-# INLINEABLE fromR #-}

-- | @since 0.1
instance (ToInteger a, UpperBoundless a) => ToReal (Fraction a) where
  toR :: HasCallStack => Fraction a -> Double
toR (UnsafeFraction a
n a
d) = Rational -> Double
forall a. (ToReal a, HasCallStack) => a -> Double
toR (a -> Integer
forall a. (ToInteger a, HasCallStack) => a -> Integer
toZ a
n Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% a -> Integer
forall a. (ToInteger a, HasCallStack) => a -> Integer
toZ a
d)
  {-# INLINEABLE toR #-}

-- | @since 0.1
numerator :: Fraction a -> a
numerator :: forall n. Fraction n -> n
numerator (UnsafeFraction a
n a
_) = a
n

-- | @since 0.1
denominator :: Fraction a -> a
denominator :: forall n. Fraction n -> n
denominator (UnsafeFraction a
_ a
d) = a
d

-- | Throws an error when given a denominator of 0.
--
-- __WARNING: Partial__
--
-- ==== __Examples__
-- >>> unsafeFraction 7 2
-- UnsafeFraction 7 2
--
--
-- @since 0.1
unsafeFraction ::
  ( HasCallStack,
    MEuclidean a,
    Normed a,
    Ord a,
    Semiring a,
    UpperBoundless a
  ) =>
  a ->
  a ->
  Fraction a
unsafeFraction :: forall a.
(HasCallStack, MEuclidean a, Normed a, Ord a, Semiring a,
 UpperBoundless a) =>
a -> a -> Fraction a
unsafeFraction a
_ a
Zero = 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 (NonZero a
d) = Fraction a -> Fraction a
forall a.
(MEuclidean a, Normed a, Ord a, Semiring 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 #-}

-- | Infix version of 'unsafeFraction'.
--
-- __WARNING: Partial__
--
-- ==== __Examples__
--
-- >>> 7 %! 2
-- UnsafeFraction 7 2
--
-- @since 0.1
(%!) ::
  ( HasCallStack,
    MEuclidean a,
    Normed a,
    Ord a,
    Semiring a,
    UpperBoundless a
  ) =>
  a ->
  a ->
  Fraction a
a
n %! :: forall a.
(HasCallStack, MEuclidean a, Normed a, Ord a, Semiring a,
 UpperBoundless a) =>
a -> a -> Fraction a
%! a
d = a -> a -> Fraction a
forall a.
(HasCallStack, MEuclidean a, Normed a, Ord a, Semiring a,
 UpperBoundless a) =>
a -> a -> Fraction a
unsafeFraction a
n a
d
{-# INLINE (%!) #-}

infixl 7 %!

-- | Reduces a fraction:
--
-- 1. Removes common factors.
-- 2. Factors out negative denominators.
-- 3. @reduce (0 :%: _) --> 0 :%: 1@.
--
-- ==== __Examples__
-- >>> reduce (7 %! 2)
-- UnsafeFraction 7 2
--
-- >>> reduce (18 %! 10)
-- UnsafeFraction 9 5
--
-- >>> reduce (-5 %! -5)
-- UnsafeFraction 1 1
--
-- @since 0.1
reduce ::
  ( MEuclidean a,
    Normed a,
    Ord a,
    Semiring a,
    UpperBoundless a
  ) =>
  Fraction a ->
  Fraction a
reduce :: forall a.
(MEuclidean a, Normed a, Ord a, Semiring a, UpperBoundless a) =>
Fraction a -> Fraction a
reduce (UnsafeFraction a
Zero a
_) = a -> a -> Fraction a
forall a. a -> a -> Fraction a
UnsafeFraction a
forall m. AMonoid m => m
zero a
forall m. MMonoid m => m
one
reduce (UnsafeFraction (NonZero a
n) a
d) = a -> a -> Fraction a
forall a. a -> a -> Fraction a
UnsafeFraction (a
n' a -> a -> a
forall s. MSemigroup s => s -> s -> s
.*. a -> a
forall s. Normed s => s -> s
sgn a
d) (a -> a
forall s. Normed s => s -> s
norm a
d')
  where
    n' :: a
n' = a
n a -> a -> a
forall g. MEuclidean g => g -> g -> g
`mdiv` a
g
    d' :: a
d' = a
d a -> a -> a
forall g. MEuclidean g => g -> g -> g
`mdiv` a
g
    g :: a
g = a -> a -> a
forall g. (AMonoid g, Eq g, MEuclidean g, Normed g) => g -> g -> g
mgcd a
n a
d
{-# INLINEABLE reduce #-}

reciprocal ::
  ( HasCallStack,
    MEuclidean a,
    Normed a,
    Ord a,
    Semiring a,
    UpperBoundless a
  ) =>
  Fraction a ->
  Fraction a
reciprocal :: forall a.
(HasCallStack, MEuclidean a, Normed a, Ord a, Semiring a,
 UpperBoundless a) =>
Fraction a -> Fraction a
reciprocal (UnsafeFraction a
Zero a
_) =
  -- NOTE: Not using errMsg because numerator vs. denominator
  String -> Fraction a
forall a. HasCallStack => String -> a
error String
"Numeric.Data.Fraction.reciprocal: Fraction has zero numerator"
reciprocal (UnsafeFraction (NonZero a
n) a
d) = a -> a -> Fraction a
forall a.
(HasCallStack, MEuclidean a, Normed a, Ord a, Semiring a,
 UpperBoundless a) =>
a -> a -> Fraction a
unsafeFraction a
d a
n

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`

-- | @since 0.1
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"
    ]