{-# OPTIONS_GHC -Wno-redundant-constraints #-}
module Numeric.Data.Fraction
(
Fraction ((:%:), (:%!)),
mkFraction,
mkFractionTH,
(%%),
Internal.unsafeFraction,
(Internal.%!),
Internal.numerator,
Internal.denominator,
Internal.reduce,
_MkFraction,
rmatching,
)
where
import Data.Bounds
( UpperBoundless,
)
import Language.Haskell.TH (Code, Q)
import Language.Haskell.TH.Syntax (Lift (liftTyped))
import Numeric.Data.Fraction.Internal (Fraction (UnsafeFraction, (:%!), (:%:)))
import Numeric.Data.Fraction.Internal qualified as Internal
import Numeric.Data.Internal.Utils (rmatching)
import Optics.Core
( ReversedPrism',
ReversibleOptic (re),
prism,
)
mkFractionTH ::
( Integral a,
Lift a,
UpperBoundless a
) =>
a ->
a ->
Code Q (Fraction a)
mkFractionTH :: forall a.
(Integral a, Lift a, UpperBoundless a) =>
a -> a -> Code Q (Fraction a)
mkFractionTH a
n = Code Q (Fraction a)
-> (Fraction a -> Code Q (Fraction a))
-> Maybe (Fraction a)
-> Code Q (Fraction a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Code Q (Fraction a)
forall a. HasCallStack => [Char] -> a
error [Char]
err) Fraction a -> Code Q (Fraction a)
forall t (m :: Type -> Type). (Lift t, Quote m) => t -> Code m t
forall (m :: Type -> Type).
Quote m =>
Fraction a -> Code m (Fraction a)
liftTyped (Maybe (Fraction a) -> Code Q (Fraction a))
-> (a -> Maybe (Fraction a)) -> a -> Code Q (Fraction a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> Maybe (Fraction a)
forall a.
(Integral a, UpperBoundless a) =>
a -> a -> Maybe (Fraction a)
mkFraction a
n
where
err :: [Char]
err = [Char] -> [Char]
Internal.errMsg [Char]
"mkFractionTH"
{-# INLINEABLE mkFractionTH #-}
mkFraction :: (Integral a, UpperBoundless a) => a -> a -> Maybe (Fraction a)
mkFraction :: forall a.
(Integral a, UpperBoundless a) =>
a -> a -> Maybe (Fraction a)
mkFraction a
_ a
0 = Maybe (Fraction a)
forall a. Maybe a
Nothing
mkFraction a
n a
d = Fraction a -> Maybe (Fraction a)
forall a. a -> Maybe a
Just (Fraction a -> Maybe (Fraction a))
-> Fraction a -> Maybe (Fraction a)
forall a b. (a -> b) -> a -> b
$ Fraction a -> Fraction a
forall a.
(Integral a, UpperBoundless a) =>
Fraction a -> Fraction a
Internal.reduce (a -> a -> Fraction a
forall a. a -> a -> Fraction a
UnsafeFraction a
n a
d)
{-# INLINEABLE mkFraction #-}
(%%) :: (Integral a, Lift a, UpperBoundless a) => a -> a -> Code Q (Fraction a)
a
n %% :: forall a.
(Integral a, Lift a, UpperBoundless a) =>
a -> a -> Code Q (Fraction a)
%% a
d = a -> a -> Code Q (Fraction a)
forall a.
(Integral a, Lift a, UpperBoundless a) =>
a -> a -> Code Q (Fraction a)
mkFractionTH a
n a
d
{-# INLINE (%%) #-}
infixl 7 %%
_MkFraction ::
( Integral a,
Ord a,
UpperBoundless a
) =>
ReversedPrism' (Fraction a) (a, a)
_MkFraction :: forall a.
(Integral a, Ord a, UpperBoundless a) =>
ReversedPrism' (Fraction a) (a, a)
_MkFraction = Optic A_Prism NoIx (a, a) (a, a) (Fraction a) (Fraction a)
-> Optic
(ReversedOptic A_Prism)
NoIx
(Fraction a)
(Fraction a)
(a, a)
(a, a)
forall (is :: IxList) s t a b.
AcceptsEmptyIndices "re" is =>
Optic A_Prism is s t a b
-> Optic (ReversedOptic A_Prism) is b a t s
forall k (is :: IxList) s t a b.
(ReversibleOptic k, AcceptsEmptyIndices "re" is) =>
Optic k is s t a b -> Optic (ReversedOptic k) is b a t s
re ((Fraction a -> (a, a))
-> ((a, a) -> Either (a, a) (Fraction a))
-> Optic A_Prism NoIx (a, a) (a, a) (Fraction a) (Fraction a)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (\(UnsafeFraction a
n a
d) -> (a
n, a
d)) (a, a) -> Either (a, a) (Fraction a)
forall {b}.
(Integral b, UpperBoundless b) =>
(b, b) -> Either (b, b) (Fraction b)
g)
where
g :: (b, b) -> Either (b, b) (Fraction b)
g (b, b)
x = case (b -> b -> Maybe (Fraction b)) -> (b, b) -> Maybe (Fraction b)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry b -> b -> Maybe (Fraction b)
forall a.
(Integral a, UpperBoundless a) =>
a -> a -> Maybe (Fraction a)
mkFraction (b, b)
x of
Maybe (Fraction b)
Nothing -> (b, b) -> Either (b, b) (Fraction b)
forall a b. a -> Either a b
Left (b, b)
x
Just Fraction b
x' -> Fraction b -> Either (b, b) (Fraction b)
forall a b. b -> Either a b
Right Fraction b
x'
{-# INLINEABLE _MkFraction #-}