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

-- | Provides the 'PollInterval' type.
--
-- @since 0.1
module Navi.Data.PollInterval
  ( PollInterval (..),
    parsePollInterval,
    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
(PollInterval -> PollInterval -> Bool)
-> (PollInterval -> PollInterval -> Bool) -> Eq PollInterval
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PollInterval -> PollInterval -> Bool
== :: PollInterval -> PollInterval -> Bool
$c/= :: PollInterval -> PollInterval -> Bool
/= :: PollInterval -> PollInterval -> Bool
Eq, Eq PollInterval
Eq PollInterval =>
(PollInterval -> PollInterval -> Ordering)
-> (PollInterval -> PollInterval -> Bool)
-> (PollInterval -> PollInterval -> Bool)
-> (PollInterval -> PollInterval -> Bool)
-> (PollInterval -> PollInterval -> Bool)
-> (PollInterval -> PollInterval -> PollInterval)
-> (PollInterval -> PollInterval -> PollInterval)
-> Ord PollInterval
PollInterval -> PollInterval -> Bool
PollInterval -> PollInterval -> Ordering
PollInterval -> PollInterval -> PollInterval
forall a.
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
$ccompare :: PollInterval -> PollInterval -> Ordering
compare :: PollInterval -> PollInterval -> Ordering
$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
>= :: PollInterval -> PollInterval -> Bool
$cmax :: PollInterval -> PollInterval -> PollInterval
max :: PollInterval -> PollInterval -> PollInterval
$cmin :: PollInterval -> PollInterval -> PollInterval
min :: PollInterval -> PollInterval -> PollInterval
Ord, Int -> PollInterval -> ShowS
[PollInterval] -> ShowS
PollInterval -> String
(Int -> PollInterval -> ShowS)
-> (PollInterval -> String)
-> ([PollInterval] -> ShowS)
-> Show PollInterval
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PollInterval -> ShowS
showsPrec :: Int -> PollInterval -> ShowS
$cshow :: PollInterval -> String
show :: PollInterval -> String
$cshowList :: [PollInterval] -> ShowS
showList :: [PollInterval] -> ShowS
Show)
  deriving (Integer -> PollInterval
PollInterval -> PollInterval
PollInterval -> PollInterval -> PollInterval
(PollInterval -> PollInterval -> PollInterval)
-> (PollInterval -> PollInterval -> PollInterval)
-> (PollInterval -> PollInterval -> PollInterval)
-> (PollInterval -> PollInterval)
-> (PollInterval -> PollInterval)
-> (PollInterval -> PollInterval)
-> (Integer -> PollInterval)
-> Num PollInterval
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: PollInterval -> PollInterval -> PollInterval
+ :: PollInterval -> PollInterval -> PollInterval
$c- :: PollInterval -> PollInterval -> PollInterval
- :: PollInterval -> PollInterval -> PollInterval
$c* :: PollInterval -> PollInterval -> PollInterval
* :: PollInterval -> PollInterval -> PollInterval
$cnegate :: PollInterval -> PollInterval
negate :: PollInterval -> PollInterval
$cabs :: PollInterval -> PollInterval
abs :: PollInterval -> PollInterval
$csignum :: PollInterval -> PollInterval
signum :: PollInterval -> PollInterval
$cfromInteger :: Integer -> PollInterval
fromInteger :: Integer -> PollInterval
Num) via Natural

-- | @since 0.1
makeFieldLabelsNoPrefix ''PollInterval

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

-- | @since 0.1
instance DecodeTOML PollInterval where
  tomlDecoder :: Decoder PollInterval
tomlDecoder = (Value -> DecodeM PollInterval) -> Decoder PollInterval
forall a. (Value -> DecodeM a) -> Decoder a
makeDecoder ((Value -> DecodeM PollInterval) -> Decoder PollInterval)
-> (Value -> DecodeM PollInterval) -> Decoder PollInterval
forall a b. (a -> b) -> a -> b
$ \case
    String Text
t -> Text -> DecodeM PollInterval
forall (m :: Type -> Type). MonadFail m => Text -> m PollInterval
parsePollInterval Text
t
    Integer Integer
i -> Natural -> DecodeM PollInterval
forall (f :: Type -> Type).
MonadFail f =>
Natural -> f PollInterval
ltRelTimeBounds (Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i)
    Value
badTy -> Value -> DecodeM PollInterval
forall a. Value -> DecodeM a
typeMismatch Value
badTy

parsePollInterval :: (MonadFail m) => Text -> m PollInterval
parsePollInterval :: forall (m :: Type -> Type). MonadFail m => Text -> m PollInterval
parsePollInterval Text
t = case String -> Either String RelativeTime
Rel.fromString (Text -> String
unpackText Text
t) of
  Left String
_ -> String -> m PollInterval
forall a. String -> m a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> m PollInterval) -> String -> m PollInterval
forall a b. (a -> b) -> a -> b
$ Text -> String
unpackText (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
"Could not parse poll-interval: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
  Right RelativeTime
relTime -> Natural -> m PollInterval
forall (f :: Type -> Type).
MonadFail f =>
Natural -> f PollInterval
ltRelTimeBounds (Natural -> m PollInterval) -> Natural -> m PollInterval
forall a b. (a -> b) -> a -> b
$ RelativeTime -> Natural
Rel.toSeconds RelativeTime
relTime

ltRelTimeBounds :: (MonadFail f) => Natural -> f PollInterval
ltRelTimeBounds :: forall (f :: Type -> Type).
MonadFail f =>
Natural -> f PollInterval
ltRelTimeBounds Natural
n
  | Natural -> PollInterval
MkPollInterval Natural
n PollInterval -> PollInterval -> Bool
forall a. Ord a => a -> a -> Bool
<= PollInterval
forall a. Bounded a => a
maxBound = PollInterval -> f PollInterval
forall a. a -> f a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (PollInterval -> f PollInterval) -> PollInterval -> f PollInterval
forall a b. (a -> b) -> a -> b
$ Natural -> PollInterval
MkPollInterval Natural
n
  | Bool
otherwise =
      String -> f PollInterval
forall a. String -> f a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail
        (String -> f PollInterval) -> String -> f PollInterval
forall a b. (a -> b) -> a -> b
$ Text -> String
unpackText
        (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat
          [ Text
"Given poll interval of ",
            Natural -> Text
forall a. Show a => a -> Text
showt Natural
n,
            Text
" is too large. Maximum seconds is ",
            forall a. Show a => a -> Text
showt @PollInterval PollInterval
forall a. 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 = Decoder PollInterval -> Text -> Decoder (Maybe PollInterval)
forall a. Decoder a -> Text -> Decoder (Maybe a)
getFieldOptWith Decoder PollInterval
forall a. 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 = Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Int)
-> (PollInterval -> Natural) -> PollInterval -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* Natural
1_000_000) (Natural -> Natural)
-> (PollInterval -> Natural) -> PollInterval -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Optic' An_Iso NoIx PollInterval Natural -> PollInterval -> Natural
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' An_Iso NoIx PollInterval Natural
#unPollInterval

maxPollInterval :: PollInterval
maxPollInterval :: PollInterval
maxPollInterval = Natural -> PollInterval
MkPollInterval (Int -> Natural
forall a b. (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 = (Int
forall a. Bounded a => a
maxBound :: Int) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
1_000_000