module Signet.Unstable.Type.Tolerance where

import qualified Control.Monad as Monad
import qualified Data.Time as Time
import qualified Signet.Unstable.Exception.ToleranceException as ToleranceException
import qualified Signet.Unstable.Type.Timestamp as Timestamp

newtype Tolerance
  = MkTolerance Time.NominalDiffTime
  deriving (Tolerance -> Tolerance -> Bool
(Tolerance -> Tolerance -> Bool)
-> (Tolerance -> Tolerance -> Bool) -> Eq Tolerance
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Tolerance -> Tolerance -> Bool
== :: Tolerance -> Tolerance -> Bool
$c/= :: Tolerance -> Tolerance -> Bool
/= :: Tolerance -> Tolerance -> Bool
Eq, Int -> Tolerance -> ShowS
[Tolerance] -> ShowS
Tolerance -> String
(Int -> Tolerance -> ShowS)
-> (Tolerance -> String)
-> ([Tolerance] -> ShowS)
-> Show Tolerance
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Tolerance -> ShowS
showsPrec :: Int -> Tolerance -> ShowS
$cshow :: Tolerance -> String
show :: Tolerance -> String
$cshowList :: [Tolerance] -> ShowS
showList :: [Tolerance] -> ShowS
Show)

unwrap :: Tolerance -> Time.NominalDiffTime
unwrap :: Tolerance -> NominalDiffTime
unwrap (MkTolerance NominalDiffTime
nominalDiffTime) = NominalDiffTime
nominalDiffTime

typical :: Tolerance
typical :: Tolerance
typical = NominalDiffTime -> Tolerance
MkTolerance NominalDiffTime
300

check ::
  Tolerance ->
  Time.UTCTime ->
  Timestamp.Timestamp ->
  Either ToleranceException.ToleranceException ()
check :: Tolerance -> UTCTime -> Timestamp -> Either ToleranceException ()
check Tolerance
tolerance UTCTime
utcTime Timestamp
timestamp = do
  let diff :: NominalDiffTime
diff = UTCTime -> UTCTime -> NominalDiffTime
Time.diffUTCTime UTCTime
utcTime (UTCTime -> NominalDiffTime) -> UTCTime -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Timestamp -> UTCTime
Timestamp.unwrap Timestamp
timestamp
  let hi :: NominalDiffTime
hi = Tolerance -> NominalDiffTime
unwrap Tolerance
tolerance
  let lo :: NominalDiffTime
lo = NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a
negate NominalDiffTime
hi
  Bool
-> Either ToleranceException () -> Either ToleranceException ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.when (NominalDiffTime
lo NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
> NominalDiffTime
diff Bool -> Bool -> Bool
|| NominalDiffTime
diff NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
> NominalDiffTime
hi)
    (Either ToleranceException () -> Either ToleranceException ())
-> (ToleranceException -> Either ToleranceException ())
-> ToleranceException
-> Either ToleranceException ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ToleranceException -> Either ToleranceException ()
forall a b. a -> Either a b
Left
    (ToleranceException -> Either ToleranceException ())
-> ToleranceException -> Either ToleranceException ()
forall a b. (a -> b) -> a -> b
$ Timestamp -> ToleranceException
ToleranceException.MkToleranceException Timestamp
timestamp