module Network.GRPC.Spec.Timeout (
    -- * Timeouts
    Timeout(..)
  , TimeoutValue(TimeoutValue, getTimeoutValue)
  , TimeoutUnit(..)
  , isValidTimeoutValue
    -- * Translation
  , timeoutToMicro
  ) where

import GHC.Generics (Generic)
import GHC.Show

{-------------------------------------------------------------------------------
  Timeouts
-------------------------------------------------------------------------------}

-- | Timeout
data Timeout = Timeout TimeoutUnit TimeoutValue
  deriving stock (Int -> Timeout -> ShowS
[Timeout] -> ShowS
Timeout -> String
(Int -> Timeout -> ShowS)
-> (Timeout -> String) -> ([Timeout] -> ShowS) -> Show Timeout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Timeout -> ShowS
showsPrec :: Int -> Timeout -> ShowS
$cshow :: Timeout -> String
show :: Timeout -> String
$cshowList :: [Timeout] -> ShowS
showList :: [Timeout] -> ShowS
Show, Timeout -> Timeout -> Bool
(Timeout -> Timeout -> Bool)
-> (Timeout -> Timeout -> Bool) -> Eq Timeout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Timeout -> Timeout -> Bool
== :: Timeout -> Timeout -> Bool
$c/= :: Timeout -> Timeout -> Bool
/= :: Timeout -> Timeout -> Bool
Eq, (forall x. Timeout -> Rep Timeout x)
-> (forall x. Rep Timeout x -> Timeout) -> Generic Timeout
forall x. Rep Timeout x -> Timeout
forall x. Timeout -> Rep Timeout x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Timeout -> Rep Timeout x
from :: forall x. Timeout -> Rep Timeout x
$cto :: forall x. Rep Timeout x -> Timeout
to :: forall x. Rep Timeout x -> Timeout
Generic)

-- | Positive integer with ASCII representation of at most 8 digits
newtype TimeoutValue = UnsafeTimeoutValue {
      TimeoutValue -> Word
getTimeoutValue :: Word
    }
  deriving newtype (TimeoutValue -> TimeoutValue -> Bool
(TimeoutValue -> TimeoutValue -> Bool)
-> (TimeoutValue -> TimeoutValue -> Bool) -> Eq TimeoutValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimeoutValue -> TimeoutValue -> Bool
== :: TimeoutValue -> TimeoutValue -> Bool
$c/= :: TimeoutValue -> TimeoutValue -> Bool
/= :: TimeoutValue -> TimeoutValue -> Bool
Eq)
  deriving stock ((forall x. TimeoutValue -> Rep TimeoutValue x)
-> (forall x. Rep TimeoutValue x -> TimeoutValue)
-> Generic TimeoutValue
forall x. Rep TimeoutValue x -> TimeoutValue
forall x. TimeoutValue -> Rep TimeoutValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TimeoutValue -> Rep TimeoutValue x
from :: forall x. TimeoutValue -> Rep TimeoutValue x
$cto :: forall x. Rep TimeoutValue x -> TimeoutValue
to :: forall x. Rep TimeoutValue x -> TimeoutValue
Generic)

-- | 'Show' instance relies on the v'TimeoutValue' pattern synonym
instance Show TimeoutValue where
  showsPrec :: Int -> TimeoutValue -> ShowS
showsPrec Int
p (UnsafeTimeoutValue Word
val) = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
appPrec1) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
        String -> ShowS
showString String
"TimeoutValue "
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
appPrec1 Word
val

