{-# LANGUAGE FlexibleContexts #-}

-- |
-- Module      :  Data.HodaTime.Pattern.Locale
-- Copyright   :  (C) 2016 Jason Johnson
-- License     :  BSD-style (see the file LICENSE)
-- Maintainer  :  Jason Johnson <jason.johnson.081@gmail.com>
-- Stability   :  experimental
-- Portability :  POSIX, Windows
--
-- Compiles the @strftime@ layout strings captured in a 'Locale' by "Data.HodaTime.Locale" (the operating system's
-- @D_FMT@ \/ @T_FMT@ on POSIX, translated from the equivalent Windows /picture/ strings) into hodatime 'Pattern's, so a
-- date or time can be formatted and parsed using the machine's own conventions.
--
-- ==== __Using the machine's own layout__
--
-- 'localeDatePattern' turns a locale's @D_FMT@ into a pattern, so the /same/ date renders the way each culture writes
-- it — month-first in the US, day-first in Germany (here @march15@ is 15 March 2020):
--
-- > do us  <- localeByName "en_US.UTF-8"
-- >    de  <- localeByName "de_DE.UTF-8"
-- >    usP <- localeDatePattern us
-- >    deP <- localeDatePattern de
-- >    pure (format usP march15, format deP march15)       -- ("03/15/2020", "15.03.2020")
--
-- Use 'currentLocale' instead of 'localeByName' to follow the machine's own @LC_TIME@ setting, and 'parse' with the
-- same pattern to read that layout back:
--
-- > do loc <- currentLocale
-- >    p   <- localeDatePattern loc                        -- the current locale's short-date layout
-- >    pure (format p march15) >>= parse p                 -- round-trips in whatever order the locale uses
--
-- 'localeTimePattern' does the same for the time-of-day layout (@T_FMT@), and 'localeDateTimePattern' for the combined
-- date-and-time layout (@D_T_FMT@) as a 'CalendarDateTime'.
--
-- ==== __On time zones__
--
-- 'localeDateTimePattern' /deliberately ignores/ the time zone.  Most @D_T_FMT@ strings end with @%Z@ (a zone
-- abbreviation such as @CEST@) or @%z@ (a numeric offset); a 'CalendarDateTime' is /civil/ time with no zone attached,
-- so there is nothing to render there and nothing to interpret, and those specifiers are dropped from the compiled
-- pattern.  In particular a zone-less datetime is /not/ assumed to be UTC — treating civil time as UTC is exactly the
-- accidental coupling the library is built to avoid; turning a 'CalendarDateTime' into an absolute instant always
-- requires you to attach an offset or time zone /on purpose/.
--
-- When you /do/ want the zone, use 'parseZonedDateTime' (below): it parses the locale's zoned layout into a
-- 'Data.HodaTime.ZonedDateTime.ZonedDateTime', capturing the @%Z@ abbreviation and resolving it through a /provider/
-- you supply (abbreviations are ambiguous, so the caller owns that mapping).  It requires the layout to contain a zone,
-- throwing 'ZonelessLayoutException' otherwise — a layout with no zone is not a zoned value.
--
-- A layout that instead carries a /numeric/ offset (@%z@, e.g. @+0200@) is unambiguous, so
-- 'localeOffsetDateTimePattern' compiles it into an ordinary, pure, bidirectional
-- 'Data.HodaTime.OffsetDateTime.OffsetDateTime' pattern (used with 'parse' and 'format', no provider needed), throwing
-- 'OffsetlessLayoutException' if the layout has no @%z@.
module Data.HodaTime.Pattern.Locale
(
   StrftimeError(..)
  ,ZonelessLayoutException(..)
  ,OffsetlessLayoutException(..)
  ,localeDatePattern
  ,localeTimePattern
  ,localeDateTimePattern
  ,localeOffsetDateTimePattern
  ,parseZonedDateTime
)
where

import Data.HodaTime.Pattern.Internal (Pattern(..), (<%), string)
import Data.HodaTime.Pattern.CalendarDate (pyyyy, pyy, pMM, pdd, pdaySpace, pMMMM', pMMM', pdddd', pddd')
import Data.HodaTime.Pattern.OffsetDateTime (offsetDateTimePattern)
import Data.HodaTime.Pattern.Offset (pOffsetCompact)
import Data.HodaTime.Pattern.LocalTime (pHH, phh, phhSpace, pmm, pss, ppp')
import Data.HodaTime.Pattern.ZonedDateTime.Internal (parseZonedDateTimeWith)
import Data.HodaTime.Locale.Internal (Locale(..))
import Data.HodaTime.CalendarDateTime.Internal (HasDate, DoW, MoY, Month, CalendarDateTime, IsCalendar)
import Data.HodaTime.LocalTime.Internal (HasLocalTime)
import Data.HodaTime.ZonedDateTime (ZonedDateTime)
import Data.HodaTime.OffsetDateTime (OffsetDateTime)
import Data.HodaTime.TimeZone (TimeZone)
import Control.Monad.Catch (MonadThrow, throwM)
import Control.Exception (Exception)
import Data.Typeable (Typeable)
import qualified Data.Text as T
import qualified Data.Text.Lazy.Builder as TLB
import qualified Text.Parsec as P (string)
import Formatting (later)

-- | Raised when a layout string uses a @strftime@ conversion that the compiler does not implement.
data StrftimeError
  = UnsupportedSpecifier Char   -- ^ a conversion we do not support here (e.g. @%Z@, @%V@, or a width\/flag like @%-d@)
  | DanglingPercent             -- ^ the layout string ended with a bare @%@
  deriving (StrftimeError -> StrftimeError -> Bool
(StrftimeError -> StrftimeError -> Bool)
-> (StrftimeError -> StrftimeError -> Bool) -> Eq StrftimeError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StrftimeError -> StrftimeError -> Bool
== :: StrftimeError -> StrftimeError -> Bool
$c/= :: StrftimeError -> StrftimeError -> Bool
/= :: StrftimeError -> StrftimeError -> Bool
Eq, Int -> StrftimeError -> ShowS
[StrftimeError] -> ShowS
StrftimeError -> String
(Int -> StrftimeError -> ShowS)
-> (StrftimeError -> String)
-> ([StrftimeError] -> ShowS)
-> Show StrftimeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StrftimeError -> ShowS
showsPrec :: Int -> StrftimeError -> ShowS
$cshow :: StrftimeError -> String
show :: StrftimeError -> String
$cshowList :: [StrftimeError] -> ShowS
showList :: [StrftimeError] -> ShowS
Show, Typeable)

instance Exception StrftimeError

-- | A literal chunk of the layout as a field pattern: it consumes\/emits the given text and leaves the value untouched.
--   Because it has the ordinary field-pattern shape it composes with '<>' like any other field, so literals anywhere in
--   the layout (including at the very start) need no special handling.
litField :: String -> Pattern (a -> a) (a -> String) String
litField :: forall a. String -> Pattern (a -> a) (a -> String) String
litField String
s = Parser (a -> a) String
-> Format String (a -> String)
-> Pattern (a -> a) (a -> String) String
forall a b r. Parser a r -> Format r b -> Pattern a b r
Pattern (a -> a
forall a. a -> a
id (a -> a)
-> ParsecT String () Identity String -> Parser (a -> a) String
forall a b.
a -> ParsecT String () Identity b -> ParsecT String () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string String
s) ((a -> Builder) -> Format String (a -> String)
forall a r. (a -> Builder) -> Format r (a -> r)
later (Builder -> a -> Builder
forall a b. a -> b -> a
const (Text -> Builder
TLB.fromText (String -> Text
T.pack String
s))))

-- | A single token of a layout string, after composite specifiers have been expanded.
data Tok = Lit Char | Conv Char

-- | A run of literal characters or a single conversion specifier.
data Frag = LitRun String | ConvF Char

-- | Tokenise a layout string, expanding the composite specifiers (@%T@, @%R@, @%r@, @%F@, @%D@) into their parts.
tokenize :: String -> Either StrftimeError [Tok]
tokenize :: String -> Either StrftimeError [Tok]
tokenize [] = [Tok] -> Either StrftimeError [Tok]
forall a b. b -> Either a b
Right []
tokenize (Char
'%':Char
c:String
rest) = case Char
c of
  Char
'%' -> (Char -> Tok
Lit Char
'%' Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:)  ([Tok] -> [Tok])
-> Either StrftimeError [Tok] -> Either StrftimeError [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either StrftimeError [Tok]
tokenize String
rest
  Char
'n' -> (Char -> Tok
Lit Char
'\n' Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:) ([Tok] -> [Tok])
-> Either StrftimeError [Tok] -> Either StrftimeError [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either StrftimeError [Tok]
tokenize String
rest
  Char
't' -> (Char -> Tok
Lit Char
'\t' Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:) ([Tok] -> [Tok])
-> Either StrftimeError [Tok] -> Either StrftimeError [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either StrftimeError [Tok]
tokenize String
rest
  Char
'T' -> String -> Either StrftimeError [Tok]
tokenize (String
"%H:%M:%S" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
rest)
  Char
'R' -> String -> Either StrftimeError [Tok]
tokenize (String
"%H:%M" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
rest)
  Char
'r' -> String -> Either StrftimeError [Tok]
tokenize (String
"%I:%M:%S %p" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
rest)
  Char
'F' -> String -> Either StrftimeError [Tok]
tokenize (String
"%Y-%m-%d" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
rest)
  Char
'D' -> String -> Either StrftimeError [Tok]
tokenize (String
"%m/%d/%y" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
rest)
  Char
_   -> (Char -> Tok
Conv Char
c Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:) ([Tok] -> [Tok])
-> Either StrftimeError [Tok] -> Either StrftimeError [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either StrftimeError [Tok]
tokenize String
rest
tokenize [Char
'%'] = StrftimeError -> Either StrftimeError [Tok]
forall a b. a -> Either a b
Left StrftimeError
DanglingPercent
tokenize (Char
c:String
rest) = (Char -> Tok
Lit Char
c Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:) ([Tok] -> [Tok])
-> Either StrftimeError [Tok] -> Either StrftimeError [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either StrftimeError [Tok]
tokenize String
rest

-- | Merge adjacent literal characters into runs so each becomes a single 'litField'.
toFrags :: [Tok] -> [Frag]
toFrags :: [Tok] -> [Frag]
toFrags = (Tok -> [Frag] -> [Frag]) -> [Frag] -> [Tok] -> [Frag]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Tok -> [Frag] -> [Frag]
step []
  where
    step :: Tok -> [Frag] -> [Frag]
step (Lit Char
c)  (LitRun String
s : [Frag]
fs) = String -> Frag
LitRun (Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String
s) Frag -> [Frag] -> [Frag]
forall a. a -> [a] -> [a]
: [Frag]
fs
    step (Lit Char
c)  [Frag]
fs              = String -> Frag
LitRun [Char
c] Frag -> [Frag] -> [Frag]
forall a. a -> [a] -> [a]
: [Frag]
fs
    step (Conv Char
c) [Frag]
fs              = Char -> Frag
ConvF Char
c Frag -> [Frag] -> [Frag]
forall a. a -> [a] -> [a]
: [Frag]
fs

-- | Assemble a list of fragments into a pattern, given a mapping from conversion specifiers to field patterns.
assemble
  :: (Char -> Either StrftimeError (Pattern (a -> a) (a -> String) String))
  -> [Frag]
  -> Either StrftimeError (Pattern (a -> a) (a -> String) String)
assemble :: forall a.
(Char
 -> Either StrftimeError (Pattern (a -> a) (a -> String) String))
-> [Frag]
-> Either StrftimeError (Pattern (a -> a) (a -> String) String)
assemble Char
-> Either StrftimeError (Pattern (a -> a) (a -> String) String)
mapConv [Frag]
frags = do
  [Pattern (a -> a) (a -> String) String]
ps <- (Frag
 -> Either StrftimeError (Pattern (a -> a) (a -> String) String))
-> [Frag]
-> Either StrftimeError [Pattern (a -> a) (a -> String) String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Frag
-> Either StrftimeError (Pattern (a -> a) (a -> String) String)
toPat [Frag]
frags
  case [Pattern (a -> a) (a -> String) String]
ps of
    [] -> Pattern (a -> a) (a -> String) String
-> Either StrftimeError (Pattern (a -> a) (a -> String) String)
forall a b. b -> Either a b
Right (String -> Pattern (a -> a) (a -> String) String
forall a. String -> Pattern (a -> a) (a -> String) String
litField String
"")
    [Pattern (a -> a) (a -> String) String]
_  -> Pattern (a -> a) (a -> String) String
-> Either StrftimeError (Pattern (a -> a) (a -> String) String)
forall a b. b -> Either a b
Right ((Pattern (a -> a) (a -> String) String
 -> Pattern (a -> a) (a -> String) String
 -> Pattern (a -> a) (a -> String) String)
-> [Pattern (a -> a) (a -> String) String]
-> Pattern (a -> a) (a -> String) String
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Pattern (a -> a) (a -> String) String
-> Pattern (a -> a) (a -> String) String
-> Pattern (a -> a) (a -> String) String
forall a. Semigroup a => a -> a -> a
(<>) [Pattern (a -> a) (a -> String) String]
ps)
  where
    toPat :: Frag
-> Either StrftimeError (Pattern (a -> a) (a -> String) String)
toPat (LitRun String
s) = Pattern (a -> a) (a -> String) String
-> Either StrftimeError (Pattern (a -> a) (a -> String) String)
forall a b. b -> Either a b
Right (String -> Pattern (a -> a) (a -> String) String
forall a. String -> Pattern (a -> a) (a -> String) String
litField String
s)
    toPat (ConvF Char
c)  = Char
-> Either StrftimeError (Pattern (a -> a) (a -> String) String)
mapConv Char
c

-- | Compile a layout string into a pattern, given a specifier mapping.
compileWith
  :: (Char -> Either StrftimeError (Pattern (a -> a) (a -> String) String))
  -> String
  -> Either StrftimeError (Pattern (a -> a) (a -> String) String)
compileWith :: forall a.
(Char
 -> Either StrftimeError (Pattern (a -> a) (a -> String) String))
-> String
-> Either StrftimeError (Pattern (a -> a) (a -> String) String)
compileWith Char
-> Either StrftimeError (Pattern (a -> a) (a -> String) String)
mapConv String
fmtStr = String -> Either StrftimeError [Tok]
tokenize String
fmtStr Either StrftimeError [Tok]
-> ([Tok]
    -> Either StrftimeError (Pattern (a -> a) (a -> String) String))
-> Either StrftimeError (Pattern (a -> a) (a -> String) String)
forall a b.
Either StrftimeError a
-> (a -> Either StrftimeError b) -> Either StrftimeError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Char
 -> Either StrftimeError (Pattern (a -> a) (a -> String) String))
-> [Frag]
-> Either StrftimeError (Pattern (a -> a) (a -> String) String)
forall a.
(Char
 -> Either StrftimeError (Pattern (a -> a) (a -> String) String))
-> [Frag]
-> Either StrftimeError (Pattern (a -> a) (a -> String) String)
assemble Char
-> Either StrftimeError (Pattern (a -> a) (a -> String) String)
mapConv ([Frag]
 -> Either StrftimeError (Pattern (a -> a) (a -> String) String))
-> ([Tok] -> [Frag])
-> [Tok]
-> Either StrftimeError (Pattern (a -> a) (a -> String) String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> [Frag]
toFrags

-- | As 'compileWith' but first drops the zone specifiers (@%Z@\/@%z@) and a single preceding space; used for the
--   combined date-and-time layout, whose 'CalendarDateTime' target has no zone.
compileDroppingZones
  :: (Char -> Either StrftimeError (Pattern (a -> a) (a -> String) String))
  -> String
  -> Either StrftimeError (Pattern (a -> a) (a -> String) String)
compileDroppingZones :: forall a.
(Char
 -> Either StrftimeError (Pattern (a -> a) (a -> String) String))
-> String
-> Either StrftimeError (Pattern (a -> a) (a -> String) String)
compileDroppingZones Char
-> Either StrftimeError (Pattern (a -> a) (a -> String) String)
mapConv String
fmtStr = String -> Either StrftimeError [Tok]
tokenize String
fmtStr Either StrftimeError [Tok]
-> ([Tok]
    -> Either StrftimeError (Pattern (a -> a) (a -> String) String))
-> Either StrftimeError (Pattern (a -> a) (a -> String) String)
forall a b.
Either StrftimeError a
-> (a -> Either StrftimeError b) -> Either StrftimeError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Char
 -> Either StrftimeError (Pattern (a -> a) (a -> String) String))
-> [Frag]
-> Either StrftimeError (Pattern (a -> a) (a -> String) String)
forall a.
(Char
 -> Either StrftimeError (Pattern (a -> a) (a -> String) String))
-> [Frag]
-> Either StrftimeError (Pattern (a -> a) (a -> String) String)
assemble Char
-> Either StrftimeError (Pattern (a -> a) (a -> String) String)
mapConv ([Frag]
 -> Either StrftimeError (Pattern (a -> a) (a -> String) String))
-> ([Tok] -> [Frag])
-> [Tok]
-> Either StrftimeError (Pattern (a -> a) (a -> String) String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Frag] -> [Frag]
stripZones ([Frag] -> [Frag]) -> ([Tok] -> [Frag]) -> [Tok] -> [Frag]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> [Frag]
toFrags

-- | Drop the zone specifiers (@%Z@\/@%z@) and a single preceding space: a 'CalendarDateTime' has no zone to show.
stripZones :: [Frag] -> [Frag]
stripZones :: [Frag] -> [Frag]
stripZones [] = []
stripZones (LitRun String
s : ConvF Char
c : [Frag]
rest)
  | Char -> Bool
isZone Char
c  = [String -> Frag
LitRun String
s' | Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s')] [Frag] -> [Frag] -> [Frag]
forall a. [a] -> [a] -> [a]
++ [Frag] -> [Frag]
stripZones [Frag]
rest
  where s' :: String
s' = ShowS
forall a. [a] -> [a]
reverse ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (ShowS
forall a. [a] -> [a]
reverse String
s))
stripZones (ConvF Char
c : [Frag]
rest)
  | Char -> Bool
isZone Char
c  = [Frag] -> [Frag]
stripZones [Frag]
rest
stripZones (Frag
f : [Frag]
rest) = Frag
f Frag -> [Frag] -> [Frag]
forall a. a -> [a] -> [a]
: [Frag] -> [Frag]
stripZones [Frag]
rest

isZone :: Char -> Bool
isZone :: Char -> Bool
isZone Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'Z' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'z'

dateConv :: (HasDate d, Enum (MoY d), Enum (DoW d)) => Locale -> Char -> Either StrftimeError (Pattern (d -> d) (d -> String) String)
dateConv :: forall d.
(HasDate d, Enum (MoY d), Enum (DoW d)) =>
Locale
-> Char
-> Either StrftimeError (Pattern (d -> d) (d -> String) String)
dateConv Locale
loc Char
c = case Char
c of
  Char
'Y' -> Pattern (d -> d) (d -> String) String
-> Either StrftimeError (Pattern (d -> d) (d -> String) String)
forall a b. b -> Either a b
Right Pattern (d -> d) (d -> String) String
forall d. HasDate d => Pattern (d -> d) (d -> String) String
pyyyy
  Char
'y' -> Pattern (d -> d) (d -> String) String
-> Either StrftimeError (Pattern (d -> d) (d -> String) String)
forall a b. b -> Either a b
Right Pattern (d -> d) (d -> String) String
forall d. HasDate d => Pattern (d -> d) (d -> String) String
pyy
  Char
'm' -> Pattern (d -> d) (d -> String) String
-> Either StrftimeError (Pattern (d -> d) (d -> String) String)
forall a b. b -> Either a b
Right Pattern (d -> d) (d -> String) String
forall d.
(HasDate d, Enum (MoY d)) =>
Pattern (d -> d) (d -> String) String
pMM
  Char
'd' -> Pattern (d -> d) (d -> String) String
-> Either StrftimeError (Pattern (d -> d) (d -> String) String)
forall a b. b -> Either a b
Right Pattern (d -> d) (d -> String) String
forall d. HasDate d => Pattern (d -> d) (d -> String) String
pdd
  Char
'e' -> Pattern (d -> d) (d -> String) String
-> Either StrftimeError (Pattern (d -> d) (d -> String) String)
forall a b. b -> Either a b
Right Pattern (d -> d) (d -> String) String
forall d. HasDate d => Pattern (d -> d) (d -> String) String
pdaySpace
  Char
'B' -> Pattern (d -> d) (d -> String) String
-> Either StrftimeError (Pattern (d -> d) (d -> String) String)
forall a b. b -> Either a b
Right (Locale -> Pattern (d -> d) (d -> String) String
forall d.
(HasDate d, Enum (MoY d)) =>
Locale -> Pattern (d -> d) (d -> String) String
pMMMM' Locale
loc)
  Char
'b' -> Pattern (d -> d) (d -> String) String
-> Either StrftimeError (Pattern (d -> d) (d -> String) String)
forall a b. b -> Either a b
Right (Locale -> Pattern (d -> d) (d -> String) String
forall d.
(HasDate d, Enum (MoY d)) =>
Locale -> Pattern (d -> d) (d -> String) String
pMMM' Locale
loc)
  Char
'h' -> Pattern (d -> d) (d -> String) String
-> Either StrftimeError (Pattern (d -> d) (d -> String) String)
forall a b. b -> Either a b
Right (Locale -> Pattern (d -> d) (d -> String) String
forall d.
(HasDate d, Enum (MoY d)) =>
Locale -> Pattern (d -> d) (d -> String) String
pMMM' Locale
loc)
  Char
'A' -> Pattern (d -> d) (d -> String) String
-> Either StrftimeError (Pattern (d -> d) (d -> String) String)
forall a b. b -> Either a b
Right (Locale -> Pattern (d -> d) (d -> String) String
forall d.
(HasDate d, Enum (DoW d)) =>
Locale -> Pattern (d -> d) (d -> String) String
pdddd' Locale
loc)
  Char
'a' -> Pattern (d -> d) (d -> String) String
-> Either StrftimeError (Pattern (d -> d) (d -> String) String)
forall a b. b -> Either a b
Right (Locale -> Pattern (d -> d) (d -> String) String
forall d.
(HasDate d, Enum (DoW d)) =>
Locale -> Pattern (d -> d) (d -> String) String
pddd' Locale
loc)
  Char
_   -> StrftimeError
-> Either StrftimeError (Pattern (d -> d) (d -> String) String)
forall a b. a -> Either a b
Left (Char -> StrftimeError
UnsupportedSpecifier Char
c)

timeConv :: HasLocalTime lt => Locale -> Char -> Either StrftimeError (Pattern (lt -> lt) (lt -> String) String)
timeConv :: forall lt.
HasLocalTime lt =>
Locale
-> Char
-> Either StrftimeError (Pattern (lt -> lt) (lt -> String) String)
timeConv Locale
loc Char
c = case Char
c of
  Char
'H' -> Pattern (lt -> lt) (lt -> String) String
-> Either StrftimeError (Pattern (lt -> lt) (lt -> String) String)
forall a b. b -> Either a b
Right Pattern (lt -> lt) (lt -> String) String
forall lt.
HasLocalTime lt =>
Pattern (lt -> lt) (lt -> String) String
pHH
  Char
'I' -> Pattern (lt -> lt) (lt -> String) String
-> Either StrftimeError (Pattern (lt -> lt) (lt -> String) String)
forall a b. b -> Either a b
Right Pattern (lt -> lt) (lt -> String) String
forall lt.
HasLocalTime lt =>
Pattern (lt -> lt) (lt -> String) String
phh
  Char
'l' -> Pattern (lt -> lt) (lt -> String) String
-> Either StrftimeError (Pattern (lt -> lt) (lt -> String) String)
forall a b. b -> Either a b
Right Pattern (lt -> lt) (lt -> String) String
forall lt.
HasLocalTime lt =>
Pattern (lt -> lt) (lt -> String) String
phhSpace
  Char
'M' -> Pattern (lt -> lt) (lt -> String) String
-> Either StrftimeError (Pattern (lt -> lt) (lt -> String) String)
forall a b. b -> Either a b
Right Pattern (lt -> lt) (lt -> String) String
forall lt.
HasLocalTime lt =>
Pattern (lt -> lt) (lt -> String) String
pmm
  Char
'S' -> Pattern (lt -> lt) (lt -> String) String
-> Either StrftimeError (Pattern (lt -> lt) (lt -> String) String)
forall a b. b -> Either a b
Right Pattern (lt -> lt) (lt -> String) String
forall lt.
HasLocalTime lt =>
Pattern (lt -> lt) (lt -> String) String
pss
  Char
'p' -> Pattern (lt -> lt) (lt -> String) String
-> Either StrftimeError (Pattern (lt -> lt) (lt -> String) String)
forall a b. b -> Either a b
Right (Locale -> Pattern (lt -> lt) (lt -> String) String
forall lt.
HasLocalTime lt =>
Locale -> Pattern (lt -> lt) (lt -> String) String
ppp' Locale
loc)
  Char
_   -> StrftimeError
-> Either StrftimeError (Pattern (lt -> lt) (lt -> String) String)
forall a b. a -> Either a b
Left (Char -> StrftimeError
UnsupportedSpecifier Char
c)

-- | Compile an explicit @strftime@ date layout against a 'Locale' (the locale supplies month\/weekday names for @%B@,
--   @%b@, @%A@, @%a@).  Throws a 'StrftimeError' on an unsupported specifier.
compileDatePattern :: (MonadThrow m, HasDate d, Enum (MoY d), Enum (DoW d)) => Locale -> String -> m (Pattern (d -> d) (d -> String) String)
compileDatePattern :: forall (m :: * -> *) d.
(MonadThrow m, HasDate d, Enum (MoY d), Enum (DoW d)) =>
Locale -> String -> m (Pattern (d -> d) (d -> String) String)
compileDatePattern Locale
loc = (StrftimeError -> m (Pattern (d -> d) (d -> String) String))
-> (Pattern (d -> d) (d -> String) String
    -> m (Pattern (d -> d) (d -> String) String))
-> Either StrftimeError (Pattern (d -> d) (d -> String) String)
-> m (Pattern (d -> d) (d -> String) String)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either StrftimeError -> m (Pattern (d -> d) (d -> String) String)
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM Pattern (d -> d) (d -> String) String
-> m (Pattern (d -> d) (d -> String) String)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StrftimeError (Pattern (d -> d) (d -> String) String)
 -> m (Pattern (d -> d) (d -> String) String))
-> (String
    -> Either StrftimeError (Pattern (d -> d) (d -> String) String))
-> String
-> m (Pattern (d -> d) (d -> String) String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
 -> Either StrftimeError (Pattern (d -> d) (d -> String) String))
-> String
-> Either StrftimeError (Pattern (d -> d) (d -> String) String)
forall a.
(Char
 -> Either StrftimeError (Pattern (a -> a) (a -> String) String))
-> String
-> Either StrftimeError (Pattern (a -> a) (a -> String) String)
compileWith (Locale
-> Char
-> Either StrftimeError (Pattern (d -> d) (d -> String) String)
forall d.
(HasDate d, Enum (MoY d), Enum (DoW d)) =>
Locale
-> Char
-> Either StrftimeError (Pattern (d -> d) (d -> String) String)
dateConv Locale
loc)

-- | Compile an explicit @strftime@ time layout against a 'Locale' (the locale supplies the AM\/PM designators for
--   @%p@).  Throws a 'StrftimeError' on an unsupported specifier.
compileTimePattern :: (MonadThrow m, HasLocalTime lt) => Locale -> String -> m (Pattern (lt -> lt) (lt -> String) String)
compileTimePattern :: forall (m :: * -> *) lt.
(MonadThrow m, HasLocalTime lt) =>
Locale -> String -> m (Pattern (lt -> lt) (lt -> String) String)
compileTimePattern Locale
loc = (StrftimeError -> m (Pattern (lt -> lt) (lt -> String) String))
-> (Pattern (lt -> lt) (lt -> String) String
    -> m (Pattern (lt -> lt) (lt -> String) String))
-> Either StrftimeError (Pattern (lt -> lt) (lt -> String) String)
-> m (Pattern (lt -> lt) (lt -> String) String)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either StrftimeError -> m (Pattern (lt -> lt) (lt -> String) String)
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM Pattern (lt -> lt) (lt -> String) String
-> m (Pattern (lt -> lt) (lt -> String) String)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StrftimeError (Pattern (lt -> lt) (lt -> String) String)
 -> m (Pattern (lt -> lt) (lt -> String) String))
-> (String
    -> Either StrftimeError (Pattern (lt -> lt) (lt -> String) String))
-> String
-> m (Pattern (lt -> lt) (lt -> String) String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
 -> Either StrftimeError (Pattern (lt -> lt) (lt -> String) String))
-> String
-> Either StrftimeError (Pattern (lt -> lt) (lt -> String) String)
forall a.
(Char
 -> Either StrftimeError (Pattern (a -> a) (a -> String) String))
-> String
-> Either StrftimeError (Pattern (a -> a) (a -> String) String)
compileWith (Locale
-> Char
-> Either StrftimeError (Pattern (lt -> lt) (lt -> String) String)
forall lt.
HasLocalTime lt =>
Locale
-> Char
-> Either StrftimeError (Pattern (lt -> lt) (lt -> String) String)
timeConv Locale
loc)

-- | The locale's short date pattern, compiled from its short-date layout (@rawDateFormat@; @D_FMT@ on POSIX).
localeDatePattern :: (MonadThrow m, HasDate d, Enum (MoY d), Enum (DoW d)) => Locale -> m (Pattern (d -> d) (d -> String) String)
localeDatePattern :: forall (m :: * -> *) d.
(MonadThrow m, HasDate d, Enum (MoY d), Enum (DoW d)) =>
Locale -> m (Pattern (d -> d) (d -> String) String)
localeDatePattern Locale
loc = Locale -> String -> m (Pattern (d -> d) (d -> String) String)
forall (m :: * -> *) d.
(MonadThrow m, HasDate d, Enum (MoY d), Enum (DoW d)) =>
Locale -> String -> m (Pattern (d -> d) (d -> String) String)
compileDatePattern Locale
loc (Locale -> String
rawDateFormat Locale
loc)

-- | The locale's time pattern, compiled from its time layout (@rawTimeFormat@; @T_FMT@ on POSIX).
localeTimePattern :: (MonadThrow m, HasLocalTime lt) => Locale -> m (Pattern (lt -> lt) (lt -> String) String)
localeTimePattern :: forall (m :: * -> *) lt.
(MonadThrow m, HasLocalTime lt) =>
Locale -> m (Pattern (lt -> lt) (lt -> String) String)
localeTimePattern Locale
loc = Locale -> String -> m (Pattern (lt -> lt) (lt -> String) String)
forall (m :: * -> *) lt.
(MonadThrow m, HasLocalTime lt) =>
Locale -> String -> m (Pattern (lt -> lt) (lt -> String) String)
compileTimePattern Locale
loc (Locale -> String
rawTimeFormat Locale
loc)

-- | Combined date-and-time mapping over 'CalendarDateTime': a date specifier resolves to its date field and a time
--   specifier to its time field (both are valid on a 'CalendarDateTime', which is 'HasDate' and 'HasLocalTime').
dateTimeConv :: (IsCalendar cal, Enum (Month cal), Enum (DoW (CalendarDateTime cal))) => Locale -> Char -> Either StrftimeError (Pattern (CalendarDateTime cal -> CalendarDateTime cal) (CalendarDateTime cal -> String) String)
dateTimeConv :: forall cal.
(IsCalendar cal, Enum (Month cal),
 Enum (DoW (CalendarDateTime cal))) =>
Locale
-> Char
-> Either
     StrftimeError
     (Pattern
        (CalendarDateTime cal -> CalendarDateTime cal)
        (CalendarDateTime cal -> String)
        String)
dateTimeConv Locale
loc Char
c = case Locale
-> Char
-> Either
     StrftimeError
     (Pattern
        (CalendarDateTime cal -> CalendarDateTime cal)
        (CalendarDateTime cal -> String)
        String)
forall d.
(HasDate d, Enum (MoY d), Enum (DoW d)) =>
Locale
-> Char
-> Either StrftimeError (Pattern (d -> d) (d -> String) String)
dateConv Locale
loc Char
c of
  Right Pattern
  (CalendarDateTime cal -> CalendarDateTime cal)
  (CalendarDateTime cal -> String)
  String
p -> Pattern
  (CalendarDateTime cal -> CalendarDateTime cal)
  (CalendarDateTime cal -> String)
  String
-> Either
     StrftimeError
     (Pattern
        (CalendarDateTime cal -> CalendarDateTime cal)
        (CalendarDateTime cal -> String)
        String)
forall a b. b -> Either a b
Right Pattern
  (CalendarDateTime cal -> CalendarDateTime cal)
  (CalendarDateTime cal -> String)
  String
p
  Left StrftimeError
_  -> Locale
-> Char
-> Either
     StrftimeError
     (Pattern
        (CalendarDateTime cal -> CalendarDateTime cal)
        (CalendarDateTime cal -> String)
        String)
forall lt.
HasLocalTime lt =>
Locale
-> Char
-> Either StrftimeError (Pattern (lt -> lt) (lt -> String) String)
timeConv Locale
loc Char
c

-- | The locale's combined date-and-time pattern, compiled from its combined layout (@rawDateTimeFormat@; @D_T_FMT@ on
--   POSIX) as a 'CalendarDateTime'.  The zone specifiers @%Z@\/@%z@ are dropped — see the note on time zones in the
--   module header.
localeDateTimePattern :: (MonadThrow m, IsCalendar cal, Enum (Month cal), Enum (DoW (CalendarDateTime cal))) => Locale -> m (Pattern (CalendarDateTime cal -> CalendarDateTime cal) (CalendarDateTime cal -> String) String)
localeDateTimePattern :: forall (m :: * -> *) cal.
(MonadThrow m, IsCalendar cal, Enum (Month cal),
 Enum (DoW (CalendarDateTime cal))) =>
Locale
-> m (Pattern
        (CalendarDateTime cal -> CalendarDateTime cal)
        (CalendarDateTime cal -> String)
        String)
localeDateTimePattern Locale
loc = (StrftimeError
 -> m (Pattern
         (CalendarDateTime cal -> CalendarDateTime cal)
         (CalendarDateTime cal -> String)
         String))
-> (Pattern
      (CalendarDateTime cal -> CalendarDateTime cal)
      (CalendarDateTime cal -> String)
      String
    -> m (Pattern
            (CalendarDateTime cal -> CalendarDateTime cal)
            (CalendarDateTime cal -> String)
            String))
-> Either
     StrftimeError
     (Pattern
        (CalendarDateTime cal -> CalendarDateTime cal)
        (CalendarDateTime cal -> String)
        String)
-> m (Pattern
        (CalendarDateTime cal -> CalendarDateTime cal)
        (CalendarDateTime cal -> String)
        String)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either StrftimeError
-> m (Pattern
        (CalendarDateTime cal -> CalendarDateTime cal)
        (CalendarDateTime cal -> String)
        String)
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM Pattern
  (CalendarDateTime cal -> CalendarDateTime cal)
  (CalendarDateTime cal -> String)
  String
-> m (Pattern
        (CalendarDateTime cal -> CalendarDateTime cal)
        (CalendarDateTime cal -> String)
        String)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Char
 -> Either
      StrftimeError
      (Pattern
         (CalendarDateTime cal -> CalendarDateTime cal)
         (CalendarDateTime cal -> String)
         String))
-> String
-> Either
     StrftimeError
     (Pattern
        (CalendarDateTime cal -> CalendarDateTime cal)
        (CalendarDateTime cal -> String)
        String)
forall a.
(Char
 -> Either StrftimeError (Pattern (a -> a) (a -> String) String))
-> String
-> Either StrftimeError (Pattern (a -> a) (a -> String) String)
compileDroppingZones (Locale
-> Char
-> Either
     StrftimeError
     (Pattern
        (CalendarDateTime cal -> CalendarDateTime cal)
        (CalendarDateTime cal -> String)
        String)
forall cal.
(IsCalendar cal, Enum (Month cal),
 Enum (DoW (CalendarDateTime cal))) =>
Locale
-> Char
-> Either
     StrftimeError
     (Pattern
        (CalendarDateTime cal -> CalendarDateTime cal)
        (CalendarDateTime cal -> String)
        String)
dateTimeConv Locale
loc) (Locale -> String
rawDateTimeFormat Locale
loc))

