{-# 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,
    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,
  )

-- $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 -> 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,
      -- | @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
      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
    )

-- | @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,
    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 :%!

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

-- | @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 (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 (==) #-}

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

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

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

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

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

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

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

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

-- | @since 0.1
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 (.+.) #-}

-- | @since 0.1
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 (.+.) #-}

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

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

-- | @since 0.1
instance AGroup (Fraction Integer) where
  .-. :: Fraction Integer -> Fraction Integer -> Fraction Integer
(.-.) = (-)
  {-# INLINEABLE (.-.) #-}

-- | @since 0.1
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 (.*.) #-}

-- | @since 0.1
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 (.*.) #-}

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

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

-- | @since 0.1
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 (.%.) #-}

-- | @since 0.1
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 (.%.) #-}

-- | @since 0.1
instance Normed (Fraction Integer) where
  norm :: Fraction Integer -> Fraction Integer
norm = Fraction Integer -> Fraction Integer
forall a. Num a => a -> a
abs
  {-# INLINEABLE norm #-}

-- | @since 0.1
instance Normed (Fraction Natural) where
  norm :: Fraction Natural -> Fraction Natural
norm = Fraction Natural -> Fraction Natural
forall a. Num a => a -> a
abs
  {-# INLINEABLE norm #-}

-- | @since 0.1
instance Semiring (Fraction Integer)

-- | @since 0.1
instance Semiring (Fraction Natural)

-- | @since 0.1
instance Ring (Fraction Integer)

-- | @since 0.1
instance Semifield (Fraction Natural)

-- | @since 0.1
instance Semifield (Fraction Integer)

-- | @since 0.1
instance Field (Fraction Integer)

-- | @since 0.1
instance FromInteger (Fraction Integer) where
  afromInteger :: HasCallStack => Integer -> Fraction Integer
afromInteger = Integer -> Fraction Integer
forall a. Num a => Integer -> a
fromInteger
  {-# INLINEABLE afromInteger #-}

-- | __WARNING: Partial__
--
-- @since 0.1
instance FromInteger (Fraction Natural) where
  afromInteger :: HasCallStack => Integer -> Fraction Natural
afromInteger = Integer -> Fraction Natural
forall a. Num a => Integer -> a
fromInteger
  {-# INLINEABLE afromInteger #-}

-- | @since 0.1
instance FromRational (Fraction Integer) where
  afromRational :: HasCallStack => Rational -> Fraction Integer
afromRational = Rational -> Fraction Integer
forall a. Fractional a => Rational -> a
fromRational
  {-# INLINEABLE afromRational #-}

-- | __WARNING: Partial__
--
-- @since 0.1
instance FromRational (Fraction Natural) where
  afromRational :: HasCallStack => Rational -> Fraction Natural
afromRational = Rational -> Fraction Natural
forall a. Fractional a => Rational -> a
fromRational
  {-# INLINEABLE afromRational #-}

-- | @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,
    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 #-}

-- | Infix version of 'unsafeFraction'.
--
-- __WARNING: Partial__
--
-- ==== __Examples__
--
-- >>> 7 %! 2
-- UnsafeFraction 7 2
--
-- @since 0.1
(%!) ::
  ( 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 %!

-- | 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 :: (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`

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