{-# LANGUAGE CPP #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Provides the 'TimeSpec' type and algebra re-exports.
--
-- @since 0.1
module Effectful.Time.TimeSpec
  ( -- * Type
    TimeSpec (..),

    -- * Creation
    fromSeconds,
    fromNanoSeconds,

    -- * Elimination
    toSeconds,
    toNanoSeconds,

    -- * Operations
    diffTimeSpec,
    normalizeTimeSpec,

    -- * Algebra
    ASemigroup (..),
    AMonoid (..),
    MSemiSpace (..),
    MSpace (..),
    Semimodule,
    SemivectorSpace,
    Normed (..),
    LowerBounded (..),
    UpperBoundless,
  )
where

import Control.DeepSeq (NFData)
import Data.Bounds (LowerBounded (lowerBound), UpperBoundless)
#if MIN_VERSION_base(4,17,0)
import GHC.Float (properFractionDouble)
#endif
import GHC.Generics (Generic)
import GHC.Natural (Natural)
import Numeric.Algebra
  ( AMonoid (zero),
    ASemigroup ((.+.)),
    Demimodule,
    Hemimodule,
    MSemiSpace ((.*)),
    MSpace ((.%)),
    Normed (norm, sgn),
    PseudoSemivectorSpace,
    Quartamodule,
    Semimodule,
    SemivectorSpace,
  )
import Optics.Core (A_Lens, LabelOptic (labelOptic), lensVL)

-- | Structure for holding time data. 'Eq' and 'Ord' are defined in terms of
-- an equivalence class e.g.
--
-- @
-- MkTimeSpec s n === MkTimeSpec 0 (s * 1_000_000_000 + n)
-- @
--
-- @since 0.1
data TimeSpec = MkTimeSpec
  { -- | Seconds.
    --
    -- @since 0.1
    TimeSpec -> Natural
sec :: !Natural,
    -- | Nanoseconds.
    --
    -- @since 0.1
    TimeSpec -> Natural
nsec :: !Natural
  }
  deriving stock
    ( -- | @since 0.1
      (forall x. TimeSpec -> Rep TimeSpec x)
-> (forall x. Rep TimeSpec x -> TimeSpec) -> Generic TimeSpec
forall x. Rep TimeSpec x -> TimeSpec
forall x. TimeSpec -> Rep TimeSpec x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TimeSpec -> Rep TimeSpec x
from :: forall x. TimeSpec -> Rep TimeSpec x
$cto :: forall x. Rep TimeSpec x -> TimeSpec
to :: forall x. Rep TimeSpec x -> TimeSpec
Generic,
      -- | @since 0.1
      Int -> TimeSpec -> ShowS
[TimeSpec] -> ShowS
TimeSpec -> String
(Int -> TimeSpec -> ShowS)
-> (TimeSpec -> String) -> ([TimeSpec] -> ShowS) -> Show TimeSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TimeSpec -> ShowS
showsPrec :: Int -> TimeSpec -> ShowS
$cshow :: TimeSpec -> String
show :: TimeSpec -> String
$cshowList :: [TimeSpec] -> ShowS
showList :: [TimeSpec] -> ShowS
Show
    )
  deriving anyclass
    ( -- | @since 0.1
      TimeSpec -> ()
(TimeSpec -> ()) -> NFData TimeSpec
forall a. (a -> ()) -> NFData a
$crnf :: TimeSpec -> ()
rnf :: TimeSpec -> ()
NFData
    )

-- | @since 0.1
instance
  (k ~ A_Lens, a ~ Natural, b ~ Natural) =>
  LabelOptic "sec" k TimeSpec TimeSpec a b
  where
  labelOptic :: Optic k NoIx TimeSpec TimeSpec a b
labelOptic = LensVL TimeSpec TimeSpec a b -> Lens TimeSpec TimeSpec a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL TimeSpec TimeSpec a b -> Lens TimeSpec TimeSpec a b)
-> LensVL TimeSpec TimeSpec a b -> Lens TimeSpec TimeSpec a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f (MkTimeSpec Natural
a1 Natural
a2) ->
    (Natural -> TimeSpec) -> f Natural -> f TimeSpec
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Natural
b -> Natural -> Natural -> TimeSpec
MkTimeSpec Natural
b Natural
a2) (a -> f b
f a
Natural
a1)
  {-# INLINE labelOptic #-}

-- | @since 0.1
instance
  (k ~ A_Lens, a ~ Natural, b ~ Natural) =>
  LabelOptic "nsec" k TimeSpec TimeSpec a b
  where
  labelOptic :: Optic k NoIx TimeSpec TimeSpec a b
labelOptic = LensVL TimeSpec TimeSpec a b -> Lens TimeSpec TimeSpec a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL TimeSpec TimeSpec a b -> Lens TimeSpec TimeSpec a b)
-> LensVL TimeSpec TimeSpec a b -> Lens TimeSpec TimeSpec a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f (MkTimeSpec Natural
a1 Natural
a2) ->
    (Natural -> TimeSpec) -> f Natural -> f TimeSpec
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Natural
b -> Natural -> Natural -> TimeSpec
MkTimeSpec Natural
a1 Natural
b) (a -> f b
f a
Natural
a2)
  {-# INLINE labelOptic #-}

-- | @since 0.1
instance Eq TimeSpec where
  TimeSpec
l == :: TimeSpec -> TimeSpec -> Bool
== TimeSpec
r = TimeSpec -> Natural
toNanoSeconds TimeSpec
l Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== TimeSpec -> Natural
toNanoSeconds TimeSpec
r

-- | @since 0.1
instance Ord TimeSpec where
  TimeSpec
l <= :: TimeSpec -> TimeSpec -> Bool
<= TimeSpec
r = TimeSpec -> Natural
toNanoSeconds TimeSpec
l Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= TimeSpec -> Natural
toNanoSeconds TimeSpec
r

-- | @since 0.1
instance LowerBounded TimeSpec where
  lowerBound :: TimeSpec
lowerBound = Natural -> Natural -> TimeSpec
MkTimeSpec Natural
0 Natural
0

-- | @since 0.1
instance UpperBoundless TimeSpec

-- | @since 0.1
instance ASemigroup TimeSpec where
  MkTimeSpec Natural
ls Natural
ln .+. :: TimeSpec -> TimeSpec -> TimeSpec
.+. MkTimeSpec Natural
rs Natural
rn = Natural -> Natural -> TimeSpec
MkTimeSpec (Natural
ls Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
rs) (Natural
ln Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
rn)

-- | @since 0.1
instance AMonoid TimeSpec where
  zero :: TimeSpec
zero = Natural -> Natural -> TimeSpec
MkTimeSpec Natural
0 Natural
0

-- | @since 0.1
instance MSemiSpace TimeSpec Natural where
  MkTimeSpec Natural
s Natural
n .* :: TimeSpec -> Natural -> TimeSpec
.* Natural
k = Natural -> Natural -> TimeSpec
MkTimeSpec (Natural
s Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* Natural
k) (Natural
n Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* Natural
k)

-- | @since 0.1
instance MSpace TimeSpec Natural where
  TimeSpec
ts .% :: TimeSpec -> Natural -> TimeSpec
.% Natural
k = Double -> TimeSpec
fromSeconds (TimeSpec -> Double
toSeconds TimeSpec
ts Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Natural -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
k)

-- | @since 0.1
instance Quartamodule TimeSpec Natural

-- | @since 0.1
instance Hemimodule TimeSpec Natural

-- | @since 0.1
instance Demimodule TimeSpec Natural

-- | @since 0.1
instance Semimodule TimeSpec Natural

-- | @since 0.1
instance PseudoSemivectorSpace TimeSpec Natural

-- | @since 0.1
instance SemivectorSpace TimeSpec Natural

-- | @since 0.1
instance Normed TimeSpec where
  norm :: TimeSpec -> TimeSpec
norm = TimeSpec -> TimeSpec
forall a. a -> a
id

  sgn :: TimeSpec -> TimeSpec
sgn TimeSpec
x
    | TimeSpec
x TimeSpec -> TimeSpec -> Bool
forall a. Eq a => a -> a -> Bool
== TimeSpec
forall m. AMonoid m => m
zero = TimeSpec
forall m. AMonoid m => m
zero
    | Bool
otherwise = Natural -> Natural -> TimeSpec
MkTimeSpec Natural
1 Natural
0

-- | Converts a 'Double' to a 'TimeSpec'.
--
-- @since 0.1
fromSeconds :: Double -> TimeSpec
fromSeconds :: Double -> TimeSpec
fromSeconds Double
d =
  MkTimeSpec
    { sec :: Natural
sec = Natural
seconds,
      nsec :: Natural
nsec = Natural
nanoseconds
    }
  where
    (Natural
seconds, Double
remainder) = Double -> (Natural, Double)
forall b. Integral b => Double -> (b, Double)
properFractionDouble Double
d
    nanoseconds :: Natural
nanoseconds = Double -> Natural
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Natural) -> Double -> Natural
forall a b. (a -> b) -> a -> b
$ Double
remainder Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1_000_000_000

