module Network.IPFS.Timeout.Types (Timeout (..)) where

import System.Envy

import Network.IPFS.Prelude
import Network.IPFS.Internal.Orphanage.Natural ()

newtype Timeout = Timeout { Timeout -> Natural
getSeconds :: Natural }
  deriving          ( Timeout -> Timeout -> Bool
(Timeout -> Timeout -> Bool)
-> (Timeout -> Timeout -> Bool) -> Eq Timeout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Timeout -> Timeout -> Bool
$c/= :: Timeout -> Timeout -> Bool
== :: Timeout -> Timeout -> Bool
$c== :: Timeout -> Timeout -> Bool
Eq
                    , 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
showList :: [Timeout] -> ShowS
$cshowList :: [Timeout] -> ShowS
show :: Timeout -> String
$cshow :: Timeout -> String
showsPrec :: Int -> Timeout -> ShowS
$cshowsPrec :: Int -> Timeout -> ShowS
Show
                    , (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
$cto :: forall x. Rep Timeout x -> Timeout
$cfrom :: forall x. Timeout -> Rep Timeout x
Generic
                    )
  deriving newtype  ( Integer -> Timeout
Timeout -> Timeout
Timeout -> Timeout -> Timeout
(Timeout -> Timeout -> Timeout)
-> (Timeout -> Timeout -> Timeout)
-> (Timeout -> Timeout -> Timeout)
-> (Timeout -> Timeout)
-> (Timeout -> Timeout)
-> (Timeout -> Timeout)
-> (Integer -> Timeout)
-> Num Timeout
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Timeout
$cfromInteger :: Integer -> Timeout
signum :: Timeout -> Timeout
$csignum :: Timeout -> Timeout
abs :: Timeout -> Timeout
$cabs :: Timeout -> Timeout
negate :: Timeout -> Timeout
$cnegate :: Timeout -> Timeout
* :: Timeout -> Timeout -> Timeout
$c* :: Timeout -> Timeout -> Timeout
- :: Timeout -> Timeout -> Timeout
$c- :: Timeout -> Timeout -> Timeout
+ :: Timeout -> Timeout -> Timeout
$c+ :: Timeout -> Timeout -> Timeout
Num )

instance FromEnv Timeout where
  fromEnv :: Maybe Timeout -> Parser Timeout
fromEnv Maybe Timeout
_ = Natural -> Timeout
Timeout (Natural -> Timeout) -> Parser Natural -> Parser Timeout
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Parser Natural
forall a. Var a => String -> Parser a
env String
"IPFS_TIMEOUT"

instance FromJSON Timeout where
  parseJSON :: Value -> Parser Timeout
parseJSON = String -> (Scientific -> Parser Timeout) -> Value -> Parser Timeout
forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
withScientific String
"IPFS.Timeout" \Scientific
num ->
    Natural -> Timeout
Timeout (Natural -> Timeout) -> Parser Natural -> Parser Timeout
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Natural
forall a. FromJSON a => Value -> Parser a
parseJSON (Scientific -> Value
Number Scientific
num)