-- | POSIX Milliseconds wrapper

module Blockfrost.Types.Shared.POSIXMillis
  ( POSIXMillis
  , POSIXTime
  , millisecondsToPosix
  , posixToMilliseconds
  , seconds
  ) where

import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Time.Clock.POSIX
import GHC.Generics
import Servant.Docs (ToSample (..), singleSample)
import Test.QuickCheck.Arbitrary
import Test.QuickCheck.Instances ()
import Test.QuickCheck.Modifiers

-- | Convert `Integer` milliseconds to `POSIXTime`
millisecondsToPosix :: Integer -> POSIXTime
millisecondsToPosix :: Integer -> POSIXTime
millisecondsToPosix Integer
n = Integer -> POSIXTime
forall a. Num a => Integer -> a
fromInteger Integer
n POSIXTime -> POSIXTime -> POSIXTime
forall a. Fractional a => a -> a -> a
/ POSIXTime
1000

-- | Convert `POSIXTime` to `Integer` milliseconds
posixToMilliseconds :: POSIXTime -> Integer
posixToMilliseconds :: POSIXTime -> Integer
posixToMilliseconds POSIXTime
t = POSIXTime -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (POSIXTime
t POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
* POSIXTime
1000)

newtype POSIXMillis = POSIXMillis {
    POSIXMillis -> POSIXTime
unPOSIXMillis :: POSIXTime
  }
  deriving stock (Int -> POSIXMillis -> ShowS
[POSIXMillis] -> ShowS
POSIXMillis -> String
(Int -> POSIXMillis -> ShowS)
-> (POSIXMillis -> String)
-> ([POSIXMillis] -> ShowS)
-> Show POSIXMillis
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [POSIXMillis] -> ShowS
$cshowList :: [POSIXMillis] -> ShowS
show :: POSIXMillis -> String
$cshow :: POSIXMillis -> String
showsPrec :: Int -> POSIXMillis -> ShowS
$cshowsPrec :: Int -> POSIXMillis -> ShowS
Show, POSIXMillis -> POSIXMillis -> Bool
(POSIXMillis -> POSIXMillis -> Bool)
-> (POSIXMillis -> POSIXMillis -> Bool) -> Eq POSIXMillis
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: POSIXMillis -> POSIXMillis -> Bool
$c/= :: POSIXMillis -> POSIXMillis -> Bool
== :: POSIXMillis -> POSIXMillis -> Bool
$c== :: POSIXMillis -> POSIXMillis -> Bool
Eq, (forall x. POSIXMillis -> Rep POSIXMillis x)
-> (forall x. Rep POSIXMillis x -> POSIXMillis)
-> Generic POSIXMillis
forall x. Rep POSIXMillis x -> POSIXMillis
forall x. POSIXMillis -> Rep POSIXMillis x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep POSIXMillis x -> POSIXMillis
$cfrom :: forall x. POSIXMillis -> Rep POSIXMillis x
Generic)

seconds :: POSIXTime -> POSIXMillis
seconds :: POSIXTime -> POSIXMillis
seconds = POSIXTime -> POSIXMillis
POSIXMillis

instance FromJSON POSIXMillis where
  parseJSON :: Value -> Parser POSIXMillis
parseJSON Value
t = POSIXTime -> POSIXMillis
POSIXMillis (POSIXTime -> POSIXMillis)
-> (Integer -> POSIXTime) -> Integer -> POSIXMillis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> POSIXTime
millisecondsToPosix (Integer -> POSIXMillis) -> Parser Integer -> Parser POSIXMillis
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Integer
forall a. FromJSON a => Value -> Parser a
parseJSON @Integer Value
t

instance ToJSON POSIXMillis where
  toJSON :: POSIXMillis -> Value
toJSON (POSIXMillis POSIXTime
t) = Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (Integer -> Value) -> Integer -> Value
forall a b. (a -> b) -> a -> b
$ POSIXTime -> Integer
posixToMilliseconds POSIXTime
t
  toEncoding :: POSIXMillis -> Encoding
toEncoding (POSIXMillis POSIXTime
t) = Integer -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (Integer -> Encoding) -> Integer -> Encoding
forall a b. (a -> b) -> a -> b
$ POSIXTime -> Integer
posixToMilliseconds POSIXTime
t

instance ToSample POSIXMillis where
    toSamples :: Proxy POSIXMillis -> [(Text, POSIXMillis)]
toSamples Proxy POSIXMillis
_ = POSIXMillis -> [(Text, POSIXMillis)]
forall a. a -> [(Text, a)]
singleSample (POSIXMillis -> [(Text, POSIXMillis)])
-> POSIXMillis -> [(Text, POSIXMillis)]
forall a b. (a -> b) -> a -> b
$ POSIXTime -> POSIXMillis
POSIXMillis (POSIXTime -> POSIXMillis) -> POSIXTime -> POSIXMillis
forall a b. (a -> b) -> a -> b
$ Integer -> POSIXTime
millisecondsToPosix Integer
1603400958947

instance Arbitrary POSIXMillis where
  arbitrary :: Gen POSIXMillis
arbitrary = do
    Positive (Integer
n :: Integer) <- Gen (Positive Integer)
forall a. Arbitrary a => Gen a
arbitrary
    POSIXMillis -> Gen POSIXMillis
forall (f :: * -> *) a. Applicative f => a -> f a
pure (POSIXMillis -> Gen POSIXMillis) -> POSIXMillis -> Gen POSIXMillis
forall a b. (a -> b) -> a -> b
$ POSIXTime -> POSIXMillis
POSIXMillis (Integer -> POSIXTime
forall a. Num a => Integer -> a
fromInteger Integer
n POSIXTime -> POSIXTime -> POSIXTime
forall a. Fractional a => a -> a -> a
/ POSIXTime
1000)