{-# LANGUAGE FlexibleContexts #-}

-- | Shared, non-user-facing machinery for parsing 'Data.HodaTime.ZonedDateTime.ZonedDateTime' values.  It lives in its
--   own module so that both "Data.HodaTime.Pattern.ZonedDateTime" (the ISO parser) and "Data.HodaTime.Pattern.Locale"
--   (the locale-driven parser) can build on it without exposing the intermediate 'ZonedDateTimeInfo' to users.
module Data.HodaTime.Pattern.ZonedDateTime.Internal
(
   ZonedDateTimeInfo(..)
  ,resolveZonedDateTime
  ,parseZonedDateTimeWith
)
where

import Data.HodaTime.Pattern.Internal (Pattern(..), DefaultForParse(..), parse)
import Data.HodaTime.ZonedDateTime (ZonedDateTime)
import Data.HodaTime.CalendarDateTime (CalendarDateTime)
import Data.HodaTime.CalendarDateTime.Internal (IsCalendar)
import Data.HodaTime.TimeZone (TimeZone)
import Control.Monad.Catch (MonadThrow)
import Formatting (later)
import qualified Data.Text as T
import qualified Data.Text.Lazy.Builder as TLB
import Data.Char (isSpace)
import Text.Parsec (many1, satisfy, skipMany, (<?>))

-- | The pure result of parsing a zoned date\/time: the local (wall-clock) 'CalendarDateTime' together with the zone
--   token (an IANA id for the ISO parser, or a @%Z@ abbreviation for the locale parser).  Users never see this; the
--   parse functions turn text straight into a 'ZonedDateTime'.
data ZonedDateTimeInfo cal = ZonedDateTimeInfo
  { forall cal. ZonedDateTimeInfo cal -> CalendarDateTime cal
zdtLocal  :: CalendarDateTime cal
  , forall cal. ZonedDateTimeInfo cal -> String
zdtZoneId :: String
  }

instance IsCalendar cal => DefaultForParse (ZonedDateTimeInfo cal) where
  getDefault :: ZonedDateTimeInfo cal
getDefault = CalendarDateTime cal -> String -> ZonedDateTimeInfo cal
forall cal. CalendarDateTime cal -> String -> ZonedDateTimeInfo cal
ZonedDateTimeInfo CalendarDateTime cal
forall d. DefaultForParse d => d
getDefault String
""

-- | Turn a parsed 'ZonedDateTimeInfo' into a 'ZonedDateTime': the /provider/ loads the 'TimeZone' for the parsed token
--   and the /resolver/ maps the local time into the zone (deciding skipped\/ambiguous cases).
resolveZonedDateTime
  :: Monad m
  => (String -> m TimeZone)
  -> (CalendarDateTime cal -> TimeZone -> m (ZonedDateTime cal))
  -> ZonedDateTimeInfo cal
  -> m (ZonedDateTime cal)
resolveZonedDateTime :: forall (m :: * -> *) cal.
Monad m =>
(String -> m TimeZone)
-> (CalendarDateTime cal -> TimeZone -> m (ZonedDateTime cal))
-> ZonedDateTimeInfo cal
-> m (ZonedDateTime cal)
resolveZonedDateTime String -> m TimeZone
provider CalendarDateTime cal -> TimeZone -> m (ZonedDateTime cal)
resolve ZonedDateTimeInfo cal
info = do
  TimeZone
tz <- String -> m TimeZone
provider (ZonedDateTimeInfo cal -> String
forall cal. ZonedDateTimeInfo cal -> String
zdtZoneId ZonedDateTimeInfo cal
info)
  CalendarDateTime cal -> TimeZone -> m (ZonedDateTime cal)
resolve (ZonedDateTimeInfo cal -> CalendarDateTime cal
forall cal. ZonedDateTimeInfo cal -> CalendarDateTime cal
zdtLocal ZonedDateTimeInfo cal
info) TimeZone
tz

-- | Parse a zoned date\/time using @localPat@ for the local part, then a trailing zone token (any run of non-space
--   characters, after optional whitespace), and resolve it with the given provider and resolver.  The local pattern's
--   own format side is irrelevant here — only its parser is used.
parseZonedDateTimeWith
  :: (MonadThrow m, IsCalendar cal)
  => Pattern (CalendarDateTime cal -> CalendarDateTime cal) b String
  -> (String -> m TimeZone)
  -> (CalendarDateTime cal -> TimeZone -> m (ZonedDateTime cal))
  -> String
  -> m (ZonedDateTime cal)
parseZonedDateTimeWith :: forall (m :: * -> *) cal b.
(MonadThrow m, IsCalendar cal) =>
Pattern (CalendarDateTime cal -> CalendarDateTime cal) b String
-> (String -> m TimeZone)
-> (CalendarDateTime cal -> TimeZone -> m (ZonedDateTime cal))
-> String
-> m (ZonedDateTime cal)
parseZonedDateTimeWith Pattern (CalendarDateTime cal -> CalendarDateTime cal) b String
localPat String -> m TimeZone
provider CalendarDateTime cal -> TimeZone -> m (ZonedDateTime cal)
resolve String
s = Pattern
  (ZonedDateTimeInfo cal -> ZonedDateTimeInfo cal)
  (ZonedDateTimeInfo Any -> String)
  String
-> String -> m (ZonedDateTimeInfo cal)
forall (m :: * -> *) a b.
(MonadThrow m, DefaultForParse a) =>
Pattern (a -> a) b String -> String -> m a
parse Pattern
  (ZonedDateTimeInfo cal -> ZonedDateTimeInfo cal)
  (ZonedDateTimeInfo Any -> String)
  String
forall {b} {cal}.
Pattern
  (b -> ZonedDateTimeInfo cal)
  (ZonedDateTimeInfo cal -> String)
  String
infoPat String
s m (ZonedDateTimeInfo cal)
-> (ZonedDateTimeInfo cal -> m (ZonedDateTime cal))
-> m (ZonedDateTime cal)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> m TimeZone)
-> (CalendarDateTime cal -> TimeZone -> m (ZonedDateTime cal))
-> ZonedDateTimeInfo cal
-> m (ZonedDateTime cal)
forall (m :: * -> *) cal.
Monad m =>
(String -> m TimeZone)
-> (CalendarDateTime cal -> TimeZone -> m (ZonedDateTime cal))
-> ZonedDateTimeInfo cal
-> m (ZonedDateTime cal)
resolveZonedDateTime String -> m TimeZone
provider CalendarDateTime cal -> TimeZone -> m (ZonedDateTime cal)
resolve
  where
    infoPat :: Pattern
  (b -> ZonedDateTimeInfo cal)
  (ZonedDateTimeInfo cal -> String)
  String
