{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Data.Validity.Time.Clock where

import Data.Time.Clock
import Data.Validity
import Data.Validity.Time.Calendar ()

-- | Valid according to the 'Rational' it contains.
instance Validity UniversalTime where
  validate :: UniversalTime -> Validation
validate = String -> Rational -> Validation
forall a. Validity a => String -> a -> Validation
delve String
"toModifiedJulianDay" (Rational -> Validation)
-> (UniversalTime -> Rational) -> UniversalTime -> Validation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniversalTime -> Rational
getModJulianDate

-- | Trivially valid
instance Validity DiffTime where
  validate :: DiffTime -> Validation
validate = DiffTime -> Validation
forall a. a -> Validation
trivialValidation

instance Validity UTCTime where
  validate :: UTCTime -> Validation
validate UTCTime {DiffTime
Day
utctDay :: UTCTime -> Day
utctDayTime :: UTCTime -> DiffTime
utctDayTime :: DiffTime
utctDay :: Day
..} =
    [Validation] -> Validation
forall a. Monoid a => [a] -> a
mconcat
      [ Day -> String -> Validation
forall a. Validity a => a -> String -> Validation
annotate Day
utctDay String
"utctDay",
        DiffTime -> String -> Validation
forall a. Validity a => a -> String -> Validation
annotate DiffTime
utctDayTime String
"utctDayTime",
        Bool -> String -> Validation
check (DiffTime
utctDayTime DiffTime -> DiffTime -> Bool
forall a. Ord a => a -> a -> Bool
>= DiffTime
0) String
"The day time is positive.",
        Bool -> String -> Validation
check (DiffTime
utctDayTime DiffTime -> DiffTime -> Bool
forall a. Ord a => a -> a -> Bool
< DiffTime
86401) String
"The day time is strictly less than 86401."
      ]

instance Validity NominalDiffTime where
  validate :: NominalDiffTime -> Validation
validate = NominalDiffTime -> Validation
forall a. a -> Validation
trivialValidation