-- | Thrown by 'parseZonedDateTime' when the locale's @D_T_FMT@ has no zone (@%Z@): such a layout describes civil time,
--   not a zoned value, so use 'localeDateTimePattern' for it instead.
newtype ZonelessLayoutException = ZonelessLayout String   -- ^ carries the offending locale's id
  deriving (ZonelessLayoutException -> ZonelessLayoutException -> Bool
(ZonelessLayoutException -> ZonelessLayoutException -> Bool)
-> (ZonelessLayoutException -> ZonelessLayoutException -> Bool)
-> Eq ZonelessLayoutException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ZonelessLayoutException -> ZonelessLayoutException -> Bool
== :: ZonelessLayoutException -> ZonelessLayoutException -> Bool
$c/= :: ZonelessLayoutException -> ZonelessLayoutException -> Bool
/= :: ZonelessLayoutException -> ZonelessLayoutException -> Bool
Eq, Int -> ZonelessLayoutException -> ShowS
[ZonelessLayoutException] -> ShowS
ZonelessLayoutException -> String
(Int -> ZonelessLayoutException -> ShowS)
-> (ZonelessLayoutException -> String)
-> ([ZonelessLayoutException] -> ShowS)
-> Show ZonelessLayoutException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ZonelessLayoutException -> ShowS
showsPrec :: Int -> ZonelessLayoutException -> ShowS
$cshow :: ZonelessLayoutException -> String
show :: ZonelessLayoutException -> String
$cshowList :: [ZonelessLayoutException] -> ShowS
showList :: [ZonelessLayoutException] -> ShowS
Show, Typeable)

