{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Data.FuzzyTime.Types
  ( module Data.FuzzyTime.Types,
    DayOfWeek (..),
  )
where

import Control.DeepSeq (NFData)
import Data.Fixed (Pico)
import Data.Int (Int16)
import Data.Time (Day, DayOfWeek (Friday, Monday, Saturday, Sunday, Thursday, Tuesday, Wednesday), LocalTime, TimeOfDay, isLeapYear)
import Data.Validity (Validity (validate), declare, decorate, genericValidate, valid)
import Data.Validity.Time ()
import GHC.Generics (Generic)

data FuzzyZonedTime
  = ZonedNow
  deriving (Int -> FuzzyZonedTime -> ShowS
[FuzzyZonedTime] -> ShowS
FuzzyZonedTime -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FuzzyZonedTime] -> ShowS
$cshowList :: [FuzzyZonedTime] -> ShowS
show :: FuzzyZonedTime -> String
$cshow :: FuzzyZonedTime -> String
showsPrec :: Int -> FuzzyZonedTime -> ShowS
$cshowsPrec :: Int -> FuzzyZonedTime -> ShowS
Show, FuzzyZonedTime -> FuzzyZonedTime -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FuzzyZonedTime -> FuzzyZonedTime -> Bool
$c/= :: FuzzyZonedTime -> FuzzyZonedTime -> Bool
== :: FuzzyZonedTime -> FuzzyZonedTime -> Bool
$c== :: FuzzyZonedTime -> FuzzyZonedTime -> Bool
Eq, forall x. Rep FuzzyZonedTime x -> FuzzyZonedTime
forall x. FuzzyZonedTime -> Rep FuzzyZonedTime x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FuzzyZonedTime x -> FuzzyZonedTime
$cfrom :: forall x. FuzzyZonedTime -> Rep FuzzyZonedTime x
Generic)

instance Validity FuzzyZonedTime

instance NFData FuzzyZonedTime

data AmbiguousLocalTime
  = OnlyDaySpecified Day
  | BothTimeAndDay LocalTime
  deriving (Int -> AmbiguousLocalTime -> ShowS
[AmbiguousLocalTime] -> ShowS
AmbiguousLocalTime -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AmbiguousLocalTime] -> ShowS
$cshowList :: [AmbiguousLocalTime] -> ShowS
show :: AmbiguousLocalTime -> String
$cshow :: AmbiguousLocalTime -> String
showsPrec :: Int -> AmbiguousLocalTime -> ShowS
$cshowsPrec :: Int -> AmbiguousLocalTime -> ShowS
Show, AmbiguousLocalTime -> AmbiguousLocalTime -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AmbiguousLocalTime -> AmbiguousLocalTime -> Bool
$c/= :: AmbiguousLocalTime -> AmbiguousLocalTime -> Bool
== :: AmbiguousLocalTime -> AmbiguousLocalTime -> Bool
$c== :: AmbiguousLocalTime -> AmbiguousLocalTime -> Bool
Eq, forall x. Rep AmbiguousLocalTime x -> AmbiguousLocalTime
forall x. AmbiguousLocalTime -> Rep AmbiguousLocalTime x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AmbiguousLocalTime x -> AmbiguousLocalTime
$cfrom :: forall x. AmbiguousLocalTime -> Rep AmbiguousLocalTime x
Generic)

instance Validity AmbiguousLocalTime

instance NFData AmbiguousLocalTime

newtype FuzzyLocalTime = FuzzyLocalTime
  { FuzzyLocalTime -> Some FuzzyDay FuzzyTimeOfDay
unFuzzyLocalTime :: Some FuzzyDay FuzzyTimeOfDay
  }
  deriving (Int -> FuzzyLocalTime -> ShowS
[FuzzyLocalTime] -> ShowS
FuzzyLocalTime -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FuzzyLocalTime] -> ShowS
$cshowList :: [FuzzyLocalTime] -> ShowS
show :: FuzzyLocalTime -> String
$cshow :: FuzzyLocalTime -> String
showsPrec :: Int -> FuzzyLocalTime -> ShowS
$cshowsPrec :: Int -> FuzzyLocalTime -> ShowS
Show, FuzzyLocalTime -> FuzzyLocalTime -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FuzzyLocalTime -> FuzzyLocalTime -> Bool
$c/= :: FuzzyLocalTime -> FuzzyLocalTime -> Bool
== :: FuzzyLocalTime -> FuzzyLocalTime -> Bool
$c== :: FuzzyLocalTime -> FuzzyLocalTime -> Bool
Eq, forall x. Rep FuzzyLocalTime x -> FuzzyLocalTime
forall x. FuzzyLocalTime -> Rep FuzzyLocalTime x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FuzzyLocalTime x -> FuzzyLocalTime
$cfrom :: forall x. FuzzyLocalTime -> Rep FuzzyLocalTime x
Generic)

