{-# LANGUAGE DeriveGeneric #-}

module Data.FuzzyTime.Types where

import Data.Fixed
import Data.Int
import Data.Validity
import Data.Validity.Time ()
import GHC.Generics (Generic)

import Control.DeepSeq

import Data.Time

data FuzzyZonedTime =
  ZonedNow
  deriving (Show, Eq, Generic)

instance Validity FuzzyZonedTime

instance NFData FuzzyZonedTime

data AmbiguousLocalTime
  = OnlyDaySpecified Day
  | BothTimeAndDay LocalTime
  deriving (Show, Eq, Generic)

instance Validity AmbiguousLocalTime

instance NFData AmbiguousLocalTime

newtype FuzzyLocalTime =
  FuzzyLocalTime
    { unFuzzyLocalTime :: Some FuzzyDay FuzzyTimeOfDay
    }
  deriving (Show, Eq, Generic)

instance Validity FuzzyLocalTime

instance NFData FuzzyLocalTime

data Some a b
  = One a
  | Other b
  | Both a b
  deriving (Show, Eq, 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 (Show, Eq, Generic)

instance Validity FuzzyTimeOfDay where
  validate ftod =
    mconcat
      [ genericValidate ftod
      , case ftod of
          AtHour h ->
            mconcat
              [ declare "The hour is positive" $ h >= 0
              , declare "The hours are fewer than 24" $ h < 24
              ]
          AtMinute h m ->
            mconcat
              [ declare "The hour is positive" $ h >= 0
              , declare "The hours are fewer than 24" $ h < 24
              , declare "The minute is positive" $ m >= 0
              , declare "The minutes are fewer than 60" $ m < 60
              ]
          HoursDiff hs ->
            mconcat
              [declare "The hours difference is no less than 24h" $ abs hs < 24]
          MinutesDiff ms ->
            mconcat
              [ declare "The minutes difference is no less than 1440m" $
                abs ms < 24 * 60
              ]
          SecondsDiff ms ->
            mconcat
              [ declare "The seconds difference is no less than 86400s" $
                abs ms < 24 * 60 * 60
              ]
          _ -> valid
      ]

instance NFData FuzzyTimeOfDay

data FuzzyDay
  = Yesterday
  | Now
  | Today
  | Tomorrow
  | OnlyDay Int
  | DayInMonth Int Int
  | DiffDays Int16
  | DiffWeeks Int16
  | DiffMonths Int16
  | NextDayOfTheWeek DayOfTheWeek
  | ExactDay Day
  deriving (Show, Eq, Generic)

instance Validity FuzzyDay where
  validate fd =
    mconcat
      [ genericValidate fd
      , case fd of
          OnlyDay di ->
            decorate "OnlyDay" $
            mconcat
              [ declare "The day is strictly positive" $ di >= 1
              , declare "The day is less than or equal to 31" $ di <= 31
              ]
          DayInMonth mi di ->
            decorate "DayInMonth" $
            mconcat
              [ declare "The day is strictly positive" $ di >= 1
              , declare "The day is less than or equal to 31" $ di <= 31
              , declare "The month is strictly positive" $ mi >= 1
              , declare "The month is less than or equal to 12" $ mi <= 12
              , declare "The number of days makes sense for the month" $
                maybe False (>= di) $ lookup (numMonth mi) (daysInMonth 2004)
              ]
          _ -> valid
      ]

instance NFData FuzzyDay

data DayOfTheWeek
  = Monday
  | Tuesday
  | Wednesday
  | Thursday
  | Friday
  | Saturday
  | Sunday
  deriving (Show, Eq, Generic, Enum, Bounded)

instance Validity DayOfTheWeek

instance NFData DayOfTheWeek

data Month
  = January
  | February
  | March
  | April
  | May
  | June
  | July
  | August
  | September
  | October
  | November
  | December
  deriving (Show, Eq, Generic, Enum, Bounded)

dayOfTheWeekNum :: DayOfTheWeek -> Int
dayOfTheWeekNum = (+ 1) . fromEnum

numDayOfTheWeek :: Int -> DayOfTheWeek
numDayOfTheWeek = toEnum . (\x -> x - 1)

instance Validity Month

instance NFData Month

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

monthNum :: Month -> Int
monthNum = (+ 1) . fromEnum

numMonth :: Int -> Month
numMonth = toEnum . (\x -> x - 1)