pattern TimeoutValue :: Word -> TimeoutValue
pattern $bTimeoutValue :: Word -> TimeoutValue
$mTimeoutValue :: forall {r}. TimeoutValue -> (Word -> r) -> ((# #) -> r) -> r
TimeoutValue t <- UnsafeTimeoutValue t
  where
    TimeoutValue Word
t
      | Word -> Bool
isValidTimeoutValue Word
t = Word -> TimeoutValue
UnsafeTimeoutValue Word
t
      | Bool
otherwise = String -> TimeoutValue
forall a. HasCallStack => String -> a
error (String -> TimeoutValue) -> String -> TimeoutValue
forall a b. (a -> b) -> a -> b
$ String
"invalid TimeoutValue: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show Word
t

{-# COMPLETE TimeoutValue #-}

-- | Valid timeout values
--
-- Timeout values cannot exceed 8 digits. If you need a longer timeout, consider
-- using a different 'TimeoutUnit' instead.
isValidTimeoutValue :: Word -> Bool
isValidTimeoutValue :: Word -> Bool
isValidTimeoutValue Word
t = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Word -> String
forall a. Show a => a -> String
show Word
t) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
8

-- | Timeout unit
data TimeoutUnit =
    Hour        -- ^ Hours
  | Minute      -- ^ Minutes
  | Second      -- ^ Seconds
  | Millisecond -- ^ Milliseconds
  | Microsecond -- ^ Microseconds
  | Nanosecond  -- ^ Nanoseconds
                --
                -- Although some servers may be able to interpret this in a
                -- meaningful way, /we/ cannot, and round this up to the nearest
                -- microsecond.
  deriving stock (Int -> TimeoutUnit -> ShowS
[TimeoutUnit] -> ShowS
TimeoutUnit -> String
(Int -> TimeoutUnit -> ShowS)
-> (TimeoutUnit -> String)
-> ([TimeoutUnit] -> ShowS)
-> Show TimeoutUnit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TimeoutUnit -> ShowS
showsPrec :: Int -> TimeoutUnit -> ShowS
$cshow :: TimeoutUnit -> String
show :: TimeoutUnit -> String
$cshowList :: [TimeoutUnit] -> ShowS
showList :: [TimeoutUnit] -> ShowS
Show, TimeoutUnit -> TimeoutUnit -> Bool
(TimeoutUnit -> TimeoutUnit -> Bool)
-> (TimeoutUnit -> TimeoutUnit -> Bool) -> Eq TimeoutUnit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimeoutUnit -> TimeoutUnit -> Bool
== :: TimeoutUnit -> TimeoutUnit -> Bool
$c/= :: TimeoutUnit -> TimeoutUnit -> Bool
/= :: TimeoutUnit -> TimeoutUnit -> Bool
Eq, (forall x. TimeoutUnit -> Rep TimeoutUnit x)
-> (forall x. Rep TimeoutUnit x -> TimeoutUnit)
-> Generic TimeoutUnit
forall x. Rep TimeoutUnit x -> TimeoutUnit
forall x. TimeoutUnit -> Rep TimeoutUnit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TimeoutUnit -> Rep TimeoutUnit x
from :: forall x. TimeoutUnit -> Rep TimeoutUnit x
$cto :: forall x. Rep TimeoutUnit x -> TimeoutUnit
to :: forall x. Rep TimeoutUnit x -> TimeoutUnit
Generic)

{-------------------------------------------------------------------------------
  Translation
-------------------------------------------------------------------------------}

-- | Translate t'Timeout' to microseconds
--
-- For 'Nanosecond' timeout we round up.
--
-- Note: the choice of 'Integer' for the result is important: timeouts can be
-- quite long, and might easily exceed the range of a 32-bit int: @2^31@
-- microseconds is roughly 35 minutes (on 64-bit architectures this is much less
-- important; @2^63@ microseconds is 292,277.2 /years/). We could use @Int64@ or
-- @Word64@, but 'Integer' works nicely with the @unbounded-delays@ package.
timeoutToMicro :: Timeout -> Integer
timeoutToMicro :: Timeout -> Integer
timeoutToMicro = \case
    Timeout TimeoutUnit
Hour        (TimeoutValue Word
n) -> Word -> Integer -> Integer
mult Word
n (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1_000 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1_000 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
60 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
24
    Timeout TimeoutUnit
Minute      (TimeoutValue Word
n) -> Word -> Integer -> Integer
mult Word
n (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1_000 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1_000 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
60
    Timeout TimeoutUnit
Second      (TimeoutValue Word
n) -> Word -> Integer -> Integer
mult Word
n (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1_000 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1_000
    Timeout TimeoutUnit
Millisecond (TimeoutValue Word
n) -> Word -> Integer -> Integer
mult Word
n (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1_000
    Timeout TimeoutUnit
Microsecond (TimeoutValue Word
n) -> Word -> Integer -> Integer
mult Word
n (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Integer
1
    Timeout TimeoutUnit
Nanosecond  (TimeoutValue Word
n) -> Word -> Integer
nano Word
n
  where
    mult :: Word -> Integer -> Integer
    mult :: Word -> Integer -> Integer
mult Word
n Integer
m = Word -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
m

    nano :: Word -> Integer
    nano :: Word -> Integer
nano Word
n = Word -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Integer) -> Word -> Integer
forall a b. (a -> b) -> a -> b
$
        Word
mu Word -> Word -> Word
forall a. Num a => a -> a -> a
+ if Word
n' Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 then Word
0 else Word
1
      where
        (Word
mu, Word
n') = Word -> Word -> (Word, Word)
forall a. Integral a => a -> a -> (a, a)
divMod Word
n Word
1_000