instance Validity FuzzyLocalTime

instance NFData FuzzyLocalTime

data Some a b
  = One a
  | Other b
  | Both a b
  deriving (Int -> Some a b -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> Some a b -> ShowS
forall a b. (Show a, Show b) => [Some a b] -> ShowS
forall a b. (Show a, Show b) => Some a b -> String
showList :: [Some a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [Some a b] -> ShowS
show :: Some a b -> String
$cshow :: forall a b. (Show a, Show b) => Some a b -> String
showsPrec :: Int -> Some a b -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> Some a b -> ShowS
Show, Some a b -> Some a b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => Some a b -> Some a b -> Bool
/= :: Some a b -> Some a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => Some a b -> Some a b -> Bool
== :: Some a b -> Some a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => Some a b -> Some a b -> Bool
Eq, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b x. Rep (Some a b) x -> Some a b
forall a b x. Some a b -> Rep (Some a b) x
$cto :: forall a b x. Rep (Some a b) x -> Some a b
$cfrom :: forall a b x. Some a b -> Rep (Some a b) x
Generic)

instance (Validity a, Validity b) => Validity (Some a b)

instance (NFData a, NFData b) => NFData (Some a b)

data FuzzyTimeOfDay
  = SameTime
  | Noon
  | Midnight
  | Morning
  | Evening
  | AtHour Int
  | AtMinute Int Int
  | AtExact TimeOfDay
  | HoursDiff Int -- Max 24
  | MinutesDiff Int -- Max 24 * 60
  | SecondsDiff Pico -- Max 24 * 60 * 60
  deriving (Int -> FuzzyTimeOfDay -> ShowS
[FuzzyTimeOfDay] -> ShowS
FuzzyTimeOfDay -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FuzzyTimeOfDay] -> ShowS
$cshowList :: [FuzzyTimeOfDay] -> ShowS
show :: FuzzyTimeOfDay -> String
$cshow :: FuzzyTimeOfDay -> String
showsPrec :: Int -> FuzzyTimeOfDay -> ShowS
$cshowsPrec :: Int -> FuzzyTimeOfDay -> ShowS
Show, FuzzyTimeOfDay -> FuzzyTimeOfDay -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FuzzyTimeOfDay -> FuzzyTimeOfDay -> Bool
$c/= :: FuzzyTimeOfDay -> FuzzyTimeOfDay -> Bool
== :: FuzzyTimeOfDay -> FuzzyTimeOfDay -> Bool
$c== :: FuzzyTimeOfDay -> FuzzyTimeOfDay -> Bool
Eq, forall x. Rep FuzzyTimeOfDay x -> FuzzyTimeOfDay
forall x. FuzzyTimeOfDay -> Rep FuzzyTimeOfDay x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FuzzyTimeOfDay x -> FuzzyTimeOfDay
$cfrom :: forall x. FuzzyTimeOfDay -> Rep FuzzyTimeOfDay x
Generic)

instance Validity FuzzyTimeOfDay where
  validate :: FuzzyTimeOfDay -> Validation
validate FuzzyTimeOfDay
ftod =
    forall a. Monoid a => [a] -> a