instance Exception ZonelessLayoutException

-- | Parse a zoned date\/time written in the locale's @D_T_FMT@ into a 'ZonedDateTime'.  The local part is read from the
--   layout and the trailing @%Z@ token is captured and handed to the /provider/ (abbreviations such as @CEST@ are
--   ambiguous, so you supply the mapping to a real 'TimeZone'); the /resolver/ then decides skipped\/ambiguous local
--   times (e.g. @fromCalendarDateTimeStrictly@).  Throws 'ZonelessLayoutException' if the locale's layout has no @%Z@
--   (a layout with no zone is not a zoned value).
parseZonedDateTime
  :: (MonadThrow m, IsCalendar cal, Enum (Month cal), Enum (DoW (CalendarDateTime cal)))
  => (String -> m TimeZone)
  -> (CalendarDateTime cal -> TimeZone -> m (ZonedDateTime cal))
  -> Locale
  -> String
  -> m (ZonedDateTime cal)
parseZonedDateTime :: forall (m :: * -> *) cal.
(MonadThrow m, IsCalendar cal, Enum (Month cal),
 Enum (DoW (CalendarDateTime cal))) =>
(String -> m TimeZone)
-> (CalendarDateTime cal -> TimeZone -> m (ZonedDateTime cal))
-> Locale
-> String
-> m (ZonedDateTime cal)
parseZonedDateTime String -> m TimeZone
provider CalendarDateTime cal -> TimeZone -> m (ZonedDateTime cal)
resolve Locale
loc String
s
  | String -> Bool
