-- | Proper fractions
--
-- Intended for qualified import.
--
-- > import Data.Falsify.ProperFraction (ProperFraction(..))
-- > import qualified Data.Falsify.ProperFraction as ProperFraction
module Data.Falsify.ProperFraction (
    ProperFraction(ProperFraction)
    -- * Use
  , scaleIntegral
  , scaleFractional
  ) where

import Prelude hiding (properFraction)

import GHC.Show
import GHC.Stack

{-------------------------------------------------------------------------------
  Definition
-------------------------------------------------------------------------------}

-- | Value @x@ such that @0 <= x < 1@
newtype ProperFraction = UnsafeProperFraction { ProperFraction -> Double
getProperFraction :: Double }
  deriving stock (ProperFraction -> ProperFraction -> Bool
(ProperFraction -> ProperFraction -> Bool)
-> (ProperFraction -> ProperFraction -> Bool) -> Eq ProperFraction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProperFraction -> ProperFraction -> Bool
== :: ProperFraction -> ProperFraction -> Bool
$c/= :: ProperFraction -> ProperFraction -> Bool
/= :: ProperFraction -> ProperFraction -> Bool
Eq, Eq ProperFraction
Eq ProperFraction =>
(ProperFraction -> ProperFraction -> Ordering)
-> (ProperFraction -> ProperFraction -> Bool)
-> (ProperFraction -> ProperFraction -> Bool)
-> (ProperFraction -> ProperFraction -> Bool)
-> (ProperFraction -> ProperFraction -> Bool)
-> (ProperFraction -> ProperFraction -> ProperFraction)
-> (ProperFraction -> ProperFraction -> ProperFraction)
-> Ord ProperFraction
ProperFraction -> ProperFraction -> Bool
ProperFraction -> ProperFraction -> Ordering
ProperFraction -> ProperFraction -> ProperFraction
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ProperFraction -> ProperFraction -> Ordering
compare :: ProperFraction -> ProperFraction -> Ordering
$c< :: ProperFraction -> ProperFraction -> Bool
< :: ProperFraction -> ProperFraction -> Bool
$c<= :: ProperFraction -> ProperFraction -> Bool
<= :: ProperFraction -> ProperFraction -> Bool
$c> :: ProperFraction -> ProperFraction -> Bool
> :: ProperFraction -> ProperFraction -> Bool
$c>= :: ProperFraction -> ProperFraction -> Bool
>= :: ProperFraction -> ProperFraction -> Bool
$cmax :: ProperFraction -> ProperFraction -> ProperFraction
max :: ProperFraction -> ProperFraction -> ProperFraction
$cmin :: ProperFraction -> ProperFraction -> ProperFraction
min :: ProperFraction -> ProperFraction -> ProperFraction
Ord)
  deriving newtype (Integer -> ProperFraction
ProperFraction -> ProperFraction
ProperFraction -> ProperFraction -> ProperFraction
(ProperFraction -> ProperFraction -> ProperFraction)
-> (ProperFraction -> ProperFraction -> ProperFraction)
-> (ProperFraction -> ProperFraction -> ProperFraction)
-> (ProperFraction -> ProperFraction)
-> (ProperFraction -> ProperFraction)
-> (ProperFraction -> ProperFraction)
-> (Integer -> ProperFraction)
-> Num ProperFraction
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ProperFraction -> ProperFraction -> ProperFraction
+ :: ProperFraction -> ProperFraction -> ProperFraction
$c- :: ProperFraction -> ProperFraction -> ProperFraction
- :: ProperFraction -> ProperFraction -> ProperFraction
$c* :: ProperFraction -> ProperFraction -> ProperFraction
* :: ProperFraction -> ProperFraction -> ProperFraction
$cnegate :: ProperFraction -> ProperFraction
negate :: ProperFraction -> ProperFraction
$cabs :: ProperFraction -> ProperFraction
abs :: ProperFraction -> ProperFraction
$csignum :: ProperFraction -> ProperFraction
signum :: ProperFraction -> ProperFraction
$cfromInteger :: Integer -> ProperFraction
fromInteger :: Integer -> ProperFraction
Num, Num ProperFraction
Num ProperFraction =>
(ProperFraction -> ProperFraction -> ProperFraction)
-> (ProperFraction -> ProperFraction)
-> (Rational -> ProperFraction)
-> Fractional ProperFraction
Rational -> ProperFraction
ProperFraction -> ProperFraction
ProperFraction -> ProperFraction -> ProperFraction
forall a.
Num a =>
(a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
$c/ :: ProperFraction -> ProperFraction -> ProperFraction
/ :: ProperFraction -> ProperFraction -> ProperFraction
$crecip :: ProperFraction -> ProperFraction
recip :: ProperFraction -> ProperFraction
$cfromRational :: Rational -> ProperFraction
fromRational :: Rational -> ProperFraction
Fractional)

-- | Show instance relies on the v'ProperFraction' pattern synonym
instance Show ProperFraction where
  showsPrec :: Int -> ProperFraction -> ShowS
showsPrec Int
p (UnsafeProperFraction Double
f) = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
appPrec1) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
        String -> ShowS
showString String
"ProperFraction "
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
appPrec1 Double
f

mkProperFraction :: HasCallStack => Double -> ProperFraction
mkProperFraction :: HasCallStack => Double -> ProperFraction
mkProperFraction Double
f
  | Double
0 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
f Bool -> Bool -> Bool
&& Double
f Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1 = Double -> ProperFraction
UnsafeProperFraction Double
f
  | Bool
otherwise = String -> ProperFraction
forall a. HasCallStack => String -> a
error (String -> ProperFraction) -> String -> ProperFraction
forall a b. (a -> b) -> a -> b
$ String
"mkProperFraction: not a proper fraction: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
f

pattern ProperFraction :: Double -> ProperFraction
pattern $mProperFraction :: forall {r}. ProperFraction -> (Double -> r) -> ((# #) -> r) -> r
$bProperFraction :: Double -> ProperFraction
ProperFraction f <- (getProperFraction -> f)
  where
    ProperFraction = HasCallStack => Double -> ProperFraction
Double -> ProperFraction
mkProperFraction

{-# COMPLETE ProperFraction #-}

{-------------------------------------------------------------------------------
  Use
-------------------------------------------------------------------------------}

scaleIntegral :: Integral a => a -> ProperFraction -> a
scaleIntegral :: forall a. Integral a => a -> ProperFraction -> a
scaleIntegral a
x (ProperFraction Double
f) = Double -> a
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> a) -> Double -> a
forall a b. (a -> b) -> a -> b
$ a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
f

scaleFractional :: Fractional a => a -> ProperFraction -> a
scaleFractional :: forall a. Fractional a => a -> ProperFraction -> a
scaleFractional a
x (ProperFraction Double
f) = a
x a -> a -> a
forall a. Num a => a -> a -> a
* Double -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
f