mconcat
      [ forall a. (Generic a, GValidity (Rep a)) => a -> Validation
genericValidate FuzzyTimeOfDay
ftod,
        case FuzzyTimeOfDay
ftod of
          AtHour Int
h ->
            forall a. Monoid a => [a] -> a
mconcat
              [ String -> Bool -> Validation
declare String
"The hour is positive" forall a b. (a -> b) -> a -> b
$ Int
h forall a. Ord a => a -> a -> Bool
>= Int
0,
                String -> Bool -> Validation
declare String
"The hours are fewer than 24" forall a b. (a -> b) -> a -> b
$ Int
h forall a. Ord a => a -> a -> Bool
< Int
24
              ]
          AtMinute Int
h Int
m ->
            forall a. Monoid a => [a] -> a
mconcat
              [ String -> Bool -> Validation
declare String
"The hour is positive" forall a b. (a -> b) -> a -> b
$ Int
h forall a. Ord a => a -> a -> Bool
>= Int
0,
                String -> Bool -> Validation
declare String
"The hours are fewer than 24" forall a b. (a -> b) -> a -> b
$ Int
h forall a. Ord a => a -> a -> Bool
< Int
24,
                String -> Bool -> Validation
declare String
"The minute is positive" forall a b. (a -> b) -> a -> b
$ Int
m forall a. Ord a => a -> a -> Bool
>= Int
0,
                String -> Bool -> Validation
declare String
"The minutes are fewer than 60" forall a b. (a -> b) -> a -> b
$ Int
m forall a. Ord a => a -> a -> Bool
< Int
60
              ]
          HoursDiff Int
hs ->
            forall a. Monoid a => [a] -> a
mconcat
              [String -> Bool -> Validation
declare String
"The hours difference is no less than 24h" forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a
abs Int
hs forall a. Ord a => a -> a -> Bool
< Int
24]
          MinutesDiff Int
ms ->
            forall a. Monoid a => [a] -> a
mconcat
              [ String -> Bool -> Validation
declare String
"The minutes difference is no less than 1440m" forall a b. (a -> b) -> a -> b
$
                  forall a. Num a => a -> a
abs Int
ms forall a. Ord a => a -> a -> Bool
< Int
24 forall a. Num a => a -> a -> a
* Int
60
              ]
          SecondsDiff Pico
ms ->
            forall a. Monoid a => [a] -> a
mconcat
              [ String -> Bool -> Validation
declare String
"The seconds difference is no less than 86400s" forall a b. (a -> b) -> a -> b
$
                  forall a. Num a => a -> a
abs Pico
ms forall a. Ord a => a -> a -> Bool
< Pico
24 forall a. Num a => a -> a -> a
* Pico
60 forall a. Num a => a -> a -> a
* Pico
60
              ]
          FuzzyTimeOfDay
_ -> Validation
valid
      ]

instance NFData FuzzyTimeOfDay

data FuzzyDay
  = Yesterday
  | Now
  | Today
  | Tomorrow
  | OnlyDay Int
  | DayInMonth Int Int
  | DiffDays Int16
  | DiffWeeks Int16
  | DiffMonths Int16
  | NextDayOfTheWeek DayOfWeek
  | ExactDay Day
  deriving (Int -> FuzzyDay -> ShowS
[FuzzyDay] -> ShowS
FuzzyDay -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FuzzyDay] -> ShowS
$cshowList :: [FuzzyDay] -> ShowS
show :: FuzzyDay -> String
$cshow :: FuzzyDay -> String
showsPrec :: Int -> FuzzyDay -> ShowS
$cshowsPrec :: Int -> FuzzyDay -> ShowS
Show, FuzzyDay -> FuzzyDay -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FuzzyDay -> FuzzyDay -> Bool
$c/= :: FuzzyDay -> FuzzyDay -> Bool
== :: FuzzyDay -> FuzzyDay -> Bool
$c== :: FuzzyDay -> FuzzyDay -> Bool
Eq, forall x. Rep FuzzyDay x -> FuzzyDay
forall x. FuzzyDay -> Rep FuzzyDay x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FuzzyDay x -> FuzzyDay
$cfrom :: forall x. FuzzyDay -> Rep FuzzyDay x
Generic)

instance Validity FuzzyDay where
  validate :: FuzzyDay -> Validation
validate FuzzyDay
fd =
    forall a. Monoid a => [a] -> a
mconcat
      [ forall a. (Generic a, GValidity (Rep a)) => a -> Validation
genericValidate FuzzyDay
fd,
        case FuzzyDay
fd of
          OnlyDay Int
di ->
            String -> Validation -> Validation
decorate String
"OnlyDay" forall a b. (a -> b) -> a -> b
$
              forall a. Monoid a => [a] -> a
mconcat
                [ String -> Bool -> Validation
declare String
"The day is strictly positive" forall a b. (a -> b) -> a -> b
$ Int
di forall a. Ord a => a -> a -> Bool
>= Int
1,
                  String -> Bool -> Validation
declare String
"The day is less than or equal to 31" forall a b. (a -> b) -> a -> b
$ Int
di forall a. Ord a => a -> a -> Bool
<= Int
31
                ]
          DayInMonth Int
mi Int
di ->
            String -> Validation -> Validation
decorate String
"DayInMonth" forall a b. (a -> b) -> a -> b
$
              forall a. Monoid a => [a] -> a
mconcat
                [ String -> Bool -> Validation
declare String
"The day is strictly positive" forall a b. (a -> b) -> a -> b
$ Int
di forall a. Ord a => a -> a -> Bool
>= Int
1,
                  String -> Bool -> Validation
declare String
"The day is less than or equal to 31" forall a b. (a -> b) -> a -> b
$ Int
di forall a. Ord a => a -> a -> Bool
<= Int
31,
                  String -> Bool -> Validation
declare String
"The month is strictly positive" forall a b. (a -> b) -> a -> b
$ Int
mi forall a. Ord a => a -> a -> Bool
>= Int
1,
                  String -> Bool -> Validation
declare String
"The month is less than or equal to 12" forall a b. (a -> b) -> a -> b
$ Int
mi forall a. Ord a => a -> a -> Bool
<= Int
12,
                  String -> Bool -> Validation
declare String
"The number of days makes sense for the month" forall a b. (a -> b) -> a -> b
$
                    forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall a. Ord a => a -> a -> Bool
>= Int
di) forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Int -> Month
numMonth Int
mi) (Integer -> [(Month, Int)]
daysInMonth Integer
2004)
                ]
          FuzzyDay
