module ParkBench.Internal.Prelude
  ( divide,
    divide',
    divideDouble,
    doubleToRational,
    r2d,
    w2d,
    w2r,
    module X,
  )
where

import Control.Monad as X (forever)
import Data.Coerce as X (coerce)
import Data.Foldable as X (fold, foldl')
import Data.Functor as X (($>))
import Data.Proxy as X (Proxy (..))
import Data.Text as X (Text)
import Data.Typeable as X (Typeable)
import Data.Word as X (Word64, Word8)
import GHC.Generics as X (Generic)
import Numeric.Natural as X (Natural)
import Prelude as X
  ( Applicative (..),
    Bool (..),
    Char,
    Double,
    Eq (..),
    FilePath,
    Foldable,
    Functor (..),
    IO,
    Int,
    Maybe (..),
    Monad (..),
    Monoid (..),
    Num (..),
    Ord (..),
    Ordering (..),
    Rational,
    Semigroup (..),
    Show (..),
    String,
    Traversable,
    all,
    error,
    floor,
    foldMap,
    fromIntegral,
    fromRational,
    length,
    map,
    max,
    maxBound,
    otherwise,
    realToFrac,
    replicate,
    sqrt,
    subtract,
    toRational,
    traverse,
    undefined,
    zip,
    zipWith,
    ($!),
    (++),
    (.),
    (/),
    (<$>),
    (||),
  )

divide :: Rational -> Rational -> Rational
divide :: Rational -> Rational -> Rational
divide Rational
n Rational
d =
  if Rational
d forall a. Eq a => a -> a -> Bool
== Rational
0 then Rational
0 else Rational
n forall a. Fractional a => a -> a -> a
/ Rational
d

divide' :: Rational -> Rational -> Maybe Rational
divide' :: Rational -> Rational -> Maybe Rational
divide' Rational
n Rational
d =
  if Rational
d forall a. Eq a => a -> a -> Bool
== Rational
0 then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just (Rational
n forall a. Fractional a => a -> a -> a
/ Rational
d)

divideDouble :: Double -> Double -> Double
divideDouble :: Double -> Double -> Double
divideDouble Double
x Double
y =
  if Double
y forall a. Eq a => a -> a -> Bool
== Double
0 then Double
0 else Double
x forall a. Fractional a => a -> a -> a
/ Double
y

doubleToRational :: Double -> Rational
doubleToRational :: Double -> Rational
doubleToRational = forall a b. (Real a, Fractional b) => a -> b
realToFrac

r2d :: Rational -> Double
r2d :: Rational -> Double
r2d = forall a b. (Real a, Fractional b) => a -> b
realToFrac

w2d :: Word64 -> Double
w2d :: Word64 -> Double
w2d = forall a b. (Integral a, Num b) => a -> b
fromIntegral

w2r :: Word64 -> Rational
w2r :: Word64 -> Rational
w2r = forall a b. (Integral a, Num b) => a -> b
fromIntegral