{-# LANGUAGE OverloadedStrings #-}

module Model.Date
  ( Date(..)
  , renderDate
  , getCurrentDate
  , getNextWeek
  , getWeekDay
  , plusDays
  , sameDayAndMonth
  , isBeforeOrEqualDayAndMonth
  , yearsGap
  , daysGap
  , isValid
  ) where

import Text.Printf (printf)

import Data.Time.Clock
import Data.Time.Calendar
import Data.Time.LocalTime
import Data.Time.Format (formatTime, defaultTimeLocale)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Maybe (isJust)

import Time (formatCurrentLocale)

data Date = Date
  { day :: Int
  , month :: Int
  , year :: Int
  } deriving (Eq, Show)

renderDate :: Date -> Text
renderDate (Date d m y) =
  T.concat
    [ T.pack $ printf "%02d" d
    , "/"
    , T.pack $ printf "%02d" m
    , "/"
    , T.pack . show $ y
    ]

getCurrentDate :: IO Date
getCurrentDate = do
  now <- getCurrentTime
  timezone <- getCurrentTimeZone
  let zoneNow = utcToLocalTime timezone now
  return . dateFromDay $ localDay zoneNow

getNextWeek :: IO (Date, Date)
getNextWeek = do
  currentDate <- getCurrentDate
  currentDayNumberOfWeek <- (read . T.unpack <$> formatCurrentLocale "%u") :: IO Int
  let begin = currentDate `plusDays` (8 - currentDayNumberOfWeek)
  let end = begin `plusDays` 6
  return (begin, end)

getWeekDay :: Date -> Text
getWeekDay = T.toLower . T.pack . formatTime defaultTimeLocale "%A" . dateToDay

plusDays :: Date -> Int -> Date
plusDays date n = dateFromDay . addDays (toInteger n) . dateToDay $ date

dateToDay :: Date -> Day
dateToDay (Date d m y) = fromGregorian (toInteger y) m d

dateFromDay :: Day -> Date
dateFromDay dayTime =
  let (y, m, d) = toGregorian dayTime
  in  Date d m (fromIntegral y)

sameDayAndMonth :: Date -> Date -> Bool
sameDayAndMonth d1 d2 =
  (  day d1 == day d2
  && month d1 == month d2
  )

isBeforeOrEqualDayAndMonth :: Date -> Date -> Bool
isBeforeOrEqualDayAndMonth d1 d2 =
  (  month d1 < month d2
  || (  month d1 == month d2
     && day d1 <= day d2
     )
  )

yearsGap :: Date -> Date -> Int
yearsGap d1 d2 = abs (year d2 - year d1)

daysGap :: Date -> Date -> Int
daysGap d1 d2 = abs . fromIntegral $ (dateToDay d1) `diffDays` (dateToDay d2)

isValid :: Date -> Bool
isValid (Date d m y) = isJust $ fromGregorianValid (toInteger y) m d