hasZoneSpecifier (Locale -> String
rawDateTimeFormat Locale
loc) = Locale
-> m (Pattern
        (CalendarDateTime cal -> CalendarDateTime cal)
        (CalendarDateTime cal -> String)
        String)
forall (m :: * -> *) cal.
(MonadThrow m, IsCalendar cal, Enum (Month cal),
 Enum (DoW (CalendarDateTime cal))) =>
Locale
-> m (Pattern
        (CalendarDateTime cal -> CalendarDateTime cal)
        (CalendarDateTime cal -> String)
        String)
localeDateTimePattern Locale
loc m (Pattern
     (CalendarDateTime cal -> CalendarDateTime cal)
     (CalendarDateTime cal -> String)
     String)
-> (Pattern
      (CalendarDateTime cal -> CalendarDateTime cal)
      (CalendarDateTime cal -> String)
      String
    -> 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
>>= \Pattern
  (CalendarDateTime cal -> CalendarDateTime cal)
  (CalendarDateTime cal -> String)
  String
localPat -> Pattern
  (CalendarDateTime cal -> CalendarDateTime cal)
  (CalendarDateTime cal -> String)
  String
-> (String -> m TimeZone)
-> (CalendarDateTime cal -> TimeZone -> m (ZonedDateTime cal))
-> String
-> m (ZonedDateTime cal)
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)
  (CalendarDateTime cal -> String)
  String
