{-# 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 ()
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
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