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

module Data.Validity.Time.LocalTime where

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

-- | Valid according to the contained values.
instance Validity TimeZone where
  validate :: TimeZone -> Validation
validate TimeZone {Bool
Int
String
timeZoneMinutes :: TimeZone -> Int
timeZoneSummerOnly :: TimeZone -> Bool
timeZoneName :: TimeZone -> String
timeZoneName :: String
timeZoneSummerOnly :: Bool
timeZoneMinutes :: Int
..} =
    [Validation] -> Validation
forall a. Monoid a => [a] -> a
mconcat
      [ Int -> String -> Validation
forall a. Validity a => a -> String -> Validation
annotate Int
timeZoneMinutes String
"timeZoneMinutes",
        Bool -> String -> Validation
forall a. Validity a => a -> String -> Validation
annotate Bool
timeZoneSummerOnly String
"timeZoneSummerOnly",
        String -> String -> Validation
forall a. Validity a => a -> String -> Validation
annotate String
timeZoneName String
"timeZoneName"
      ]

-- | Valid according to the validity of contained values and these constraints:
--
--  * todHour : range 0 - 23
--  * todMin : range 0 - 59
--  * todSec : 0 <= todSec < 61,
instance Validity TimeOfDay where
  validate :: TimeOfDay -> Validation
validate TimeOfDay {Int
Pico
todHour :: TimeOfDay -> Int
todMin :: TimeOfDay -> Int
todSec :: TimeOfDay -> Pico
todSec :: Pico
todMin :: Int
todHour :: Int
..} =
    [Validation] -> Validation
forall a. Monoid a => [a] -> a
mconcat
      [ Int -> String -> Validation
forall a. Validity a => a -> String -> Validation
annotate Int
todHour String
"todHour",
        Bool -> String -> Validation
check (Int
todHour Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) String
"The 'hour' is positive.",
        Bool -> String -> Validation
check (Int
todHour Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
23) String
"The 'hour' is 23 or less.",
        Int -> String -> Validation
forall a. Validity a => a -> String -> Validation
annotate Int
todMin String
"todMin",
        Bool -> String -> Validation
check (Int
todMin Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) String
"The 'minute' is positive.",
        Bool -> String -> Validation
check (Int
todMin Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
59) String
"The 'minute' is 59 or less.",
        Pico -> String -> Validation
forall a. Validity a => a -> String -> Validation
annotate Pico
todSec String
"todSec",
        Bool -> String -> Validation
check (Pico
todSec Pico -> Pico -> Bool
forall a. Ord a => a -> a -> Bool
>= Pico
0) String
"The 'second' is positive.",
        Bool -> String -> Validation
check (Pico
todSec Pico -> Pico -> Bool
forall a. Ord a => a -> a -> Bool
< Pico
61) String
"The 'second' is 60 or less."
      ]

-- | Valid according to the validity of contained values
instance Validity LocalTime where
  validate :: LocalTime -> Validation
validate LocalTime {TimeOfDay
Day
localDay :: LocalTime -> Day
localTimeOfDay :: LocalTime -> TimeOfDay
localTimeOfDay :: TimeOfDay
localDay :: Day
..} =
    [Validation] -> Validation
forall a. Monoid a => [a] -> a
mconcat
      [Day -> String -> Validation
forall a. Validity a => a -> String -> Validation
annotate Day
localDay String
"localDay", TimeOfDay -> String -> Validation
forall a. Validity a => a -> String -> Validation
annotate TimeOfDay
localTimeOfDay String
"localTimeOfDay"]

-- | Valid according to the validity of contained values
instance Validity ZonedTime where
  validate :: ZonedTime -> Validation
validate ZonedTime {LocalTime
TimeZone
zonedTimeToLocalTime :: ZonedTime -> LocalTime
zonedTimeZone :: ZonedTime -> TimeZone
zonedTimeZone :: TimeZone
zonedTimeToLocalTime :: LocalTime
..} =
    [Validation] -> Validation
forall a. Monoid a => [a] -> a
mconcat
      [ LocalTime -> String -> Validation
forall a. Validity a => a -> String -> Validation
annotate LocalTime
zonedTimeToLocalTime String
"zonedTimeToLocalTime",
        TimeZone -> String -> Validation
forall a. Validity a => a -> String -> Validation
annotate TimeZone
zonedTimeZone String
"zonedTimeZone"
      ]

instance Validity CalendarDiffTime where
  validate :: CalendarDiffTime -> Validation
validate CalendarDiffTime {Integer
NominalDiffTime
ctMonths :: CalendarDiffTime -> Integer
ctTime :: CalendarDiffTime -> NominalDiffTime
ctTime :: NominalDiffTime
ctMonths :: Integer
..} =
    [Validation] -> Validation
forall a. Monoid a => [a] -> a
mconcat
      [ Integer -> String -> Validation
forall a. Validity a => a -> String -> Validation
annotate Integer
ctMonths String
"ctMonths",
        NominalDiffTime -> String -> Validation
forall a. Validity a => a -> String -> Validation
annotate NominalDiffTime
ctTime String
"ctTime"
      ]