localPat String -> m TimeZone
provider CalendarDateTime cal -> TimeZone -> m (ZonedDateTime cal)
resolve String
s
  | Bool
otherwise                                = ZonelessLayoutException -> m (ZonedDateTime cal)
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (String -> ZonelessLayoutException
ZonelessLayout (Locale -> String
localeId Locale
loc))

-- | Does a @strftime@ layout contain the zone specifier @%Z@ (respecting @%%@)?
hasZoneSpecifier :: String -> Bool
hasZoneSpecifier :: String -> Bool
hasZoneSpecifier (Char
'%':Char
'%':String
rest) = String -> Bool
hasZoneSpecifier String
rest
hasZoneSpecifier (Char
'%':Char
'Z':String
_)    = Bool
True
hasZoneSpecifier (Char
'%':Char
_:String
rest)   = String -> Bool
hasZoneSpecifier String
rest
hasZoneSpecifier (Char
_:String
rest)       = String -> Bool
hasZoneSpecifier String
rest
hasZoneSpecifier []             = Bool
False

-- | Thrown by 'localeOffsetDateTimePattern' when the locale's @D_T_FMT@ has no numeric offset (@%z@).
newtype OffsetlessLayoutException = OffsetlessLayout String   -- ^ carries the offending locale's id
  deriving (OffsetlessLayoutException -> OffsetlessLayoutException -> Bool
(OffsetlessLayoutException -> OffsetlessLayoutException -> Bool)
-> (OffsetlessLayoutException -> OffsetlessLayoutException -> Bool)
-> Eq OffsetlessLayoutException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OffsetlessLayoutException -> OffsetlessLayoutException -> Bool
== :: OffsetlessLayoutException -> OffsetlessLayoutException -> Bool
$c/= :: OffsetlessLayoutException -> OffsetlessLayoutException -> Bool
/= :: OffsetlessLayoutException -> OffsetlessLayoutException -> Bool
Eq, Int -> OffsetlessLayoutException -> ShowS
[OffsetlessLayoutException] -> ShowS
OffsetlessLayoutException -> String
(Int -> OffsetlessLayoutException -> ShowS)
-> (OffsetlessLayoutException -> String)
-> ([OffsetlessLayoutException] -> ShowS)
-> Show OffsetlessLayoutException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OffsetlessLayoutException -> ShowS
showsPrec :: Int -> OffsetlessLayoutException -> ShowS
$cshow :: OffsetlessLayoutException -> String
show :: OffsetlessLayoutException -> String
$cshowList :: [OffsetlessLayoutException] -> ShowS
showList :: [OffsetlessLayoutException] -> ShowS
Show, Typeable)

