ApplyParse.hs

{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}
module Data.HodaTime.Pattern.ApplyParse
(
   DefaultForParse(..)
  ,ApplyParse(..)
  ,ZonedDateTimeInfo(..)
  ,DateTimeInfo(..)
  ,TimeInfo(..)
  ,DateInfo(..)
)
where

import Data.HodaTime.LocalTime.Internal (LocalTime(..), localTime)
import Data.HodaTime.CalendarDateTime.Internal (IsCalendar(..), Date, CalendarDateTime(..), at)
import Data.HodaTime.Instant.Internal (Instant(..), Duration(..))
import Data.HodaTime.Offset.Internal (Offset, empty)
import Data.HodaTime.OffsetDateTime (OffsetDateTime, fromCalendarDateTimeWithOffset)
import Data.HodaTime.Pattern.ParseTypes
import Control.Monad.Catch (MonadThrow)

defaultTime :: TimeInfo
defaultTime = TimeInfo 0 0 0 0

-- Class

class DefaultForParse d where
  getDefault :: d

instance DefaultForParse LocalTime where
  getDefault = LocalTime 0 0

instance IsCalendar cal => DefaultForParse (Date cal) where
  getDefault = fromDays 0   -- the calendar's epoch; parsing overwrites the fields, so any valid date works

instance IsCalendar cal => DefaultForParse (CalendarDateTime cal) where
  getDefault = getDefault `at` getDefault

instance DefaultForParse Instant where
  getDefault = Instant 0 0 0   -- the Instant epoch (1 March 2000); parsing overwrites the fields

instance DefaultForParse Offset where
  getDefault = empty           -- UTC; a full offset pattern replaces this outright

instance IsCalendar cal => DefaultForParse (OffsetDateTime cal) where
  getDefault = fromCalendarDateTimeWithOffset getDefault empty   -- fully replaced by the pattern

instance DefaultForParse Duration where
  getDefault = Duration (Instant 0 0 0)   -- the zero duration; fully replaced by the pattern


class ApplyParse a b | b -> a where
  applyParse :: MonadThrow m => (a -> a) -> m b

instance ApplyParse TimeInfo LocalTime where
  applyParse f = localTime (_hour ti) (_minute ti) (_second ti) (_nanoSecond ti)
    where
      ti = f defaultTime

instance IsCalendar cal => ApplyParse (DateInfo cal) (Date cal) where
  applyParse _ = undefined

{- class ApplyParse r where
  type StartData r
  getStartData :: StartData r
  applyParse :: StartData r -> r

instance ApplyParse LocalTime where
  type StartData LocalTime = TimeInfo
  getStartData = defaultTime

instance IsCalendar cal => ApplyParse (CalendarDate cal) where
  type StartData LocalTime = DateInfo cal
  getStartData = defaultDate

instance IsCalendar cal => ApplyParse (CalendarDateTime cal) where
  type StartData r = DateTimeInfo
  getStartData = defaultDateTime

instance IsCalendar cal => ApplyParse (ZonedDateTimeInfo cal) where
  type StartData r = ZonedDateTimeInfo
  getStartData = defaultDateTime "UTC" -}