{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC   -Wno-orphans #-}

module Data.Time.Units.Extra where

import Data.Aeson (FromJSON, ToJSON, parseJSON, toJSON, withScientific)
import Data.Scientific (toBoundedInteger)
import Data.Time.Units (Millisecond, Second)

instance FromJSON Second where
    parseJSON :: Value -> Parser Second
parseJSON =
        String -> (Scientific -> Parser Second) -> Value -> Parser Second
forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
withScientific
            String
"second"
            (\Scientific
s ->
                 case Scientific -> Maybe Int
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger Scientific
s of
                     Maybe Int
Nothing -> String -> Parser Second
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Value must be an Integer."
                     Just Int
i  -> Second -> Parser Second
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Second
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
i :: Int)))

instance ToJSON Second where
    toJSON :: Second -> Value
toJSON = ToJSON Int => Int -> Value
forall a. ToJSON a => a -> Value
toJSON @Int (Int -> Value) -> (Second -> Int) -> Second -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Second -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance FromJSON Millisecond where
    parseJSON :: Value -> Parser Millisecond
parseJSON =
        String
-> (Scientific -> Parser Millisecond)
-> Value
-> Parser Millisecond
forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
withScientific
            String
"millisecond"
            (\Scientific
s ->
                 case Scientific -> Maybe Int
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger Scientific
s of
                     Maybe Int
Nothing -> String -> Parser Millisecond
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Value must be an Integer."
                     Just Int
i  -> Millisecond -> Parser Millisecond
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Millisecond
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
i :: Int)))

instance ToJSON Millisecond where
    toJSON :: Millisecond -> Value
toJSON = ToJSON Int => Int -> Value
forall a. ToJSON a => a -> Value
toJSON @Int (Int -> Value) -> (Millisecond -> Int) -> Millisecond -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Millisecond -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral