{-# LANGUAGE InstanceSigs #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Literate.Time (
  module Data.Time.Calendar,
  module Data.Time.Calendar.Month,
  module Data.Time.Clock,
  module Data.Time.Format,
  module Data.Time.LocalTime,
)
where

import Data.Fixed (Pico)
import Data.Foldable (asum, or)
import Data.Maybe (fromJust)
import Data.Time.Calendar
import Data.Time.Calendar.Month
import Data.Time.Clock
import Data.Time.Format
import Data.Time.LocalTime
import Literate.Prelude
import Prelude (error)

instance IsString LocalTime where
  fromString :: HasCallStack => String -> LocalTime
  fromString s =
    fromJust $
      asum @[]
        [ parseTimeM False timeLocales "%Y-%0m-%0dT%H:%M:%S" s
        , parseTimeM False timeLocales "%Y-%0m-%0d %H:%M:%S" s
        , parseTimeM False timeLocales "%Y-%0m-%0dT%H:%M" s
        , parseTimeM False timeLocales "%Y-%0m-%0d %H:%M" s
        , parseTimeM False timeLocales "%Y-%0m-%0d" s
        , parseTimeM False timeLocales "%Y-%0m" s
        , parseTimeM False timeLocales "%Y" s
        ]
instance IsString Day where
  fromString :: HasCallStack => String -> Day
  fromString s =
    fromJust $
      asum @[]
        [ parseTimeM False timeLocales "%Y-%0m-%0d" s
        ]
instance IsString TimeOfDay where
  fromString :: HasCallStack => String -> TimeOfDay
  fromString s =
    asum @[] @_ @DiffTime
      [ parseTimeM False timeLocales "%H" s
      , parseTimeM False timeLocales "%H:%M" s
      , parseTimeM False timeLocales "%H:%M:%S" s
      ]
      & fromJust
      & pastMidnight

timeLocales =
  defaultTimeLocale
    { knownTimeZones = knownTimeZones defaultTimeLocale <> [cet, cest]
    }
  where
    cet =
      TimeZone
        { timeZoneMinutes = 60
        , timeZoneSummerOnly = False
        , timeZoneName = "CET"
        }
    cest =
      TimeZone
        { timeZoneMinutes = 120
        , timeZoneSummerOnly = True
        , timeZoneName = "CEST"
        }

fromGregorianValid :: HasCallStack => Integer -> Int -> Int -> Day
fromGregorianValid y m d =
  fromMaybe (error ("invalid Day: " <> show (y, m, d))) $
    Data.Time.Calendar.fromGregorianValid y m d

type Hour = Int
type Minute = Int
type Second = Pico

makeTimeOfDayValid :: HasCallStack => Hour -> Minute -> Second -> TimeOfDay
makeTimeOfDayValid h m s =
  fromMaybe (error ("invalid TimeOfDay: " <> show (h, m, s))) $
    Data.Time.LocalTime.makeTimeOfDayValid h m s