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

    -- * Creation
    Internal.mkInterval,
    mkIntervalTH,
    Internal.unsafeInterval,
    reallyUnsafeInterval,

    -- * Elimination
    unInterval,

    -- * Bound aliases
    -- $bound-aliases
    O,
    C,
    N,

    -- * Optics
    -- $optics
    _MkInterval,
    rmatching,
    _Open,
    _Closed,
    _None,
  )
where

import Data.Singletons (SingI)
import GHC.TypeNats (Nat)
import Language.Haskell.TH (Code, Q)
import Language.Haskell.TH.Syntax (Lift (liftTyped))
import Numeric.Convert.Integer (FromInteger)
import Numeric.Data.Internal.Utils (rmatching)
import Numeric.Data.Interval.Internal
  ( Interval (MkInterval, UnsafeInterval),
    IntervalBound (Closed, None, Open),
  )
import Numeric.Data.Interval.Internal qualified as Internal
import Optics.Core (Prism', ReversedPrism', ReversibleOptic (re), prism)

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

-- | @since 0.1
unInterval :: Interval l r a -> a
unInterval :: forall (l :: IntervalBound) (r :: IntervalBound) a.
Interval l r a -> a
unInterval (UnsafeInterval a
x) = a
x

-- | Template haskell for creating an 'Interval' at compile-time.
--
-- ==== __Examples__
-- >>> $$(mkIntervalTH @None @(Closed 100) 7)
-- UnsafeInterval None (Closed 100) 7
--
-- @since 0.1
mkIntervalTH ::
  forall l r a.
  ( FromInteger a,
    Lift a,
    Ord a,
    SingI l,
    SingI r,
    Show a
  ) =>
  a ->
  Code Q (Interval l r a)
mkIntervalTH :: forall (l :: IntervalBound) (r :: IntervalBound) a.
(FromInteger a, Lift a, Ord a, SingI l, SingI 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.
(FromInteger a, Ord a, SingI l, SingI r) =>
a -> Maybe (Interval l r a)
Internal.mkInterval a
x
  where
    msg :: [Char]
msg = forall (l :: IntervalBound) (r :: IntervalBound) a.
(Show a, SingI l, SingI r) =>
a -> Builder -> [Char]
Internal.errMsg @l @r a
x Builder
"mkIntervalTH"
{-# INLINEABLE mkIntervalTH #-}

-- | This function is an alias for the unchecked constructor @UnsafeInterval@
-- i.e. it allows us to construct a 'Interval' __without__ checking
-- invariants. This is intended only for when we absolutely know the invariant
-- holds and a branch (i.e. 'Internal.unsafeInterval') is undesirable for
-- performance reasons. Exercise extreme caution.
--
-- @since 0.1
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 #-}

-- $bound-aliases
-- These aliases allow for writing interval types more concisely.
--
-- >>> Internal.unsafeInterval @(O 10) @(C 100) 50
-- UnsafeInterval (Open 10) (Closed 100) 50
--
-- >>> Internal.unsafeInterval @N @(C 100) 50
-- UnsafeInterval None (Closed 100) 50

-- | Alias for 'Open', for writing bounds more concisely.
type O :: Nat -> IntervalBound
type O n = Open n

-- | Alias for 'Closed', for writing bounds more concisely.
type C :: Nat -> IntervalBound
type C n = Closed n

-- | Alias for 'None', for writing bounds more concisely.
type N :: IntervalBound
type N = None

-- $optics
-- We provide a 'ReversedPrism'' '_MkInterval' that allows for total
-- elimination and partial construction, along with a 'Optics.Core.LabelOptic'
-- 'Optics.Core.Getter' for @#unInterval@.
--
-- ==== __Examples__
--
-- >>> :set -XOverloadedLabels
-- >>> import Optics.Core (view)
-- >>> let x = $$(mkIntervalTH @(Open 1) @(Open 5) 2)
-- >>> view #unInterval x
-- 2

-- | 'ReversedPrism'' that enables total elimination and partial construction.
--
-- ==== __Examples__
-- >>> import Optics.Core (view)
-- >>> x = $$(mkIntervalTH @(Open 1) @(Open 5) 2)
-- >>> view _MkInterval x
-- 2
--
-- >>> rmatching (_MkInterval @(Open 1) @(Open 5)) 3
-- Right (UnsafeInterval (Open 1) (Open 5) 3)
--
-- >>> rmatching (_MkInterval @(Open 1) @(Open 5)) 7
-- Left 7
--
-- @since 0.1
_MkInterval ::
  forall l r a.
  ( FromInteger a,
    Ord a,
    SingI l,
    SingI r
  ) =>
  ReversedPrism' (Interval l r a) a
_MkInterval :: forall (l :: IntervalBound) (r :: IntervalBound) a.
(FromInteger a, Ord a, SingI l, SingI 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}.
(FromInteger a, Ord a, SingI l, SingI 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.
(FromInteger a, Ord a, SingI l, SingI 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 #-}

-- | @since 0.1
_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
    ( \case
        Open Nat
x -> Nat -> Either IntervalBound Nat
forall a b. b -> Either a b
Right Nat
x
        IntervalBound
other -> IntervalBound -> Either IntervalBound Nat
forall a b. a -> Either a b
Left IntervalBound
other
    )
{-# INLINEABLE _Open #-}

-- | @since 0.1
_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
    ( \case
        Closed Nat
x -> Nat -> Either IntervalBound Nat
forall a b. b -> Either a b
Right Nat
x
        IntervalBound
other -> IntervalBound -> Either IntervalBound Nat
forall a b. a -> Either a b
Left IntervalBound
other
    )
{-# INLINEABLE _Closed #-}

-- | @since 0.1
_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)
    ( \case
        IntervalBound
None -> () -> Either IntervalBound ()
forall a b. b -> Either a b
Right ()
        IntervalBound
other -> IntervalBound -> Either IntervalBound ()
forall a b. a -> Either a b
Left IntervalBound
other
    )
{-# INLINEABLE _None #-}