module Numeric.Data.Interval
(
IntervalBound (..),
Interval (MkInterval),
Internal.mkInterval,
mkIntervalTH,
Internal.unsafeInterval,
reallyUnsafeInterval,
unInterval,
_MkInterval,
rmatching,
_Open,
_Closed,
_None,
)
where
import GHC.TypeNats (Nat)
import Language.Haskell.TH (Code, Q)
import Language.Haskell.TH.Syntax (Lift (liftTyped))
import Numeric.Data.Internal.Utils (rmatching)
import Numeric.Data.Interval.Internal
( Interval (MkInterval, UnsafeInterval),
IntervalBound (Closed, None, Open),
SingIntervalBound,
)
import Numeric.Data.Interval.Internal qualified as Internal
import Optics.Core (Prism', ReversedPrism', ReversibleOptic (re), prism)
unInterval :: Interval l r a -> a
unInterval :: forall (l :: IntervalBound) (r :: IntervalBound) a.
Interval l r a -> a
unInterval (UnsafeInterval a
x) = a
x
mkIntervalTH ::
forall l r a.
( Lift a,
Num a,
Ord a,
SingIntervalBound l,
SingIntervalBound r,
Show a
) =>
a ->
Code Q (Interval l r a)
mkIntervalTH :: forall (l :: IntervalBound) (r :: IntervalBound) a.
(Lift a, Num a, Ord a, SingIntervalBound l, SingIntervalBound r,
Show a) =>
a -> Code Q (Interval l r a)
mkIntervalTH a
x = Code Q (Interval l r a)
-> (Interval l r a -> Code Q (Interval l r a))
-> Maybe (Interval l r a)
-> Code Q (Interval l r a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Code Q (Interval l r a)
forall a. HasCallStack => [Char] -> a
error [Char]
msg) Interval l r a -> Code Q (Interval l r a)
forall t (m :: Type -> Type). (Lift t, Quote m) => t -> Code m t
forall (m :: Type -> Type).
Quote m =>
Interval l r a -> Code m (Interval l r a)
liftTyped (Maybe (Interval l r a) -> Code Q (Interval l r a))
-> Maybe (Interval l r a) -> Code Q (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)
Internal.mkInterval a
x
where
msg :: [Char]
msg = forall (l :: IntervalBound) (r :: IntervalBound) a.
(Show a, SingIntervalBound l, SingIntervalBound r) =>
a -> Builder -> [Char]
Internal.errMsg @l @r a
x Builder
"mkIntervalTH"
{-# INLINEABLE mkIntervalTH #-}
reallyUnsafeInterval :: a -> Interval l r a
reallyUnsafeInterval :: forall a (l :: IntervalBound) (r :: IntervalBound).
a -> Interval l r a
reallyUnsafeInterval = a -> Interval l r a
forall (l :: IntervalBound) (r :: IntervalBound) a.
a -> Interval l r a
UnsafeInterval
{-# INLINEABLE reallyUnsafeInterval #-}
_MkInterval ::
forall l r a.
( Num a,
Ord a,
SingIntervalBound l,
SingIntervalBound r
) =>
ReversedPrism' (Interval l r a) a
_MkInterval :: forall (l :: IntervalBound) (r :: IntervalBound) a.
(Num a, Ord a, SingIntervalBound l, SingIntervalBound r) =>
ReversedPrism' (Interval l r a) a
_MkInterval = Optic A_Prism NoIx a a (Interval l r a) (Interval l r a)
-> Optic
(ReversedOptic A_Prism) NoIx (Interval l r a) (Interval l r a) a a
forall (is :: IxList) s t a b.
AcceptsEmptyIndices "re" is =>
Optic A_Prism is s t a b
-> Optic (ReversedOptic A_Prism) is b a t s
forall k (is :: IxList) s t a b.
(ReversibleOptic k, AcceptsEmptyIndices "re" is) =>
Optic k is s t a b -> Optic (ReversedOptic k) is b a t s
re ((Interval l r a -> a)
-> (a -> Either a (Interval l r a))
-> Optic A_Prism NoIx a a (Interval l r a) (Interval l r a)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism Interval l r a -> a
forall (l :: IntervalBound) (r :: IntervalBound) a.
Interval l r a -> a
unInterval a -> Either a (Interval l r a)
forall {a} {l :: IntervalBound} {r :: IntervalBound}.
(Num a, Ord a, SingIntervalBound l, SingIntervalBound r) =>
a -> Either a (Interval l r a)
g)
where
g :: a -> Either a (Interval l r a)
g a
x = case 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)
Internal.mkInterval a
x of
Maybe (Interval l r a)
Nothing -> a -> Either a (Interval l r a)
forall a b. a -> Either a b
Left a
x
Just Interval l r a
x' -> Interval l r a -> Either a (Interval l r a)
forall a b. b -> Either a b
Right Interval l r a
x'
{-# INLINEABLE _MkInterval #-}
_Open :: Prism' IntervalBound Nat
_Open :: Prism' IntervalBound Nat
_Open = (Nat -> IntervalBound)
-> (IntervalBound -> Either IntervalBound Nat)
-> Prism' IntervalBound Nat
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism Nat -> IntervalBound
Open IntervalBound -> Either IntervalBound Nat
g
where
g :: IntervalBound -> Either IntervalBound Nat
g (Open Nat
x) = Nat -> Either IntervalBound Nat
forall a b. b -> Either a b
Right Nat
x
g IntervalBound
other = IntervalBound -> Either IntervalBound Nat
forall a b. a -> Either a b
Left IntervalBound
other
{-# INLINEABLE _Open #-}
_Closed :: Prism' IntervalBound Nat
_Closed :: Prism' IntervalBound Nat
_Closed = (Nat -> IntervalBound)
-> (IntervalBound -> Either IntervalBound Nat)
-> Prism' IntervalBound Nat
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism Nat -> IntervalBound
Closed IntervalBound -> Either IntervalBound Nat
g
where
g :: IntervalBound -> Either IntervalBound Nat
g (Closed Nat
x) = Nat -> Either IntervalBound Nat
forall a b. b -> Either a b
Right Nat
x
g IntervalBound
other = IntervalBound -> Either IntervalBound Nat
forall a b. a -> Either a b
Left IntervalBound
other
{-# INLINEABLE _Closed #-}
_None :: Prism' IntervalBound ()
_None :: Prism' IntervalBound ()
_None = (() -> IntervalBound)
-> (IntervalBound -> Either IntervalBound ())
-> Prism' IntervalBound ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (IntervalBound -> () -> IntervalBound
forall a b. a -> b -> a
const IntervalBound
None) IntervalBound -> Either IntervalBound ()
g
where
g :: IntervalBound -> Either IntervalBound ()
g IntervalBound
None = () -> Either IntervalBound ()
forall a b. b -> Either a b
Right ()
g IntervalBound
other = IntervalBound -> Either IntervalBound ()
forall a b. a -> Either a b
Left IntervalBound
other
{-# INLINEABLE _None #-}