instance Exception OffsetlessLayoutException

-- | Compile the locale's @D_T_FMT@ into an 'OffsetDateTime' pattern, using its numeric offset (@%z@, e.g. @+0200@).
--   Unlike 'parseZonedDateTime' this is a plain, /pure/, bidirectional pattern (drive it with 'Data.HodaTime.Pattern.parse'
--   and 'Data.HodaTime.Pattern.format') because a numeric offset is unambiguous — no zone provider or resolver is
--   needed.  Throws 'OffsetlessLayoutException' if the layout has no @%z@ (the abbreviation form @%Z@ is not an offset;
--   use 'parseZonedDateTime' for that).
localeOffsetDateTimePattern
  :: (MonadThrow m, IsCalendar cal, Enum (Month cal), Enum (DoW (CalendarDateTime cal)))
  => Locale
  -> m (Pattern (OffsetDateTime cal -> OffsetDateTime cal) (OffsetDateTime cal -> String) String)
localeOffsetDateTimePattern :: forall (m :: * -> *) cal.
(MonadThrow m, IsCalendar cal, Enum (Month cal),
 Enum (DoW (CalendarDateTime cal))) =>
Locale
-> m (Pattern
        (OffsetDateTime cal -> OffsetDateTime cal)
        (OffsetDateTime cal -> String)
        String)