-- | Converts 'Natural' nanoseconds to a 'TimeSpec'.
--
-- @since 0.1
fromNanoSeconds :: Natural -> TimeSpec
fromNanoSeconds :: Natural -> TimeSpec
fromNanoSeconds Natural
nanoseconds = Natural -> Natural -> TimeSpec
MkTimeSpec Natural
s Natural
ns
  where
    (Natural
s, Natural
ns) = Natural -> Natural -> (Natural, Natural)
forall a. Integral a => a -> a -> (a, a)
quotRem Natural
nanoseconds Natural
1_000_000_000

-- | Converts a 'TimeSpec' to a 'Double'.
--
-- @since 0.1
toSeconds :: TimeSpec -> Double
toSeconds :: TimeSpec -> Double
toSeconds (MkTimeSpec Natural
s Natural
n) =
  Natural -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
s Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Natural -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1_000_000_000)

-- | Converts a 'TimeSpec' into 'Natural' nanoseconds.
--
-- @since 0.1
toNanoSeconds :: TimeSpec -> Natural
toNanoSeconds :: TimeSpec -> Natural
toNanoSeconds (MkTimeSpec Natural
s Natural
n) = (Natural
s Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* Natural
1_000_000_000) Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
n

-- | Returns the absolute difference of two 'TimeSpec's.
--
-- @since 0.1
diffTimeSpec :: TimeSpec -> TimeSpec -> TimeSpec
diffTimeSpec :: TimeSpec -> TimeSpec -> TimeSpec
diffTimeSpec TimeSpec
t1 TimeSpec
t2
  | Natural
