{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Provides the 'PollInterval' type.
--
-- @since 0.1
module Navi.Data.PollInterval
  ( PollInterval (..),
    pollIntervalOptDecoder,
    toSleepTime,
  )
where

import Data.Text qualified as T
import Data.Time.Relative qualified as Rel
import Navi.Prelude

-- | Represents how often to poll for service changes, in seconds.
--
-- @since 0.1
newtype PollInterval = MkPollInterval {PollInterval -> Natural
unPollInterval :: Natural}
  deriving stock (PollInterval -> PollInterval -> Bool
forall (a :: OpticKind).
(a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PollInterval -> PollInterval -> Bool
$c/= :: PollInterval -> PollInterval -> Bool
== :: PollInterval -> PollInterval -> Bool
$c== :: PollInterval -> PollInterval -> Bool
Eq, Eq PollInterval
PollInterval -> PollInterval -> Bool
PollInterval -> PollInterval -> Ordering
PollInterval -> PollInterval -> PollInterval
forall (a :: OpticKind).
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
min :: PollInterval -> PollInterval -> PollInterval
$cmin :: PollInterval -> PollInterval -> PollInterval
max :: PollInterval -> PollInterval -> PollInterval
$cmax :: PollInterval -> PollInterval -> PollInterval
>= :: PollInterval -> PollInterval -> Bool
$c>= :: PollInterval -> PollInterval -> Bool
> :: PollInterval -> PollInterval -> Bool
$c> :: PollInterval -> PollInterval -> Bool
<= :: PollInterval -> PollInterval -> Bool
$c<= :: PollInterval -> PollInterval -> Bool
< :: PollInterval -> PollInterval -> Bool
$c< :: PollInterval -> PollInterval -> Bool
compare :: PollInterval -> PollInterval -> Ordering
$ccompare :: PollInterval -> PollInterval -> Ordering
Ord, Int -> PollInterval -> ShowS
[PollInterval] -> ShowS
PollInterval -> String
forall (a :: OpticKind).
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PollInterval] -> ShowS
$cshowList :: [PollInterval] -> ShowS
show :: PollInterval -> String
$cshow :: PollInterval -> String
showsPrec :: Int -> PollInterval -> ShowS
$cshowsPrec :: Int -> PollInterval -> ShowS
Show)
  deriving (Integer -> PollInterval
PollInterval -> PollInterval
PollInterval -> PollInterval -> PollInterval
forall (a :: OpticKind).
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> PollInterval
$cfromInteger :: Integer -> PollInterval
signum :: PollInterval -> PollInterval
$csignum :: PollInterval -> PollInterval
abs :: PollInterval -> PollInterval
$cabs :: PollInterval -> PollInterval
negate :: PollInterval -> PollInterval
$cnegate :: PollInterval -> PollInterval
* :: PollInterval -> PollInterval -> PollInterval
$c* :: PollInterval -> PollInterval -> PollInterval
- :: PollInterval -> PollInterval -> PollInterval
$c- :: PollInterval -> PollInterval -> PollInterval
+ :: PollInterval -> PollInterval -> PollInterval
$c+ :: PollInterval -> PollInterval -> PollInterval
Num) via Natural

-- | @since 0.1
makeFieldLabelsNoPrefix ''PollInterval

-- | @since 0.1
instance Bounded PollInterval where
  minBound :: PollInterval
minBound = Natural -> PollInterval
MkPollInterval Natural
0
  {-# INLINEABLE minBound #-}
  maxBound :: PollInterval
maxBound = PollInterval
maxPollInterval
  {-# INLINEABLE maxBound #-}

-- | @since 0.1
instance DecodeTOML PollInterval where
  tomlDecoder :: Decoder PollInterval
tomlDecoder = forall (a :: OpticKind). (Value -> DecodeM a) -> Decoder a
makeDecoder forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \case
    String Text
t ->
      case String -> Either String RelativeTime
Rel.fromString (Text -> String
unpack Text
t) of
        Left String
_ -> forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
MonadFail m =>
String -> m a
fail forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Text -> String
unpack forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Text
"Could not parse poll-interval: " forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
t
        Right RelativeTime
relTime -> forall (f :: OpticKind -> OpticKind).
MonadFail f =>
Natural -> f PollInterval
ltRelTimeBounds forall (a :: OpticKind) b. (a -> b) -> a -> b
$ RelativeTime -> Natural
Rel.toSeconds RelativeTime
relTime
    Integer Integer
i -> forall (f :: OpticKind -> OpticKind).
MonadFail f =>
Natural -> f PollInterval
ltRelTimeBounds (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
fromIntegral Integer
i)
    Value
badTy -> forall (a :: OpticKind). Value -> DecodeM a
typeMismatch Value
badTy

ltRelTimeBounds :: MonadFail f => Natural -> f PollInterval
ltRelTimeBounds :: forall (f :: OpticKind -> OpticKind).
MonadFail f =>
Natural -> f PollInterval
ltRelTimeBounds Natural
n
  | Natural -> PollInterval
MkPollInterval Natural
n forall (a :: OpticKind). Ord a => a -> a -> Bool
<= forall (a :: OpticKind). Bounded a => a
maxBound = forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Natural -> PollInterval
MkPollInterval Natural
n
  | Bool
otherwise =
      forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
MonadFail m =>
String -> m a
fail forall (a :: OpticKind) b. (a -> b) -> a -> b
$
        Text -> String
unpack forall (a :: OpticKind) b. (a -> b) -> a -> b
$
          [Text] -> Text
T.concat
            [ Text
"Given poll interval of ",
              forall (a :: OpticKind). Show a => a -> Text
showt Natural
n,
              Text
" is too large. Maximum seconds is ",
              forall (a :: OpticKind). Show a => a -> Text
showt @PollInterval forall (a :: OpticKind). Bounded a => a
maxBound
            ]

-- | TOML decoder for optional 'PollInterval' with field name 'poll-interval'.
--
-- @since 0.1
pollIntervalOptDecoder :: Decoder (Maybe PollInterval)
pollIntervalOptDecoder :: Decoder (Maybe PollInterval)
pollIntervalOptDecoder = forall (a :: OpticKind). Decoder a -> Text -> Decoder (Maybe a)
getFieldOptWith forall (a :: OpticKind). DecodeTOML a => Decoder a
tomlDecoder Text
"poll-interval"

-- | Converts a 'PollInterval' into an 'Int' suitable to be used with
-- threadDelay.
--
-- @since 0.1
toSleepTime :: PollInterval -> Int
toSleepTime :: PollInterval -> Int
toSleepTime = forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
fromIntegral forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. (forall (a :: OpticKind). Num a => a -> a -> a
* Natural
1_000_000) forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (a :: OpticKind).
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall (a :: OpticKind). IsLabel "unPollInterval" a => a
#unPollInterval
{-# INLINEABLE toSleepTime #-}

maxPollInterval :: PollInterval
maxPollInterval :: PollInterval
maxPollInterval = Natural -> PollInterval
MkPollInterval (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
fromIntegral Int
mx)
  where
    -- PollInterval represents seconds, and we eventually want to use it in
    -- threadDelay (which requires an Int). This means we have to multiply
    -- by 1_000_000, thus the maximum value we can safely store is
    -- (maxInt / 1_000_000).
    mx :: Int
mx = (forall (a :: OpticKind). Bounded a => a
maxBound :: Int) forall (a :: OpticKind). Integral a => a -> a -> a
`div` Int
1_000_000
{-# INLINEABLE maxPollInterval #-}