{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- see NOTE: [TypeAbstractions default extensions]

#if __GLASGOW_HASKELL__ >= 908
{-# LANGUAGE TypeAbstractions #-}
#endif

-- | Provides types for enforcing minimum and maximum bounds.
--
-- @since 0.1
module Numeric.Data.Interval.Internal
  ( -- * Types
    IntervalBound (..),
    Interval (MkInterval, UnsafeInterval),

    -- * Creation
    mkInterval,
    unsafeInterval,

    -- * Singletons
    SIntervalBound (..),
    SingIntervalBound (..),
    withSingIntervalBound,

    -- * Misc
    errMsg,
  )
where

import Control.DeepSeq (NFData)
import Data.Kind (Constraint, Type)
import Data.Maybe qualified as Maybe
import Data.Proxy (Proxy (Proxy))
import Data.Text qualified as T
import Data.Text.Display (Display (displayBuilder))
import Data.Text.Lazy qualified as TL
import Data.Text.Lazy.Builder (Builder)
import Data.Text.Lazy.Builder qualified as TLB
import GHC.Generics (Generic)
import GHC.Records (HasField (getField))
import GHC.Show (showSpace)
import GHC.Stack (HasCallStack)
import GHC.TypeNats (KnownNat, Nat, natVal)
import Language.Haskell.TH.Syntax (Lift)
import Numeric.Literal.Integer (FromInteger (afromInteger))
import Numeric.Literal.Rational (FromRational (afromRational))
import Optics.Core (A_Getter, LabelOptic (labelOptic), to)

-- $setup
-- >>> :set -XTemplateHaskell

type IntervalBound :: Type

-- | Interval bound.
--
-- @since 0.1
data IntervalBound
  = -- | Open bound.
    Open Nat
  | -- | Closed bound.
    Closed Nat
  | -- | No bound.
    None
  deriving stock
    ( -- | @since 0.1
      IntervalBound -> IntervalBound -> Bool
(IntervalBound -> IntervalBound -> Bool)
-> (IntervalBound -> IntervalBound -> Bool) -> Eq IntervalBound
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IntervalBound -> IntervalBound -> Bool
== :: IntervalBound -> IntervalBound -> Bool
$c/= :: IntervalBound -> IntervalBound -> Bool
/= :: IntervalBound -> IntervalBound -> Bool
Eq,
      -- | @since 0.1
      (forall x. IntervalBound -> Rep IntervalBound x)
-> (forall x. Rep IntervalBound x -> IntervalBound)
-> Generic IntervalBound
forall x. Rep IntervalBound x -> IntervalBound
forall x. IntervalBound -> Rep IntervalBound x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IntervalBound -> Rep IntervalBound x
from :: forall x. IntervalBound -> Rep IntervalBound x
$cto :: forall x. Rep IntervalBound x -> IntervalBound
to :: forall x. Rep IntervalBound x -> IntervalBound
Generic,
      -- | @since 0.1
      (forall (m :: Type -> Type). Quote m => IntervalBound -> m Exp)
-> (forall (m :: Type -> Type).
    Quote m =>
    IntervalBound -> Code m IntervalBound)
-> Lift IntervalBound
forall t.
(forall (m :: Type -> Type). Quote m => t -> m Exp)
-> (forall (m :: Type -> Type). Quote m => t -> Code m t) -> Lift t
forall (m :: Type -> Type). Quote m => IntervalBound -> m Exp
forall (m :: Type -> Type).
Quote m =>
IntervalBound -> Code m IntervalBound
$clift :: forall (m :: Type -> Type). Quote m => IntervalBound -> m Exp
lift :: forall (m :: Type -> Type). Quote m => IntervalBound -> m Exp
$cliftTyped :: forall (m :: Type -> Type).
Quote m =>
IntervalBound -> Code m IntervalBound
liftTyped :: forall (m :: Type -> Type).
Quote m =>
IntervalBound -> Code m IntervalBound
Lift,
      -- | @since 0.1
      Eq IntervalBound
Eq IntervalBound =>
(IntervalBound -> IntervalBound -> Ordering)
-> (IntervalBound -> IntervalBound -> Bool)
-> (IntervalBound -> IntervalBound -> Bool)
-> (IntervalBound -> IntervalBound -> Bool)
-> (IntervalBound -> IntervalBound -> Bool)
-> (IntervalBound -> IntervalBound -> IntervalBound)
-> (IntervalBound -> IntervalBound -> IntervalBound)
-> Ord IntervalBound
IntervalBound -> IntervalBound -> Bool
IntervalBound -> IntervalBound -> Ordering
IntervalBound -> IntervalBound -> IntervalBound
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 :: IntervalBound -> IntervalBound -> Ordering
compare :: IntervalBound -> IntervalBound -> Ordering
$c< :: IntervalBound -> IntervalBound -> Bool
< :: IntervalBound -> IntervalBound -> Bool
$c<= :: IntervalBound -> IntervalBound -> Bool
<= :: IntervalBound -> IntervalBound -> Bool
$c> :: IntervalBound -> IntervalBound -> Bool
> :: IntervalBound -> IntervalBound -> Bool
$c>= :: IntervalBound -> IntervalBound -> Bool
>= :: IntervalBound -> IntervalBound -> Bool
$cmax :: IntervalBound -> IntervalBound -> IntervalBound
max :: IntervalBound -> IntervalBound -> IntervalBound
$cmin :: IntervalBound -> IntervalBound -> IntervalBound
min :: IntervalBound -> IntervalBound -> IntervalBound
Ord,
      -- | @since 0.1
      Int -> IntervalBound -> ShowS
[IntervalBound] -> ShowS
IntervalBound -> String
(Int -> IntervalBound -> ShowS)
-> (IntervalBound -> String)
-> ([IntervalBound] -> ShowS)
-> Show IntervalBound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IntervalBound -> ShowS
showsPrec :: Int -> IntervalBound -> ShowS
$cshow :: IntervalBound -> String
show :: IntervalBound -> String
$cshowList :: [IntervalBound] -> ShowS
showList :: [IntervalBound] -> ShowS
Show
    )
  deriving anyclass
    ( -- | @since 0.1
      IntervalBound -> ()
(IntervalBound -> ()) -> NFData IntervalBound
forall a. (a -> ()) -> NFData a
$crnf :: IntervalBound -> ()
rnf :: IntervalBound -> ()
NFData
    )

displayIntervalBounds :: IntervalBound -> IntervalBound -> Builder
displayIntervalBounds :: IntervalBound -> IntervalBound -> Builder
displayIntervalBounds IntervalBound
l IntervalBound
r =
  [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
    [ IntervalBound -> Builder
forall {a}. IsString a => IntervalBound -> a
bracketL IntervalBound
l,
      IntervalBound -> Builder
valL IntervalBound
l,
      Builder
", ",
      IntervalBound -> Builder
valR IntervalBound
r,
      IntervalBound -> Builder
forall {a}. IsString a => IntervalBound -> a
bracketR IntervalBound
r
    ]
  where
    valL :: IntervalBound -> Builder
valL (Open Nat
n) = Nat -> Builder
displayShow Nat
n
    valL (Closed Nat
n) = Nat -> Builder
displayShow Nat
n
    valL IntervalBound
None = Builder
"-\8734"

    valR :: IntervalBound -> Builder
valR (Open Nat
n) = Nat -> Builder
displayShow Nat
n
    valR (Closed Nat
n) = Nat -> Builder
displayShow Nat
n
    valR IntervalBound
None = Builder
"\8734"

    bracketL :: IntervalBound -> a
bracketL (Closed Nat
_) = a
"["
    bracketL IntervalBound
_ = a
"("

    bracketR :: IntervalBound -> a
bracketR (Closed Nat
_) = a
"]"
    bracketR IntervalBound
_ = a
")"

    displayShow :: Nat -> Builder
displayShow = String -> Builder
forall a. Display a => a -> Builder
displayBuilder (String -> Builder) -> (Nat -> String) -> Nat -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nat -> String
forall a. Show a => a -> String
show

type SIntervalBound :: IntervalBound -> Type

-- | Singleton for 'IntervalBound'.
--
-- @since 0.1
data SIntervalBound (i :: IntervalBound) where
  SOpen :: forall (n :: Nat). (KnownNat n) => SIntervalBound (Open n)
  SClosed :: forall (n :: Nat). (KnownNat n) => SIntervalBound (Closed n)
  SNone :: SIntervalBound None

-- | Singleton \"with\"-style convenience function. Allows us to run a
-- computation @SingIntervalBound i => r@ without explicitly pattern-matching
-- every time.
--
-- @since 0.1
withSingIntervalBound :: SIntervalBound i -> ((SingIntervalBound i) => r) -> r
withSingIntervalBound :: forall (i :: IntervalBound) r.
SIntervalBound i -> (SingIntervalBound i => r) -> r
withSingIntervalBound SIntervalBound i
i SingIntervalBound i => r
x = case SIntervalBound i
i of
  SIntervalBound i
SOpen -> r
SingIntervalBound i => r
x
  SIntervalBound i
SClosed -> r
SingIntervalBound i => r
x
  SIntervalBound i
SNone -> r
SingIntervalBound i => r
x
{-# INLINEABLE withSingIntervalBound #-}

type SingIntervalBound :: IntervalBound -> Constraint

-- | Class for retrieving the singleton witness from the 'IntervalBound'.
--
-- @since 0.1
class SingIntervalBound (s :: IntervalBound) where
  -- | Retrieves the singleton witness.
  --
  -- @since 0.1
  singIntervalBound :: SIntervalBound s

-- | @since 0.1
instance (KnownNat k) => SingIntervalBound (Open k) where
  singIntervalBound :: SIntervalBound ('Open k)
singIntervalBound = forall (k :: Nat). KnownNat k => SIntervalBound ('Open k)
SOpen @k

-- | @since 0.1
instance (KnownNat k) => SingIntervalBound (Closed k) where
  singIntervalBound :: SIntervalBound ('Closed k)
singIntervalBound = forall (k :: Nat). KnownNat k => SIntervalBound ('Closed k)
SClosed @k

-- | @since 0.1
instance SingIntervalBound None where
  singIntervalBound :: SIntervalBound 'None
singIntervalBound = SIntervalBound 'None
SNone

type Interval :: IntervalBound -> IntervalBound -> Type -> Type

-- | Represents an interval. Can be (open|closed) bounded (left|right).
--
-- ==== __Examples__
--
-- >>> import Data.Text.Display (display)
-- >>> import Data.Text qualified as T
-- >>> let x = unsafeInterval @(Open 10) @(Closed 100) 50
-- >>> putStrLn $ T.unpack $ display x
-- 50 ∈ (10, 100]
--
-- >>> let y = unsafeInterval @None @None (-2)
-- >>> putStrLn $ T.unpack $ display y
-- -2 ∈ (-∞, ∞)
--
-- @since 0.1
newtype Interval (l :: IntervalBound) (r :: IntervalBound) (a :: Type)
  = UnsafeInterval a
  deriving stock
    ( -- | @since 0.1
      Interval l r a -> Interval l r a -> Bool
(Interval l r a -> Interval l r a -> Bool)
-> (Interval l r a -> Interval l r a -> Bool)
-> Eq (Interval l r a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (l :: IntervalBound) (r :: IntervalBound) a.
Eq a =>
Interval l r a -> Interval l r a -> Bool
$c== :: forall (l :: IntervalBound) (r :: IntervalBound) a.
Eq a =>
Interval l r a -> Interval l r a -> Bool
== :: Interval l r a -> Interval l r a -> Bool
$c/= :: forall (l :: IntervalBound) (r :: IntervalBound) a.
Eq a =>
Interval l r a -> Interval l r a -> Bool
/= :: Interval l r a -> Interval l r a -> Bool
Eq,
      -- | @since 0.1
      (forall x. Interval l r a -> Rep (Interval l r a) x)
-> (forall x. Rep (Interval l r a) x -> Interval l r a)
-> Generic (Interval l r a)
forall x. Rep (Interval l r a) x -> Interval l r a
forall x. Interval l r a -> Rep (Interval l r a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (l :: IntervalBound) (r :: IntervalBound) a x.
Rep (Interval l r a) x -> Interval l r a
forall (l :: IntervalBound) (r :: IntervalBound) a x.
Interval l r a -> Rep (Interval l r a) x
$cfrom :: forall (l :: IntervalBound) (r :: IntervalBound) a x.
Interval l r a -> Rep (Interval l r a) x
from :: forall x. Interval l r a -> Rep (Interval l r a) x
$cto :: forall (l :: IntervalBound) (r :: IntervalBound) a x.
Rep (Interval l r a) x -> Interval l r a
to :: forall x. Rep (Interval l r a) x -> Interval l r a
Generic,
      -- | @since 0.1
      (forall (m :: Type -> Type). Quote m => Interval l r a -> m Exp)
-> (forall (m :: Type -> Type).
    Quote m =>
    Interval l r a -> Code m (Interval l r a))
-> Lift (Interval l r a)
forall t.
(forall (m :: Type -> Type). Quote m => t -> m Exp)
-> (forall (m :: Type -> Type). Quote m => t -> Code m t) -> Lift t
forall (l :: IntervalBound) (r :: IntervalBound) a
       (m :: Type -> Type).
(Lift a, Quote m) =>
Interval l r a -> m Exp
forall (l :: IntervalBound) (r :: IntervalBound) a
       (m :: Type -> Type).
(Lift a, Quote m) =>
Interval l r a -> Code m (Interval l r a)
forall (m :: Type -> Type). Quote m => Interval l r a -> m Exp
forall (m :: Type -> Type).
Quote m =>
Interval l r a -> Code m (Interval l r a)
$clift :: forall (l :: IntervalBound) (r :: IntervalBound) a
       (m :: Type -> Type).
(Lift a, Quote m) =>
Interval l r a -> m Exp
lift :: forall (m :: Type -> Type). Quote m => Interval l r a -> m Exp
$cliftTyped :: forall (l :: IntervalBound) (r :: IntervalBound) a
       (m :: Type -> Type).
(Lift a, Quote m) =>
Interval l r a -> Code m (Interval l r a)
liftTyped :: forall (m :: Type -> Type).
Quote m =>
Interval l r a -> Code m (Interval l r a)
Lift,
      -- | @since 0.1
      Eq (Interval l r a)
Eq (Interval l r a) =>
(Interval l r a -> Interval l r a -> Ordering)
-> (Interval l r a -> Interval l r a -> Bool)
-> (Interval l r a -> Interval l r a -> Bool)
-> (Interval l r a -> Interval l r a -> Bool)
-> (Interval l r a -> Interval l r a -> Bool)
-> (Interval l r a -> Interval l r a -> Interval l r a)
-> (Interval l r a -> Interval l r a -> Interval l r a)
-> Ord (Interval l r a)
Interval l r a -> Interval l r a -> Bool
Interval l r a -> Interval l r a -> Ordering
Interval l r a -> Interval l r a -> Interval l r a
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
forall (l :: IntervalBound) (r :: IntervalBound) a.
Ord a =>
Eq (Interval l r a)
forall (l :: IntervalBound) (r :: IntervalBound) a.
Ord a =>
Interval l r a -> Interval l r a -> Bool
forall (l :: IntervalBound) (r :: IntervalBound) a.
Ord a =>
Interval l r a -> Interval l r a -> Ordering
forall (l :: IntervalBound) (r :: IntervalBound) a.
Ord a =>
Interval l r a -> Interval l r a -> Interval l r a
$ccompare :: forall (l :: IntervalBound) (r :: IntervalBound) a.
Ord a =>
Interval l r a -> Interval l r a -> Ordering
compare :: Interval l r a -> Interval l r a -> Ordering
$c< :: forall (l :: IntervalBound) (r :: IntervalBound) a.
Ord a =>
Interval l r a -> Interval l r a -> Bool
< :: Interval l r a -> Interval l r a -> Bool
$c<= :: forall (l :: IntervalBound) (r :: IntervalBound) a.
Ord a =>
Interval l r a -> Interval l r a -> Bool
<= :: Interval l r a -> Interval l r a -> Bool
$c> :: forall (l :: IntervalBound) (r :: IntervalBound) a.
Ord a =>
Interval l r a -> Interval l r a -> Bool
> :: Interval l r a -> Interval l r a -> Bool
$c>= :: forall (l :: IntervalBound) (r :: IntervalBound) a.
Ord a =>
Interval l r a -> Interval l r a -> Bool
>= :: Interval l r a -> Interval l r a -> Bool
$cmax :: forall (l :: IntervalBound) (r :: IntervalBound) a.
Ord a =>
Interval l r a -> Interval l r a -> Interval l r a
max :: Interval l r a -> Interval l r a -> Interval l r a
$cmin :: forall (l :: IntervalBound) (r :: IntervalBound) a.
Ord a =>
Interval l r a -> Interval l r a -> Interval l r a
min :: Interval l r a -> Interval l r a -> Interval l r a
Ord
    )
  deriving anyclass
    ( -- | @since 0.1
      Interval l r a -> ()
(Interval l r a -> ()) -> NFData (Interval l r a)
forall a. (a -> ()) -> NFData a
forall (l :: IntervalBound) (r :: IntervalBound) a.
NFData a =>
Interval l r a -> ()
$crnf :: forall (l :: IntervalBound) (r :: IntervalBound) a.
NFData a =>
Interval l r a -> ()
rnf :: Interval l r a -> ()
NFData
    )

-- | @since 0.1
instance HasField "unInterval" (Interval l r a) a where
  getField :: Interval l r a -> a
getField (UnsafeInterval a
x) = a
x

-- | @since 0.1
instance
  ( k ~ A_Getter,
    a ~ n,
    b ~ n
  ) =>
  LabelOptic "unInterval" k (Interval l r a) (Interval l r a) a b
  where
  labelOptic :: Optic k NoIx (Interval l r a) (Interval l r a) a b
labelOptic = (Interval l r a -> a) -> Getter (Interval l r a) a
forall s a. (s -> a) -> Getter s a
to (\(UnsafeInterval a
x) -> a
x)
  {-# INLINE labelOptic #-}

-- | @since 0.1
instance
  ( Show a,
    SingIntervalBound l,
    SingIntervalBound r
  ) =>
  Show (Interval l r a)
  where
  showsPrec :: Int -> Interval l r a -> ShowS
showsPrec Int
i (UnsafeInterval a
x) =
    Bool -> ShowS -> ShowS
showParen
      (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
      ( String -> ShowS
showString String
"UnsafeInterval "
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IntervalBound -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 IntervalBound
left
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
showSpace
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IntervalBound -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 IntervalBound
right
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
showSpace
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
x
      )
    where
      (IntervalBound
left, IntervalBound
right) = forall (l :: IntervalBound) (r :: IntervalBound).
(SingIntervalBound l, SingIntervalBound r) =>
(IntervalBound, IntervalBound)
getInterval @l @r

-- | @since 0.1
instance
  ( Show a,
    SingIntervalBound l,
    SingIntervalBound r
  ) =>
  Display (Interval l r a)
  where
  displayBuilder :: Interval l r a -> Builder
displayBuilder (UnsafeInterval a
x) =
    [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Builder
forall a. Display a => a -> Builder
displayBuilder (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
x,
        Builder
" ∈ ",
        IntervalBound -> IntervalBound -> Builder
displayIntervalBounds IntervalBound
left IntervalBound
right
      ]
    where
      (IntervalBound
left, IntervalBound
right) = forall (l :: IntervalBound) (r :: IntervalBound).
(SingIntervalBound l, SingIntervalBound r) =>
(IntervalBound, IntervalBound)
getInterval @l @r

-- | __WARNING: Partial__
--
-- @since 0.1
instance
  ( Num a,
    Ord a,
    SingIntervalBound l,
    SingIntervalBound r,
    Show a
  ) =>
  FromInteger (Interval l r a)
  where
  afromInteger :: HasCallStack => Integer -> Interval l r a
afromInteger = a -> Interval l r a
forall (l :: IntervalBound) (r :: IntervalBound) a.
(HasCallStack, Num a, Ord a, SingIntervalBound l,
 SingIntervalBound r, Show a) =>
a -> Interval l r a
unsafeInterval (a -> Interval l r a)
-> (Integer -> a) -> Integer -> Interval l r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. Num a => Integer -> a
fromInteger
  {-# INLINEABLE afromInteger #-}

-- | __WARNING: Partial__
--
-- @since 0.1
instance
  ( Fractional a,
    Ord a,
    SingIntervalBound l,
    SingIntervalBound r,
    Show a
  ) =>
  FromRational (Interval l r a)
  where
  afromRational :: HasCallStack => Rational -> Interval l r a
afromRational = a -> Interval l r a
forall (l :: IntervalBound) (r :: IntervalBound) a.
(HasCallStack, Num a, Ord a, SingIntervalBound l,
 SingIntervalBound r, Show a) =>
a -> Interval l r a
unsafeInterval (a -> Interval l r a)
-> (Rational -> a) -> Rational -> Interval l r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> a
forall a. Fractional a => Rational -> a
fromRational
  {-# INLINEABLE afromRational #-}

pattern MkInterval :: a -> Interval l r a
pattern $mMkInterval :: forall {r} {a} {l :: IntervalBound} {r :: IntervalBound}.
Interval l r a -> (a -> r) -> ((# #) -> r) -> r
MkInterval x <- UnsafeInterval x

{-# COMPLETE MkInterval #-}

-- | Smart constructor for 'Interval'. Returns 'Nothing' if the given value
-- is not within the bounds. Note that we do not check that the bounds fit
-- within the type itself (e.g. consider @Interval @None @(Closed 200) Int8@).
--
-- ==== __Examples__
-- >>> mkInterval @(Open 10) @(Closed 100) 50
-- Just (UnsafeInterval (Open 10) (Closed 100) 50)
--
-- >>> mkInterval @(Open 10) @(Closed 100) 100
-- Just (UnsafeInterval (Open 10) (Closed 100) 100)
--
-- >>> mkInterval @(Open 10) @(Closed 100) 10
-- Nothing
--
-- >>> mkInterval @(Open 10) @(Closed 100) 101
-- Nothing
--
-- @since 0.1
mkInterval ::
  forall l r a.
  ( Num a,
    Ord a,
    SingIntervalBound l,
    SingIntervalBound r
  ) =>
  a ->
  Maybe (Interval l r a)
mkInterval :: forall (l :: IntervalBound) (r :: IntervalBound) a.
(Num a, Ord a, SingIntervalBound l, SingIntervalBound r) =>
a -> Maybe (Interval l r a)
mkInterval a
x
  | Bool
boundedLeft Bool -> Bool -> Bool
&& Bool
boundedRight = Interval l r a -> Maybe (Interval l r a)
forall a. a -> Maybe a
Just (a -> Interval l r a
forall (l :: IntervalBound) (r :: IntervalBound) a.
a -> Interval l r a
UnsafeInterval a
x)
  | Bool
otherwise = Maybe (Interval l r a)
forall a. Maybe a
Nothing
  where
    boundedLeft :: Bool
    boundedLeft :: Bool
boundedLeft = case forall (s :: IntervalBound).
SingIntervalBound s =>
SIntervalBound s
singIntervalBound @l of
      SIntervalBound l
SNone -> Bool
True
      (SOpen @k) ->
        let l' :: Nat
l' = forall (n :: Nat) (proxy :: Nat -> Type).
KnownNat n =>
proxy n -> Nat
natVal @k Proxy n
forall {k} (t :: k). Proxy t
Proxy
         in a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> Nat -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Nat
l'
      (SClosed @k) ->
        let l' :: Nat
l' = forall (n :: Nat) (proxy :: Nat -> Type).
KnownNat n =>
proxy n -> Nat
natVal @k Proxy n
forall {k} (t :: k). Proxy t
Proxy
         in a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= Nat -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Nat
l'

    boundedRight :: Bool
    boundedRight :: Bool
boundedRight = case forall (s :: IntervalBound).
SingIntervalBound s =>
SIntervalBound s
singIntervalBound @r of
      SIntervalBound r
SNone -> Bool
True
      (SOpen @k) ->
        let r' :: Nat
r' = forall (n :: Nat) (proxy :: Nat -> Type).
KnownNat n =>
proxy n -> Nat
natVal @k Proxy n
forall {k} (t :: k). Proxy t
Proxy
         in a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< Nat -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Nat
r'
      (SClosed @k) ->
        let r' :: Nat
r' = forall (n :: Nat) (proxy :: Nat -> Type).
KnownNat n =>
proxy n -> Nat
natVal @k Proxy n
forall {k} (t :: k). Proxy t
Proxy
         in a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= Nat -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Nat
r'
{-# INLINEABLE mkInterval #-}

-- | Variant of 'mkInterval' that throws an error when given a value out of bounds.
--
-- __WARNING: Partial__
--
-- ==== __Examples__
-- >>> unsafeInterval @(Open 10) @(Closed 100) 50
-- UnsafeInterval (Open 10) (Closed 100) 50
--
-- @since 0.1
unsafeInterval ::
  forall l r a.
  ( HasCallStack,
    Num a,
    Ord a,
    SingIntervalBound l,
    SingIntervalBound r,
    Show a
  ) =>
  a ->
  Interval l r a
unsafeInterval :: forall (l :: IntervalBound) (r :: IntervalBound) a.
(HasCallStack, Num a, Ord a, SingIntervalBound l,
 SingIntervalBound r, Show a) =>
a -> Interval l r a
unsafeInterval a
x = Interval l r a -> Maybe (Interval l r a) -> Interval l r a
forall a. a -> Maybe a -> a
Maybe.fromMaybe (String -> Interval l r a
forall a. HasCallStack => String -> a
error String
msg) (Maybe (Interval l r a) -> Interval l r a)
-> Maybe (Interval l r a) -> Interval l r a
forall a b. (a -> b) -> a -> b
$ a -> Maybe (Interval l r a)
forall (l :: IntervalBound) (r :: IntervalBound) a.
(Num a, Ord a, SingIntervalBound l, SingIntervalBound r) =>
a -> Maybe (Interval l r a)
mkInterval a
x
  where
    msg :: String
msg = forall (l :: IntervalBound) (r :: IntervalBound) a.
(Show a, SingIntervalBound l, SingIntervalBound r) =>
a -> Builder -> String
errMsg @l @r a
x Builder
"unsafeInterval"
{-# INLINEABLE unsafeInterval #-}

-- | @since 0.1
errMsg ::
  forall l r a.
  ( Show a,
    SingIntervalBound l,
    SingIntervalBound r
  ) =>
  a ->
  Builder ->
  String
errMsg :: forall (l :: IntervalBound) (r :: IntervalBound) a.
(Show a, SingIntervalBound l, SingIntervalBound r) =>
a -> Builder -> String
errMsg a
x Builder
fnName =
  Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
    LazyText -> Text
TL.toStrict (LazyText -> Text) -> LazyText -> Text
forall a b. (a -> b) -> a -> b
$
      Builder -> LazyText
TLB.toLazyText Builder
msg
  where
    intervalStr :: Builder
intervalStr = IntervalBound -> IntervalBound -> Builder
displayIntervalBounds IntervalBound
left IntervalBound
right
    (IntervalBound
left, IntervalBound
right) = forall (l :: IntervalBound) (r :: IntervalBound).
(SingIntervalBound l, SingIntervalBound r) =>
(IntervalBound, IntervalBound)
getInterval @l @r
    msg :: Builder
msg =
      [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
        [ Builder
"Numeric.Data.Interval.",
          Builder
fnName,
          Builder
": Wanted value in ",
          Builder
intervalStr,
          Builder
", received: ",
          String -> Builder
forall a. Display a => a -> Builder
displayBuilder (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
x
        ]

getInterval ::
  forall l r.
  ( SingIntervalBound l,
    SingIntervalBound r
  ) =>
  (IntervalBound, IntervalBound)
getInterval :: forall (l :: IntervalBound) (r :: IntervalBound).
(SingIntervalBound l, SingIntervalBound r) =>
(IntervalBound, IntervalBound)
getInterval = (SIntervalBound l -> IntervalBound
forall (i :: IntervalBound). SIntervalBound i -> IntervalBound
fromSingleton SIntervalBound l
left, SIntervalBound r -> IntervalBound
forall (i :: IntervalBound). SIntervalBound i -> IntervalBound
fromSingleton SIntervalBound r
right)
  where
    left :: SIntervalBound l
left = forall (s :: IntervalBound).
SingIntervalBound s =>
SIntervalBound s
singIntervalBound @l
    right :: SIntervalBound r
right = forall (s :: IntervalBound).
SingIntervalBound s =>
SIntervalBound s
singIntervalBound @r

fromSingleton :: SIntervalBound i -> IntervalBound
fromSingleton :: forall (i :: IntervalBound). SIntervalBound i -> IntervalBound
fromSingleton SIntervalBound i
SNone = IntervalBound
None
fromSingleton (SOpen @n) = Nat -> IntervalBound
Open (forall (n :: Nat) (proxy :: Nat -> Type).
KnownNat n =>
proxy n -> Nat
natVal @n Proxy n
forall {k} (t :: k). Proxy t
Proxy)
fromSingleton (SClosed @n) = Nat -> IntervalBound
Closed (forall (n :: Nat) (proxy :: Nat -> Type).
KnownNat n =>
proxy n -> Nat
natVal @n Proxy n
forall {k} (t :: k). Proxy t
Proxy)