-- | 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.Bifunctor (Bifunctor (first))
import Data.Singletons (SingI)
import GHC.TypeNats (Nat)
import Language.Haskell.TH (Code, Q)
import Language.Haskell.TH.Syntax (Lift)
import Numeric.Convert.Integer (FromInteger)
import Numeric.Data.Internal.Utils (rmatching)
import Numeric.Data.Internal.Utils qualified as Utils
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 = Either String (Interval l r a) -> Code Q (Interval l r a)
forall a. Lift a => Either String a -> Code Q a
Utils.liftErrorTH (Either String (Interval l r a) -> Code Q (Interval l r a))
-> (a -> Either String (Interval l r a))
-> a
-> Code Q (Interval l r a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either String (Interval l r a)
forall (l :: IntervalBound) (r :: IntervalBound) a.
(FromInteger a, Ord a, Show a, SingI l, SingI r) =>
a -> Either String (Interval l r a)
Internal.mkInterval
{-# 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,
    Show a,
    SingI l,
    SingI r
  ) =>
  ReversedPrism' (Interval l r a) a
_MkInterval :: forall (l :: IntervalBound) (r :: IntervalBound) a.
(FromInteger a, Ord a, Show 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 {b} {l :: IntervalBound} {r :: IntervalBound}.
(FromInteger b, Ord b, Show b, SingI l, SingI r) =>
b -> Either b (Interval l r b)
g)
  where
    g :: b -> Either b (Interval l r b)
g b
x = (String -> b)
-> Either String (Interval l r b) -> Either b (Interval l r b)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: Type -> Type -> Type) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (b -> String -> b
forall a b. a -> b -> a
const b
x) (Either String (Interval l r b) -> Either b (Interval l r b))
-> (b -> Either String (Interval l r b))
-> b
-> Either b (Interval l r b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either String (Interval l r b)
forall (l :: IntervalBound) (r :: IntervalBound) a.
(FromInteger a, Ord a, Show a, SingI l, SingI r) =>
a -> Either String (Interval l r a)
Internal.mkInterval (b -> Either b (Interval l r b)) -> b -> Either b (Interval l r b)
forall a b. (a -> b) -> a -> b
$ b
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 #-}