{-|
    Module      :  Utils.Test.EnforceRange
    Description :  squash generated numbers to a given range
    Copyright   :  (c) Michal Konecny
    License     :  BSD3

    Maintainer  :  mikkonecny@gmail.com
    Stability   :  experimental
    Portability :  portable

    Utility for squashing randomly generated numbers to a given range.
-}
module Utils.Test.EnforceRange 
    (enforceRange, CanEnforceRange)
where

import Numeric.MixedTypes.PreludeHiding
-- import qualified Prelude as P

-- import Numeric.CollectErrors

import Numeric.MixedTypes.Literals
import Numeric.MixedTypes.Bool
-- import Numeric.MixedTypes.Eq
import Numeric.MixedTypes.Ord
import Numeric.MixedTypes.MinMaxAbs
import Numeric.MixedTypes.AddSub
import Numeric.MixedTypes.Mul
import Numeric.MixedTypes.Field
import Numeric.MixedTypes.Round

type CanEnforceRange t b =
    (CanAddSubMulDivBy t Integer
    , CanAddSameType t, CanSubSameType t, CanAbsSameType t
    , CanDivIModIntegerSameType t
    , ConvertibleExactly b t
    , HasOrderCertainly t t)

{-| 
    @enforceRange (Just l, Just u) a@ where @l < u@ returns an arbitrary value @b@ with @u < b < l@.
    Moreover, the returned values are distributed roughly evenly if the input values @a@ are distributed 
    roughly evenly in a large neighbourhood of the interval @[l,r]@.
    In most cases, when @l<a<u@, then @b=a@.
-}
enforceRange ::
    (CanEnforceRange t b) => (Maybe b, Maybe b) -> t -> t
enforceRange :: forall t b. CanEnforceRange t b => (Maybe b, Maybe b) -> t -> t
enforceRange (Just b
l_, Just b
u_) (t
a::t) 
    | forall t. CanNeg t => t -> NegType t
not (t
l forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<! t
u) = forall a. HasCallStack => [Char] -> a
error [Char]
"enforceRange: inconsistent range"
    | t
l forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<! t
a forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& t
a forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<! t
u = t
a
    | t
l forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<! AddType t (ModType t t)
b forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& AddType t (ModType t t)
b forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<! t
u = AddType t (ModType t t)
b
    | Bool
otherwise = (t
uforall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+t
l)forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/Integer
2
    where
    l :: t
l = forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly b
l_ :: t
    u :: t
u = forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly b
u_ :: t
    b :: AddType t (ModType t t)
b = t
l forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ ((forall t. CanAbs t => t -> AbsType t
abs t
a) forall t1 t2. CanDivIMod t1 t2 => t1 -> t2 -> ModType t1 t2
`mod` (t
uforall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
-t
l))
enforceRange (Just b
l_, Maybe b
_) (t
a::t)
    | t
l forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<! t
a = t
a
    | Bool
otherwise = (Integer
2forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
*t
lforall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
-t
aforall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+Integer
1)
    where
    l :: t
l = forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly b
l_ :: t
enforceRange (Maybe b
_, Just b
u_) (t
a::t)
    | t
a forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<! t
u = t
a
    | Bool
otherwise = (Integer
2forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
*t
uforall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
-t
aforall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
-Integer
1)
    where
    u :: t
u = forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly b
u_ :: t
enforceRange (Maybe b, Maybe b)
_ t
a = t
a