{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Test.Cardano.Ledger.Core.Rational where

import Cardano.Ledger.BaseTypes (
  BoundedRational (..),
  NonNegativeInterval,
  PositiveInterval,
  PositiveUnitInterval,
  UnitInterval,
  boundRational,
 )
import Data.Maybe (fromMaybe)
import Data.Proxy (Proxy (..))
import qualified Data.Ratio
import Data.Typeable (Typeable, typeRep)
import GHC.Stack (HasCallStack)

unsafeBoundRational :: forall r. (HasCallStack, Typeable r, BoundedRational r) => Rational -> r
unsafeBoundRational :: forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational Rational
x = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
errMessage) forall a b. (a -> b) -> a -> b
$ forall r. BoundedRational r => Rational -> Maybe r
boundRational Rational
x
  where
    errMessage :: [Char]
errMessage = forall a. Show a => a -> [Char]
show (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy :: Proxy r)) forall a. Semigroup a => a -> a -> a
<> [Char]
" is out of bounds: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Rational
x

-- | polymorphic rationals that agree with the Show instances of UnitInterval
-- and friends.
class IsRatio r where
  (%!) :: HasCallStack => Integer -> Integer -> r
  default (%!) :: (HasCallStack, Typeable r, BoundedRational r) => Integer -> Integer -> r
  Integer
n %! Integer
d = forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational forall a b. (a -> b) -> a -> b
$ Integer
n forall a. Integral a => a -> a -> Ratio a
Data.Ratio.% Integer
d

instance IsRatio UnitInterval

instance IsRatio Rational where
  %! :: HasCallStack => Integer -> Integer -> Rational
(%!) = forall a. Integral a => a -> a -> Ratio a
(Data.Ratio.%)

instance IsRatio NonNegativeInterval

instance IsRatio PositiveInterval

instance IsRatio PositiveUnitInterval