_ -> Validation
valid
      ]

instance NFData FuzzyDay

deriving instance Generic DayOfWeek

#if !MIN_VERSION_time(1,11,1)
instance NFData DayOfWeek
#endif

dayOfTheWeekNum :: DayOfWeek -> Int
dayOfTheWeekNum :: DayOfWeek -> Int
dayOfTheWeekNum = forall a. Enum a => a -> Int
fromEnum

numDayOfTheWeek :: Int -> DayOfWeek
numDayOfTheWeek :: Int -> DayOfWeek
numDayOfTheWeek = forall a. Enum a => Int -> a
toEnum

data Month
  = January
  | February
  | March
  | April
  | May
  | June
  | July
  | August
  | September
  | October
  | November
  | December
  deriving (Int -> Month -> ShowS
[Month] -> ShowS
Month -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Month] -> ShowS
$cshowList :: [Month] -> ShowS
show :: Month -> String
$cshow :: Month -> String
showsPrec :: Int -> Month -> ShowS
$cshowsPrec :: Int -> Month -> ShowS
Show, Month -> Month -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Month -> Month -> Bool
$c/= :: Month -> Month -> Bool
== :: Month -> Month -> Bool
$c== :: Month -> Month -> Bool
Eq, forall x. Rep Month x -> Month
forall x. Month -> Rep Month x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Month x -> Month
$cfrom :: forall x. Month -> Rep Month x
Generic, Int -> Month
Month -> Int
Month -> [Month]
Month -> Month
Month -> Month -> [Month]
Month -> Month -> Month -> [Month]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Month -> Month -> Month -> [Month]
$cenumFromThenTo :: Month -> Month -> Month -> [Month]
enumFromTo :: Month -> Month -> [Month]
$cenumFromTo :: Month -> Month -> [Month]
enumFromThen :: Month -> Month -> [Month]
$cenumFromThen :: Month -> Month -> [Month]
enumFrom :: Month -> [Month]
$cenumFrom :: Month -> [Month]
fromEnum :: Month -> Int
$cfromEnum :: Month -> Int
toEnum :: Int -> Month
$ctoEnum :: Int -> Month
pred :: Month -> Month
$cpred :: Month -> Month
succ :: Month -> Month
$csucc :: Month -> Month
Enum, Month
forall a. a -> a -> Bounded a
maxBound :: Month
$cmaxBound :: Month
minBound :: Month
$cminBound :: Month
Bounded)

instance Validity Month

instance NFData Month

daysInMonth :: Integer -> [(Month, Int)]
daysInMonth :: Integer -> [(Month, Int)]
daysInMonth Integer
y =
  [ (Month
January, Int
31),
    ( Month
February,
      if Integer -> Bool
isLeapYear Integer
y
        then Int
29
        else Int
28
    ),
    (Month
March, Int
31),
    (Month
April, Int
30),
    (Month
May, Int
31),
    (Month
June, Int
30),
    (Month
July, Int
31),
    (Month
August, Int
31),
    (Month
September, Int
30),
    (Month
October, Int
31),
    (Month
November, Int
30),
    (Month
December, Int
31)
  ]

monthNum :: Month -> Int
monthNum :: Month -> Int
monthNum = (forall a. Num a => a -> a -> a
+ Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum

numMonth :: Int -> Month
numMonth :: Int -> Month
numMonth = forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Int
x -> Int
x forall a. Num a => a -> a -> a
- Int
1)