localeOffsetDateTimePattern Locale
loc
  | String -> Bool
hasOffsetSpecifier String
fmt = (StrftimeError
 -> m (Pattern
         (OffsetDateTime cal -> OffsetDateTime cal)
         (OffsetDateTime cal -> String)
         String))
-> (Pattern
      (OffsetDateTime cal -> OffsetDateTime cal)
      (OffsetDateTime cal -> String)
      String
    -> m (Pattern
            (OffsetDateTime cal -> OffsetDateTime cal)
            (OffsetDateTime cal -> String)
            String))
-> Either
     StrftimeError
     (Pattern
        (OffsetDateTime cal -> OffsetDateTime cal)
        (OffsetDateTime cal -> String)
        String)
-> m (Pattern
        (OffsetDateTime cal -> OffsetDateTime cal)
        (OffsetDateTime cal -> String)
        String)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either StrftimeError
-> m (Pattern
        (OffsetDateTime cal -> OffsetDateTime cal)
        (OffsetDateTime cal -> String)
        String)
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM Pattern
  (OffsetDateTime cal -> OffsetDateTime cal)
  (OffsetDateTime cal -> String)
  String
-> m (Pattern
        (OffsetDateTime cal -> OffsetDateTime cal)
        (OffsetDateTime cal -> String)
        String)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Char
 -> Either
      StrftimeError
      (Pattern
         (CalendarDateTime cal -> CalendarDateTime cal)
         (CalendarDateTime cal -> String)
         String))
-> String
-> Either
     StrftimeError
     (Pattern
        (OffsetDateTime cal -> OffsetDateTime cal)
        (OffsetDateTime cal -> String)
        String)
forall cal.
IsCalendar cal =>
(Char
 -> Either
      StrftimeError
      (Pattern
         (CalendarDateTime cal -> CalendarDateTime cal)
         (CalendarDateTime cal -> String)
         String))
-> String
-> Either
     StrftimeError
     (Pattern
        (OffsetDateTime cal -> OffsetDateTime cal)
        (OffsetDateTime cal -> String)
        String)