t1' Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
>= Natural
t2' = Natural -> TimeSpec
fromNanoSeconds (Natural
t1' Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
t2')
  | Bool
otherwise = Natural -> TimeSpec
fromNanoSeconds (Natural
t2' Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
t1')
  where
    t1' :: Natural
t1' = TimeSpec -> Natural
toNanoSeconds TimeSpec
t1
    t2' :: Natural
t2' = TimeSpec -> Natural
toNanoSeconds TimeSpec
t2

-- | Normalizes nanoseconds < 1 second.
--
-- @since 0.1
normalizeTimeSpec :: TimeSpec -> TimeSpec
normalizeTimeSpec :: TimeSpec -> TimeSpec
normalizeTimeSpec = Natural -> TimeSpec
fromNanoSeconds (Natural -> TimeSpec)
-> (TimeSpec -> Natural) -> TimeSpec -> TimeSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeSpec -> Natural
toNanoSeconds

#if !MIN_VERSION_base(4,17,0)
properFractionDouble :: Integral b => Double -> (b, Double)
{-# NOINLINE [1] properFractionDouble #-}
properFractionDouble x =
  case decodeFloat x of
    (m, n) ->
      if n >= 0
        then (fromInteger m * 2 ^ n, 0.0)
        else case quotRem m (2 ^ negate n) of
          (w, r) ->
            (fromInteger w, encodeFloat r n)
#endif