infoPat = Parser (b -> ZonedDateTimeInfo cal) String
-> Format String (ZonedDateTimeInfo cal -> String)
-> Pattern
     (b -> ZonedDateTimeInfo cal)
     (ZonedDateTimeInfo cal -> String)
     String
forall a b r. Parser a r -> Format r b -> Pattern a b r
Pattern Parser (b -> ZonedDateTimeInfo cal) String
forall {b}. ParsecT String () Identity (b -> ZonedDateTimeInfo cal)
par Format String (ZonedDateTimeInfo cal -> String)
forall {r} {cal}. Format r (ZonedDateTimeInfo cal -> r)
fmt
    par :: ParsecT String () Identity (b -> ZonedDateTimeInfo cal)
par = (CalendarDateTime cal -> CalendarDateTime cal)
-> String -> b -> ZonedDateTimeInfo cal
forall {t} {cal} {b}.
DefaultForParse t =>
(t -> CalendarDateTime cal) -> String -> b -> ZonedDateTimeInfo cal
build ((CalendarDateTime cal -> CalendarDateTime cal)
 -> String -> b -> ZonedDateTimeInfo cal)
-> ParsecT
     String () Identity (CalendarDateTime cal -> CalendarDateTime cal)
-> ParsecT
     String () Identity (String -> b -> ZonedDateTimeInfo cal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern (CalendarDateTime cal -> CalendarDateTime cal) b String
-> ParsecT
     String () Identity (CalendarDateTime cal -> CalendarDateTime cal)
forall a b r. Pattern a b r -> Parser a r
_patParse Pattern (CalendarDateTime cal -> CalendarDateTime cal) b String
localPat ParsecT String () Identity (String -> b -> ZonedDateTimeInfo cal)
-> ParsecT String () Identity String
-> ParsecT String () Identity (b -> ZonedDateTimeInfo cal)
forall a b.
ParsecT String () Identity (a -> b)
-> ParsecT String () Identity a -> ParsecT String () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String () Identity String
forall {u}. ParsecT String u Identity String
zoneToken
    zoneToken :: ParsecT String u Identity String
zoneToken = ParsecT String u Identity Char -> ParsecT String u Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ((Char -> Bool) -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isSpace) ParsecT String u Identity ()
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ParsecT String u Identity Char -> ParsecT String u Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ((Char -> Bool) -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace)) ParsecT String u Identity String
-> String -> ParsecT String u Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"zone")
    build :: (t -> CalendarDateTime cal) -> String -> b -> ZonedDateTimeInfo cal
build t -> CalendarDateTime cal
setCdt String
z = ZonedDateTimeInfo cal -> b -> ZonedDateTimeInfo cal
forall a b. a -> b -> a
const (CalendarDateTime cal -> String -> ZonedDateTimeInfo cal
forall cal. CalendarDateTime cal -> String -> ZonedDateTimeInfo cal
ZonedDateTimeInfo (t -> CalendarDateTime cal
setCdt t
forall d. DefaultForParse d => d
getDefault) String
z)
    fmt :: Format r (ZonedDateTimeInfo cal -> r)
fmt = (ZonedDateTimeInfo cal -> Builder)
-> Format r (ZonedDateTimeInfo cal -> r)
forall a r. (a -> Builder) -> Format r (a -> r)
later (\ZonedDateTimeInfo cal
info -> Text -> Builder
TLB.fromText (Text -> Builder) -> (String -> Text) -> String -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ ZonedDateTimeInfo cal -> String
forall cal. ZonedDateTimeInfo cal -> String
zdtZoneId ZonedDateTimeInfo cal
info)