compileOffsetDateTime (Locale
-> Char
-> Either
     StrftimeError
     (Pattern
        (CalendarDateTime cal -> CalendarDateTime cal)
        (CalendarDateTime cal -> String)
        String)
forall cal.
(IsCalendar cal, Enum (Month cal),
 Enum (DoW (CalendarDateTime cal))) =>
Locale
-> Char
-> Either
     StrftimeError
     (Pattern
        (CalendarDateTime cal -> CalendarDateTime cal)
        (CalendarDateTime cal -> String)
        String)
dateTimeConv Locale
loc) String
fmt)
  | Bool
otherwise              = OffsetlessLayoutException
-> m (Pattern
        (OffsetDateTime cal -> OffsetDateTime cal)
        (OffsetDateTime cal -> String)
        String)
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (String -> OffsetlessLayoutException
OffsetlessLayout (Locale -> String
localeId Locale
loc))
  where fmt :: String
fmt = Locale -> String
rawDateTimeFormat Locale
loc

-- | Split a @%z@-bearing layout into its local part and the offset, compile the local part, and pair it with the
--   compact-offset field.
compileOffsetDateTime
  :: IsCalendar cal
  => (Char -> Either StrftimeError (Pattern (CalendarDateTime cal -> CalendarDateTime cal) (CalendarDateTime cal -> String) String))
  -> String
  -> Either StrftimeError (Pattern (OffsetDateTime cal -> OffsetDateTime cal) (OffsetDateTime cal -> String) String)
compileOffsetDateTime :: forall cal.
IsCalendar cal =>
(Char
 -> Either
      StrftimeError
      (Pattern
         (CalendarDateTime cal -> CalendarDateTime cal)
         (CalendarDateTime cal -> String)
         String))
-> String
-> Either
     StrftimeError
     (Pattern
        (OffsetDateTime cal -> OffsetDateTime cal)
        (OffsetDateTime cal -> String)
        String)
compileOffsetDateTime Char
-> Either
     StrftimeError
     (Pattern
        (CalendarDateTime cal -> CalendarDateTime cal)
        (CalendarDateTime cal -> String)
        String)
dtConv String
fmtStr = do
  [Tok]
toks <- String -> Either StrftimeError [Tok]
tokenize String
fmtStr
  let ([Frag]
before, [Frag]
rest) = (Frag -> Bool) -> [Frag] -> ([Frag], [Frag])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Frag -> Bool
isOffsetFrag ([Tok] -> [Frag]
toFrags [Tok]
toks)
  Pattern
  (CalendarDateTime cal -> CalendarDateTime cal)
  (CalendarDateTime cal -> String)
  String
localPat <- (Char
 -> Either
      StrftimeError
      (Pattern
         (CalendarDateTime cal -> CalendarDateTime cal)
         (CalendarDateTime cal -> String)
         String))
-> [Frag]
-> Either
     StrftimeError
     (Pattern
        (CalendarDateTime cal -> CalendarDateTime cal)
        (CalendarDateTime cal -> String)
        String)
forall a.
(Char
 -> Either StrftimeError (Pattern (a -> a) (a -> String) String))
-> [Frag]
-> Either StrftimeError (Pattern (a -> a) (a -> String) String)
assemble Char
-> Either
     StrftimeError
     (Pattern
        (CalendarDateTime cal -> CalendarDateTime cal)
        (CalendarDateTime cal -> String)
        String)
dtConv [Frag]
before
  String
trailing <- [Frag] -> Either StrftimeError String
trailingLits (Int -> [Frag] -> [Frag]
forall a. Int -> [a] -> [a]
drop Int
1 [Frag]
rest)
  Pattern
  (OffsetDateTime cal -> OffsetDateTime cal)
  (OffsetDateTime cal -> String)
  String
-> Either
     StrftimeError
     (Pattern
        (OffsetDateTime cal -> OffsetDateTime cal)
        (OffsetDateTime cal -> String)
        String)
forall a. a -> Either StrftimeError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern
  (CalendarDateTime cal -> CalendarDateTime cal)
  (CalendarDateTime cal -> String)
  String
-> Pattern (Offset -> Offset) (Offset -> String) String
-> Pattern
     (OffsetDateTime cal -> OffsetDateTime cal)
     (OffsetDateTime cal -> String)
     String
forall cal.
IsCalendar cal =>
Pattern
  (CalendarDateTime cal -> CalendarDateTime cal)
  (CalendarDateTime cal -> String)
  String
-> Pattern (Offset -> Offset) (Offset -> String) String
-> Pattern
     (OffsetDateTime cal -> OffsetDateTime cal)
     (OffsetDateTime cal -> String)
     String
offsetDateTimePattern Pattern
  (CalendarDateTime cal -> CalendarDateTime cal)
  (CalendarDateTime cal -> String)
  String
localPat (Pattern (Offset -> Offset) (Offset -> String) String
pOffsetCompact Pattern (Offset -> Offset) (Offset -> String) String
-> Pattern String String String
-> Pattern (Offset -> Offset) (Offset -> String) String
forall a b r c. Pattern a b r -> Pattern c r r -> Pattern a b r
<% String -> Pattern String String String
string String
trailing))

isOffsetFrag :: Frag -> Bool
isOffsetFrag :: Frag -> Bool
isOffsetFrag (ConvF Char
'z') = Bool
True
isOffsetFrag Frag
_           = Bool
False

-- | The literal text following @%z@ (normally none); a further field there is unsupported.
trailingLits :: [Frag] -> Either StrftimeError String
trailingLits :: [Frag] -> Either StrftimeError String
trailingLits []                = String -> Either StrftimeError String
forall a b. b -> Either a b
Right String
""
trailingLits (LitRun String
s : [Frag]
rest) = (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> Either StrftimeError String -> Either StrftimeError String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Frag] -> Either StrftimeError String
trailingLits [Frag]
rest
trailingLits (ConvF Char
c : [Frag]
_)     = StrftimeError -> Either StrftimeError String
forall a b. a -> Either a b
Left (Char -> StrftimeError
UnsupportedSpecifier Char
c)

-- | Does a @strftime@ layout contain the numeric-offset specifier @%z@ (respecting @%%@)?
hasOffsetSpecifier :: String -> Bool
hasOffsetSpecifier :: String -> Bool
hasOffsetSpecifier (Char
'%':Char
'%':String
rest) = String -> Bool
hasOffsetSpecifier String
rest
hasOffsetSpecifier (Char
'%':Char
'z':String
_)    = Bool
True
hasOffsetSpecifier (Char
'%':Char
_:String
rest)   = String -> Bool
hasOffsetSpecifier String
rest
hasOffsetSpecifier (Char
_:String
rest)       = String -> Bool
hasOffsetSpecifier String
rest
hasOffsetSpecifier []             = Bool
False