{-# LANGUAGE FlexibleInstances #-}

{- |
Module      : Time.Format
License     : BSD-style
Copyright   : (c) 2014 Vincent Hanquez <vincent@snarc.org>
Stability   : experimental
Portability : unknown

Time formatting : printing and parsing

Built-in format strings
-}

module Time.Format
  ( -- * Parsing and Printing

    -- ** Format strings

    TimeFormatElem (..)
  , TimeFormatFct (..)
  , TimeFormatString (..)
  , TimeFormat (..)
    -- ** Common built-in formats

  , ISO8601_Date (..)
  , ISO8601_DateAndTime (..)
    -- ** Format methods

  , timePrint
  , timeParse
  , timeParseE
  , localTimePrint
  , localTimeParse
  , localTimeParseE
  ) where

import           Data.Char ( isDigit, ord )
import           Data.Int ( Int64 )
import           Time.Internal ( dateTimeFromUnixEpochP )
import           Time.LocalTime
                   ( LocalTime (..), localTime, localTimeToGlobal )
import           Time.Time ( Timeable (..), timeGetDateTimeOfDay )
import           Time.Utils ( pad2, pad4, padN )
import           Time.Types
                   ( Date (..), DateTime (..), Elapsed (..), ElapsedP (..)
                   , Hours (..), Minutes (..), Month (..), NanoSeconds (..)
                   , Seconds (..), TimeOfDay (..), TimezoneOffset (..)
                   , timezone_UTC
                   )

-- | Type representing formatters that can be part of a time format string.

data TimeFormatElem =
    Format_Year2
    -- ^ 2 digit years (70 is 1970, 69 is 2069).

  | Format_Year4
    -- ^ 4 digits years.

  | Format_Year
    -- ^ Any digits years.

  | Format_Month
    -- ^ Months (1 to 12).

  | Format_Month2
    -- ^ Months padded to 2 characters (01 to 12).

  | Format_MonthName_Short
    -- ^ Short name of nthe month (\'Jan\', \'Feb\' ..).

  | Format_DayYear
    -- ^ Day of the year (1 to 365, 366 for leap years).

  | Format_Day
    -- ^ Day of the month (1 to 31).

  | Format_Day2
    -- ^ Day of the month padded to 2 characters (01 to 31).

  | Format_Hour
    -- ^ Hours (0 to 23).

  | Format_Minute
    -- ^ Minutes (0 to 59).

  | Format_Second
    -- ^ sSeconds (0 to 59, 60 for leap seconds).

  | Format_UnixSecond
    -- ^ Number of seconds since the start of the Unix epoch

    -- (1970-01-01 00:00:00 UTC).

  | Format_MilliSecond
    -- ^ Milliseconds padded to 3 characters (000 to 999).

  | Format_MicroSecond
    -- ^ MicroSeconds padded to 6 characters (000000 to 999999).

  | Format_NanoSecond
    -- ^ NanoSeconds padded to 9 characters (000000000 to 999999999).

  | Format_Precision Int
    -- ^ Sub seconds display with a precision of n digits, with n between @1@

    -- and @9@.

  | Format_TimezoneName
    -- ^ Timezone name (e.g. GMT, PST). Not yet implemented.

--  Format_TimezoneOffset

    -- ^ Timezone offset offset (+02:00).

  | Format_TzHM_Colon_Z
    -- ^ Zero UTC offset (Z) or timezone offset with colon (+02:00).

  | Format_TzHM_Colon
    -- ^ Timezone offset with colon (+02:00).

  | Format_TzHM
    -- ^ Timezone offset without colon (+0200).

  | Format_Tz_Offset
    -- ^ Timezone offset in minutes.

  | Format_Spaces
    -- ^ One or more space-like chars.

  | Format_Text Char
    -- ^ A verbatim character.

  | Format_Fct TimeFormatFct
    -- ^ Not implemented.

  deriving (TimeFormatElem -> TimeFormatElem -> Bool
(TimeFormatElem -> TimeFormatElem -> Bool)
-> (TimeFormatElem -> TimeFormatElem -> Bool) -> Eq TimeFormatElem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimeFormatElem -> TimeFormatElem -> Bool
== :: TimeFormatElem -> TimeFormatElem -> Bool
$c/= :: TimeFormatElem -> TimeFormatElem -> Bool
/= :: TimeFormatElem -> TimeFormatElem -> Bool
Eq, Int -> TimeFormatElem -> ShowS
[TimeFormatElem] -> ShowS
TimeFormatElem -> String
(Int -> TimeFormatElem -> ShowS)
-> (TimeFormatElem -> String)
-> ([TimeFormatElem] -> ShowS)
-> Show TimeFormatElem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TimeFormatElem -> ShowS
showsPrec :: Int -> TimeFormatElem -> ShowS
$cshow :: TimeFormatElem -> String
show :: TimeFormatElem -> String
$cshowList :: [TimeFormatElem] -> ShowS
showList :: [TimeFormatElem] -> ShowS
Show)

-- | Type representing format functions.

data TimeFormatFct = TimeFormatFct
  { TimeFormatFct -> String
timeFormatFctName :: String
    -- ^ The name of the format function.

  , TimeFormatFct
-> DateTime -> String -> Either String (DateTime, String)
timeFormatParse   :: DateTime -> String -> Either String (DateTime, String)
    -- ^ A parser.

  , TimeFormatFct -> DateTime -> String
timeFormatPrint   :: DateTime -> String
    -- A printer.

  }

instance Show TimeFormatFct where
  show :: TimeFormatFct -> String
show = TimeFormatFct -> String
timeFormatFctName

instance Eq TimeFormatFct where
  TimeFormatFct
t1 == :: TimeFormatFct -> TimeFormatFct -> Bool
== TimeFormatFct
t2 = TimeFormatFct -> String
timeFormatFctName TimeFormatFct
t1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== TimeFormatFct -> String
timeFormatFctName TimeFormatFct
t2

-- | Type representing time format strings, composed of list

-- of t'TimeFormatElem'.

newtype TimeFormatString = TimeFormatString [TimeFormatElem]
  deriving (TimeFormatString -> TimeFormatString -> Bool
(TimeFormatString -> TimeFormatString -> Bool)
-> (TimeFormatString -> TimeFormatString -> Bool)
-> Eq TimeFormatString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimeFormatString -> TimeFormatString -> Bool
== :: TimeFormatString -> TimeFormatString -> Bool
$c/= :: TimeFormatString -> TimeFormatString -> Bool
/= :: TimeFormatString -> TimeFormatString -> Bool
Eq, Int -> TimeFormatString -> ShowS
[TimeFormatString] -> ShowS
TimeFormatString -> String
(Int -> TimeFormatString -> ShowS)
-> (TimeFormatString -> String)
-> ([TimeFormatString] -> ShowS)
-> Show TimeFormatString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TimeFormatString -> ShowS
showsPrec :: Int -> TimeFormatString -> ShowS
$cshow :: TimeFormatString -> String
show :: TimeFormatString -> String
$cshowList :: [TimeFormatString] -> ShowS
showList :: [TimeFormatString] -> ShowS
Show)

-- | A type class promising the ability to convert values to

-- a t'TimeFormatString'.

class TimeFormat format where
  toFormat :: format -> TimeFormatString

-- | A type representing a ISO8601 date format string.

--

-- e.g. 2014-04-05

data ISO8601_Date = ISO8601_Date
  deriving (ISO8601_Date -> ISO8601_Date -> Bool
(ISO8601_Date -> ISO8601_Date -> Bool)
-> (ISO8601_Date -> ISO8601_Date -> Bool) -> Eq ISO8601_Date
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ISO8601_Date -> ISO8601_Date -> Bool
== :: ISO8601_Date -> ISO8601_Date -> Bool
$c/= :: ISO8601_Date -> ISO8601_Date -> Bool
/= :: ISO8601_Date -> ISO8601_Date -> Bool
Eq, Int -> ISO8601_Date -> ShowS
[ISO8601_Date] -> ShowS
ISO8601_Date -> String
(Int -> ISO8601_Date -> ShowS)
-> (ISO8601_Date -> String)
-> ([ISO8601_Date] -> ShowS)
-> Show ISO8601_Date
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ISO8601_Date -> ShowS
showsPrec :: Int -> ISO8601_Date -> ShowS
$cshow :: ISO8601_Date -> String
show :: ISO8601_Date -> String
$cshowList :: [ISO8601_Date] -> ShowS
showList :: [ISO8601_Date] -> ShowS
Show)

-- | A type representing a ISO8601 date and time format string.

--

-- e.g. 2014-04-05T17:25:04+00:00 or 2014-04-05T17:25:04Z.

data ISO8601_DateAndTime = ISO8601_DateAndTime
  deriving (ISO8601_DateAndTime -> ISO8601_DateAndTime -> Bool
(ISO8601_DateAndTime -> ISO8601_DateAndTime -> Bool)
-> (ISO8601_DateAndTime -> ISO8601_DateAndTime -> Bool)
-> Eq ISO8601_DateAndTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ISO8601_DateAndTime -> ISO8601_DateAndTime -> Bool
== :: ISO8601_DateAndTime -> ISO8601_DateAndTime -> Bool
$c/= :: ISO8601_DateAndTime -> ISO8601_DateAndTime -> Bool
/= :: ISO8601_DateAndTime -> ISO8601_DateAndTime -> Bool
Eq, Int -> ISO8601_DateAndTime -> ShowS
[ISO8601_DateAndTime] -> ShowS
ISO8601_DateAndTime -> String
(Int -> ISO8601_DateAndTime -> ShowS)
-> (ISO8601_DateAndTime -> String)
-> ([ISO8601_DateAndTime] -> ShowS)
-> Show ISO8601_DateAndTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ISO8601_DateAndTime -> ShowS
showsPrec :: Int -> ISO8601_DateAndTime -> ShowS
$cshow :: ISO8601_DateAndTime -> String
show :: ISO8601_DateAndTime -> String
$cshowList :: [ISO8601_DateAndTime] -> ShowS
showList :: [ISO8601_DateAndTime] -> ShowS
Show)

instance TimeFormat [TimeFormatElem] where
  toFormat :: [TimeFormatElem] -> TimeFormatString
toFormat = [TimeFormatElem] -> TimeFormatString
TimeFormatString

instance TimeFormat TimeFormatString where
  toFormat :: TimeFormatString -> TimeFormatString
toFormat = TimeFormatString -> TimeFormatString
forall a. a -> a
id

instance TimeFormat String where
  toFormat :: String -> TimeFormatString
toFormat = [TimeFormatElem] -> TimeFormatString
TimeFormatString ([TimeFormatElem] -> TimeFormatString)
-> (String -> [TimeFormatElem]) -> String -> TimeFormatString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [TimeFormatElem]
toFormatElem
   where
    toFormatElem :: String -> [TimeFormatElem]
toFormatElem []                  = []
    toFormatElem (Char
'Y':Char
'Y':Char
'Y':Char
'Y':String
r) = TimeFormatElem
Format_Year4  TimeFormatElem -> [TimeFormatElem] -> [TimeFormatElem]
forall a. a -> [a] -> [a]
: String -> [TimeFormatElem]
toFormatElem String
r
    toFormatElem (Char
'Y':Char
'Y':String
r)         = TimeFormatElem
Format_Year2  TimeFormatElem -> [TimeFormatElem] -> [TimeFormatElem]
forall a. a -> [a] -> [a]
: String -> [TimeFormatElem]
toFormatElem String
r
    toFormatElem (Char
'M':Char
'M':String
r)         = TimeFormatElem
Format_Month2 TimeFormatElem -> [TimeFormatElem] -> [TimeFormatElem]
forall a. a -> [a] -> [a]
: String -> [TimeFormatElem]
toFormatElem String
r
    toFormatElem (Char
'M':Char
'o':Char
'n':String
r)     = TimeFormatElem
Format_MonthName_Short TimeFormatElem -> [TimeFormatElem] -> [TimeFormatElem]
forall a. a -> [a] -> [a]
: String -> [TimeFormatElem]
toFormatElem String
r
    toFormatElem (Char
'M':Char
'I':String
r)         = TimeFormatElem
Format_Minute TimeFormatElem -> [TimeFormatElem] -> [TimeFormatElem]
forall a. a -> [a] -> [a]
: String -> [TimeFormatElem]
toFormatElem String
r
    toFormatElem (Char
'M':String
r)             = TimeFormatElem
Format_Month  TimeFormatElem -> [TimeFormatElem] -> [TimeFormatElem]
forall a. a -> [a] -> [a]
: String -> [TimeFormatElem]
toFormatElem String
r
    toFormatElem (Char
'D':Char
'D':String
r)         = TimeFormatElem
Format_Day2   TimeFormatElem -> [TimeFormatElem] -> [TimeFormatElem]
forall a. a -> [a] -> [a]
: String -> [TimeFormatElem]
toFormatElem String
r
    toFormatElem (Char
'H':String
r)             = TimeFormatElem
Format_Hour   TimeFormatElem -> [TimeFormatElem] -> [TimeFormatElem]
forall a. a -> [a] -> [a]
: String -> [TimeFormatElem]
toFormatElem String
r
    toFormatElem (Char
'S':String
r)             = TimeFormatElem
Format_Second TimeFormatElem -> [TimeFormatElem] -> [TimeFormatElem]
forall a. a -> [a] -> [a]
: String -> [TimeFormatElem]
toFormatElem String
r
    toFormatElem (Char
'm':Char
's':String
r)         = TimeFormatElem
Format_MilliSecond TimeFormatElem -> [TimeFormatElem] -> [TimeFormatElem]
forall a. a -> [a] -> [a]
: String -> [TimeFormatElem]
toFormatElem String
r
    toFormatElem (Char
'u':Char
's':String
r)         = TimeFormatElem
Format_MicroSecond TimeFormatElem -> [TimeFormatElem] -> [TimeFormatElem]
forall a. a -> [a] -> [a]
: String -> [TimeFormatElem]
toFormatElem String
r
    toFormatElem (Char
'μ':String
r)             = TimeFormatElem
Format_MicroSecond TimeFormatElem -> [TimeFormatElem] -> [TimeFormatElem]
forall a. a -> [a] -> [a]
: String -> [TimeFormatElem]
toFormatElem String
r
    toFormatElem (Char
'n':Char
's':String
r)         = TimeFormatElem
Format_NanoSecond TimeFormatElem -> [TimeFormatElem] -> [TimeFormatElem]
forall a. a -> [a] -> [a]
: String -> [TimeFormatElem]
toFormatElem String
r
    toFormatElem (Char
'p':Char
'1':String
r)         = Int -> TimeFormatElem
Format_Precision Int
1 TimeFormatElem -> [TimeFormatElem] -> [TimeFormatElem]
forall a. a -> [a] -> [a]
: String -> [TimeFormatElem]
toFormatElem String
r
    toFormatElem (Char
'p':Char
'2':String
r)         = Int -> TimeFormatElem
Format_Precision Int
2 TimeFormatElem -> [TimeFormatElem] -> [TimeFormatElem]
forall a. a -> [a] -> [a]
: String -> [TimeFormatElem]
toFormatElem String
r
    toFormatElem (Char
'p':Char
'3':String
r)         = Int -> TimeFormatElem
Format_Precision Int
3 TimeFormatElem -> [TimeFormatElem] -> [TimeFormatElem]
forall a. a -> [a] -> [a]
: String -> [TimeFormatElem]
toFormatElem String
r
    toFormatElem (Char
'p':Char
'4':String
r)         = Int -> TimeFormatElem
Format_Precision Int
4 TimeFormatElem -> [TimeFormatElem] -> [TimeFormatElem]
forall a. a -> [a] -> [a]
: String -> [TimeFormatElem]
toFormatElem String
r
    toFormatElem (Char
'p':Char
'5':String
r)         = Int -> TimeFormatElem
Format_Precision Int
5 TimeFormatElem -> [TimeFormatElem] -> [TimeFormatElem]
forall a. a -> [a] -> [a]
: String -> [TimeFormatElem]
toFormatElem String
r
    toFormatElem (Char
'p':Char
'6':String
r)         = Int -> TimeFormatElem
Format_Precision Int
6 TimeFormatElem -> [TimeFormatElem] -> [TimeFormatElem]
forall a. a -> [a] -> [a]
: String -> [TimeFormatElem]
toFormatElem String
r
    toFormatElem (Char
'p':Char
'7':String
r)         = Int -> TimeFormatElem
Format_Precision Int
7 TimeFormatElem -> [TimeFormatElem] -> [TimeFormatElem]
forall a. a -> [a] -> [a]
: String -> [TimeFormatElem]
toFormatElem String
r
    toFormatElem (Char
'p':Char
'8':String
r)         = Int -> TimeFormatElem
Format_Precision Int
8 TimeFormatElem -> [TimeFormatElem] -> [TimeFormatElem]
forall a. a -> [a] -> [a]
: String -> [TimeFormatElem]
toFormatElem String
r
    toFormatElem (Char
'p':Char
'9':String
r)         = Int -> TimeFormatElem
Format_Precision Int
9 TimeFormatElem -> [TimeFormatElem] -> [TimeFormatElem]
forall a. a -> [a] -> [a]
: String -> [TimeFormatElem]
toFormatElem String
r
    -----------------------------------------------------------

    toFormatElem (Char
'E':Char
'P':Char
'O':Char
'C':Char
'H':String
r) = TimeFormatElem
Format_UnixSecond TimeFormatElem -> [TimeFormatElem] -> [TimeFormatElem]
forall a. a -> [a] -> [a]
: String -> [TimeFormatElem]
toFormatElem String
r
    -----------------------------------------------------------

    toFormatElem (Char
'T':Char
'Z':Char
'H':Char
'M':String
r)     = TimeFormatElem
Format_TzHM TimeFormatElem -> [TimeFormatElem] -> [TimeFormatElem]
forall a. a -> [a] -> [a]
: String -> [TimeFormatElem]
toFormatElem String
r
    toFormatElem (Char
'T':Char
'Z':Char
'H':Char
':':Char
'M':String
r) = TimeFormatElem
Format_TzHM_Colon TimeFormatElem -> [TimeFormatElem] -> [TimeFormatElem]
forall a. a -> [a] -> [a]
: String -> [TimeFormatElem]
toFormatElem String
r
    toFormatElem (Char
'T':Char
'Z':Char
'O':Char
'F':Char
'S':String
r) = TimeFormatElem
Format_Tz_Offset TimeFormatElem -> [TimeFormatElem] -> [TimeFormatElem]
forall a. a -> [a] -> [a]
: String -> [TimeFormatElem]
toFormatElem String
r
    -----------------------------------------------------------

    toFormatElem (Char
'\\':Char
c:String
r)          = Char -> TimeFormatElem
Format_Text Char
c TimeFormatElem -> [TimeFormatElem] -> [TimeFormatElem]
forall a. a -> [a] -> [a]
: String -> [TimeFormatElem]
toFormatElem String
r
    toFormatElem (Char
' ':String
r)             = TimeFormatElem
Format_Spaces TimeFormatElem -> [TimeFormatElem] -> [TimeFormatElem]
forall a. a -> [a] -> [a]
: String -> [TimeFormatElem]
toFormatElem String
r
    toFormatElem (Char
c:String
r)               = Char -> TimeFormatElem
Format_Text Char
c TimeFormatElem -> [TimeFormatElem] -> [TimeFormatElem]
forall a. a -> [a] -> [a]
: String -> [TimeFormatElem]
toFormatElem String
r

instance TimeFormat ISO8601_Date where
  toFormat :: ISO8601_Date -> TimeFormatString
toFormat ISO8601_Date
_ =
    [TimeFormatElem] -> TimeFormatString
TimeFormatString [TimeFormatElem
Format_Year,TimeFormatElem
dash,TimeFormatElem
Format_Month2,TimeFormatElem
dash,TimeFormatElem
Format_Day2]
   where
    dash :: TimeFormatElem
dash = Char -> TimeFormatElem
Format_Text Char
'-'

instance TimeFormat ISO8601_DateAndTime where
  toFormat :: ISO8601_DateAndTime -> TimeFormatString
toFormat ISO8601_DateAndTime
_ = [TimeFormatElem] -> TimeFormatString
TimeFormatString
    [ TimeFormatElem
Format_Year,TimeFormatElem
dash,TimeFormatElem
Format_Month2,TimeFormatElem
dash,TimeFormatElem
Format_Day2 -- date

    , Char -> TimeFormatElem
Format_Text Char
'T'
    , TimeFormatElem
Format_Hour,TimeFormatElem
colon,TimeFormatElem
Format_Minute,TimeFormatElem
colon,TimeFormatElem
Format_Second -- time

    , TimeFormatElem
Format_TzHM_Colon_Z -- zero UTC offset (Z) or timezone offset with colon +HH:MM

    ]
   where
    dash :: TimeFormatElem
dash = Char -> TimeFormatElem
Format_Text Char
'-'
    colon :: TimeFormatElem
colon = Char -> TimeFormatElem
Format_Text Char
':'

monthFromShort :: String -> Either String Month
monthFromShort :: String -> Either String Month
monthFromShort String
str =
  case String
str of
    String
"Jan" -> Month -> Either String Month
forall a b. b -> Either a b
Right Month
January
    String
"Feb" -> Month -> Either String Month
forall a b. b -> Either a b
Right Month
February
    String
"Mar" -> Month -> Either String Month
forall a b. b -> Either a b
Right Month
March
    String
"Apr" -> Month -> Either String Month
forall a b. b -> Either a b
Right Month
April
    String
"May" -> Month -> Either String Month
forall a b. b -> Either a b
Right Month
May
    String
"Jun" -> Month -> Either String Month
forall a b. b -> Either a b
Right Month
June
    String
"Jul" -> Month -> Either String Month
forall a b. b -> Either a b
Right Month
July
    String
"Aug" -> Month -> Either String Month
forall a b. b -> Either a b
Right Month
August
    String
"Sep" -> Month -> Either String Month
forall a b. b -> Either a b
Right Month
September
    String
"Oct" -> Month -> Either String Month
forall a b. b -> Either a b
Right Month
October
    String
"Nov" -> Month -> Either String Month
forall a b. b -> Either a b
Right Month
November
    String
"Dec" -> Month -> Either String Month
forall a b. b -> Either a b
Right Month
December
    String
_     -> String -> Either String Month
forall a b. a -> Either a b
Left (String -> Either String Month) -> String -> Either String Month
forall a b. (a -> b) -> a -> b
$ String
"unknown month: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str

printWith ::
     (TimeFormat format, Timeable t)
  => format
  -> TimezoneOffset
  -> t
  -> String
printWith :: forall format t.
(TimeFormat format, Timeable t) =>
format -> TimezoneOffset -> t -> String
printWith format
fmt tzOfs :: TimezoneOffset
tzOfs@(TimezoneOffset Int
tz) t
t = (TimeFormatElem -> String) -> [TimeFormatElem] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TimeFormatElem -> String
fmtToString [TimeFormatElem]
fmtElems
 where
  fmtToString :: TimeFormatElem -> String
fmtToString TimeFormatElem
Format_Year     = Int -> String
forall a. Show a => a -> String
show (Date -> Int
dateYear Date
date)
  fmtToString TimeFormatElem
Format_Year4    = Int -> String
forall a. (Show a, Ord a, Num a, Integral a) => a -> String
pad4 (Date -> Int
dateYear Date
date)
  fmtToString TimeFormatElem
Format_Year2    = Int -> String
forall a. (Show a, Ord a, Num a, Integral a) => a -> String
pad2 (Date -> Int
dateYear Date
date Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1900)
  fmtToString TimeFormatElem
Format_Month2   = Int -> String
forall a. (Show a, Ord a, Num a, Integral a) => a -> String
pad2 (Month -> Int
forall a. Enum a => a -> Int
fromEnum (Date -> Month
dateMonth Date
date) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  fmtToString TimeFormatElem
Format_Month    = Int -> String
forall a. Show a => a -> String
show (Month -> Int
forall a. Enum a => a -> Int
fromEnum (Date -> Month
dateMonth Date
date) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  fmtToString TimeFormatElem
Format_MonthName_Short = Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
3 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Month -> String
forall a. Show a => a -> String
show (Date -> Month
dateMonth Date
date)
  fmtToString TimeFormatElem
Format_Day2     = Int -> String
forall a. (Show a, Ord a, Num a, Integral a) => a -> String
pad2 (Date -> Int
dateDay Date
date)
  fmtToString TimeFormatElem
Format_Day      = Int -> String
forall a. Show a => a -> String
show (Date -> Int
dateDay Date
date)
  fmtToString TimeFormatElem
Format_Hour     = Int -> String
forall a. (Show a, Ord a, Num a, Integral a) => a -> String
pad2 (Hours -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (TimeOfDay -> Hours
todHour TimeOfDay
tm) :: Int)
  fmtToString TimeFormatElem
Format_Minute   = Int -> String
forall a. (Show a, Ord a, Num a, Integral a) => a -> String
pad2 (Minutes -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (TimeOfDay -> Minutes
todMin TimeOfDay
tm) :: Int)
  fmtToString TimeFormatElem
Format_Second   = Int -> String
forall a. (Show a, Ord a, Num a, Integral a) => a -> String
pad2 (Seconds -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (TimeOfDay -> Seconds
todSec TimeOfDay
tm) :: Int)
  fmtToString TimeFormatElem
Format_MilliSecond = Int -> Int64 -> String
forall a. (Show a, Ord a, Num a, Integral a) => Int -> a -> String
padN Int
3 (Int64
ns Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
1000000)
  fmtToString TimeFormatElem
Format_MicroSecond = Int -> Int64 -> String
forall a. (Show a, Ord a, Num a, Integral a) => Int -> a -> String
padN Int
3 ((Int64
ns Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
1000) Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`mod` Int64
1000)
  fmtToString TimeFormatElem
Format_NanoSecond = Int -> Int64 -> String
forall a. (Show a, Ord a, Num a, Integral a) => Int -> a -> String
padN Int
3 (Int64
ns Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`mod` Int64
1000)
  fmtToString (Format_Precision Int
n)
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
9 = Int -> Int64 -> String
forall a. (Show a, Ord a, Num a, Integral a) => Int -> a -> String
padN Int
n (Int64
ns Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` (Int64
10 Int64 -> Int -> Int64
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
9 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)))
      | Bool
otherwise        = ShowS
forall a. HasCallStack => String -> a
error String
"invalid precision format"
  fmtToString TimeFormatElem
Format_UnixSecond = Int64 -> String
forall a. Show a => a -> String
show Int64
unixSecs
  fmtToString TimeFormatElem
Format_TimezoneName   = String
"" --

  fmtToString TimeFormatElem
Format_Tz_Offset = Int -> String
forall a. Show a => a -> String
show Int
tz
  fmtToString TimeFormatElem
Format_TzHM = TimezoneOffset -> String
forall a. Show a => a -> String
show TimezoneOffset
tzOfs
  fmtToString TimeFormatElem
Format_TzHM_Colon_Z
      | Int
tz Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0   = String
"Z"
      | Bool
otherwise = TimeFormatElem -> String
fmtToString TimeFormatElem
Format_TzHM_Colon
  fmtToString TimeFormatElem
Format_TzHM_Colon =
      let (Int
tzH, Int
tzM) = Int -> Int
forall a. Num a => a -> a
abs Int
tz Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
60
          sign :: String
sign = if Int
tz Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then String
"-" else String
"+"
       in String
sign String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. (Show a, Ord a, Num a, Integral a) => a -> String
pad2 Int
tzH String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. (Show a, Ord a, Num a, Integral a) => a -> String
pad2 Int
tzM
  fmtToString TimeFormatElem
Format_Spaces   = String
" "
  fmtToString (Format_Text Char
c) = [Char
c]
  fmtToString TimeFormatElem
f = ShowS
forall a. HasCallStack => String -> a
error (String
"unimplemented printing format: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TimeFormatElem -> String
forall a. Show a => a -> String
show TimeFormatElem
f)

  (TimeFormatString [TimeFormatElem]
fmtElems) = format -> TimeFormatString
forall format. TimeFormat format => format -> TimeFormatString
toFormat format
fmt

  (Elapsed (Seconds Int64
unixSecs)) = t -> Elapsed
forall t. Timeable t => t -> Elapsed
timeGetElapsed t
t
  (DateTime Date
date TimeOfDay
tm) = t -> DateTime
forall t. Timeable t => t -> DateTime
timeGetDateTimeOfDay t
t
  (NanoSeconds Int64
ns) = t -> NanoSeconds
forall t. Timeable t => t -> NanoSeconds
timeGetNanoSeconds t
t

-- | Given the specified format, pretty print the given local time.

localTimePrint ::
     (TimeFormat format, Timeable t)
  => format      -- ^ The format to use for printing.

  -> LocalTime t -- ^ The local time to print.

  -> String
localTimePrint :: forall format t.
(TimeFormat format, Timeable t) =>
format -> LocalTime t -> String
localTimePrint format
fmt LocalTime t
lt =
  LocalTime String -> String
forall t. LocalTime t -> t
localTimeUnwrap (LocalTime String -> String) -> LocalTime String -> String
forall a b. (a -> b) -> a -> b
$ (t -> String) -> LocalTime t -> LocalTime String
forall a b. (a -> b) -> LocalTime a -> LocalTime b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (format -> TimezoneOffset -> t -> String
forall format t.
(TimeFormat format, Timeable t) =>
format -> TimezoneOffset -> t -> String
printWith format
fmt (LocalTime t -> TimezoneOffset
forall t. LocalTime t -> TimezoneOffset
localTimeGetTimezone LocalTime t
lt)) LocalTime t
lt

-- | Given the specified format, pretty print the given time.

timePrint ::
     (TimeFormat format, Timeable t)
  => format -- ^ The format to use for printing.

  -> t      -- ^ The time to print.

  -> String
timePrint :: forall format t.
(TimeFormat format, Timeable t) =>
format -> t -> String
timePrint format
fmt = format -> TimezoneOffset -> t -> String
forall format t.
(TimeFormat format, Timeable t) =>
format -> TimezoneOffset -> t -> String
printWith format
fmt TimezoneOffset
timezone_UTC

-- | Given the specified format, try to parse the given string as time value.

--

-- On failure, the parsing function returns the reason of the failure.

--

-- If successful, yield the parsed value and the remaining unparsed string.

localTimeParseE ::
     TimeFormat format
  => format -- ^ The format to use for parsing.

  -> String -- ^ The string to parse.

  -> Either (TimeFormatElem, String) (LocalTime DateTime, String)
localTimeParseE :: forall format.
TimeFormat format =>
format
-> String
-> Either (TimeFormatElem, String) (LocalTime DateTime, String)
localTimeParseE format
fmt = (DateTime, TimezoneOffset)
-> [TimeFormatElem]
-> String
-> Either (TimeFormatElem, String) (LocalTime DateTime, String)
loop (DateTime, TimezoneOffset)
ini [TimeFormatElem]
fmtElems
 where
  (TimeFormatString [TimeFormatElem]
fmtElems) = format -> TimeFormatString
forall format. TimeFormat format => format -> TimeFormatString
toFormat format
fmt

  toLocal :: (t, TimezoneOffset) -> LocalTime t
toLocal (t
dt, TimezoneOffset
tz) = TimezoneOffset -> t -> LocalTime t
forall t. Time t => TimezoneOffset -> t -> LocalTime t
localTime TimezoneOffset
tz t
dt

  loop :: (DateTime, TimezoneOffset)
-> [TimeFormatElem]
-> String
-> Either (TimeFormatElem, String) (LocalTime DateTime, String)
loop (DateTime, TimezoneOffset)
acc []    String
s  = (LocalTime DateTime, String)
-> Either (TimeFormatElem, String) (LocalTime DateTime, String)
forall a b. b -> Either a b
Right ((DateTime, TimezoneOffset) -> LocalTime DateTime
forall {t}. Time t => (t, TimezoneOffset) -> LocalTime t
toLocal (DateTime, TimezoneOffset)
acc, String
s)
  loop (DateTime, TimezoneOffset)
_   (TimeFormatElem
x:[TimeFormatElem]
_) [] = (TimeFormatElem, String)
-> Either (TimeFormatElem, String) (LocalTime DateTime, String)
forall a b. a -> Either a b
Left (TimeFormatElem
x, String
"empty")
  loop (DateTime, TimezoneOffset)
acc (TimeFormatElem
x:[TimeFormatElem]
xs) String
s =
    case (DateTime, TimezoneOffset)
-> TimeFormatElem
-> String
-> Either String ((DateTime, TimezoneOffset), String)
processOne (DateTime, TimezoneOffset)
acc TimeFormatElem
x String
s of
      Left String
err         -> (TimeFormatElem, String)
-> Either (TimeFormatElem, String) (LocalTime DateTime, String)
forall a b. a -> Either a b
Left (TimeFormatElem
x, String
err)
      Right ((DateTime, TimezoneOffset)
nacc, String
s') -> (DateTime, TimezoneOffset)
-> [TimeFormatElem]
-> String
-> Either (TimeFormatElem, String) (LocalTime DateTime, String)
loop (DateTime, TimezoneOffset)
nacc [TimeFormatElem]
xs String
s'

  processOne :: (DateTime, TimezoneOffset)
-> TimeFormatElem
-> String
-> Either String ((DateTime, TimezoneOffset), String)
processOne (DateTime, TimezoneOffset)
_   TimeFormatElem
_               []     = String -> Either String ((DateTime, TimezoneOffset), String)
forall a b. a -> Either a b
Left String
"empty"
  processOne (DateTime, TimezoneOffset)
acc (Format_Text Char
c) (Char
x:String
xs)
    | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
x    = ((DateTime, TimezoneOffset), String)
-> Either String ((DateTime, TimezoneOffset), String)
forall a b. b -> Either a b
Right ((DateTime, TimezoneOffset)
acc, String
xs)
    | Bool
otherwise = String -> Either String ((DateTime, TimezoneOffset), String)
forall a b. a -> Either a b
Left (String
"unexpected char, got: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c)

  processOne (DateTime, TimezoneOffset)
acc TimeFormatElem
Format_Year String
s =
    (Int64 -> (DateTime, TimezoneOffset))
-> Either String (Int64, String)
-> Either String ((DateTime, TimezoneOffset), String)
forall {t} {a} {a} {b}.
(t -> a) -> Either a (t, b) -> Either a (a, b)
onSuccess (\Int64
y -> (Date -> Date)
-> (DateTime, TimezoneOffset) -> (DateTime, TimezoneOffset)
forall {b}. (Date -> Date) -> (DateTime, b) -> (DateTime, b)
modDate (Int64 -> Date -> Date
setYear Int64
y) (DateTime, TimezoneOffset)
acc) (Either String (Int64, String)
 -> Either String ((DateTime, TimezoneOffset), String))
-> Either String (Int64, String)
-> Either String ((DateTime, TimezoneOffset), String)
forall a b. (a -> b) -> a -> b
$ String -> Either String (Int64, String)
forall a. Num a => String -> Either String (a, String)
isNumber String
s
  processOne (DateTime, TimezoneOffset)
acc TimeFormatElem
Format_Year4 String
s =
    (Int64 -> (DateTime, TimezoneOffset))
-> Either String (Int64, String)
-> Either String ((DateTime, TimezoneOffset), String)
forall {t} {a} {a} {b}.
(t -> a) -> Either a (t, b) -> Either a (a, b)
onSuccess (\Int64
y -> (Date -> Date)
-> (DateTime, TimezoneOffset) -> (DateTime, TimezoneOffset)
forall {b}. (Date -> Date) -> (DateTime, b) -> (DateTime, b)
modDate (Int64 -> Date -> Date
setYear Int64
y) (DateTime, TimezoneOffset)
acc) (Either String (Int64, String)
 -> Either String ((DateTime, TimezoneOffset), String))
-> Either String (Int64, String)
-> Either String ((DateTime, TimezoneOffset), String)
forall a b. (a -> b) -> a -> b
$ Int -> String -> Either String (Int64, String)
getNDigitNum Int
4 String
s
  processOne (DateTime, TimezoneOffset)
acc TimeFormatElem
Format_Year2 String
s = (Int64 -> (DateTime, TimezoneOffset))
-> Either String (Int64, String)
-> Either String ((DateTime, TimezoneOffset), String)
forall {t} {a} {a} {b}.
(t -> a) -> Either a (t, b) -> Either a (a, b)
onSuccess
    ( \Int64
y -> let year :: Int64
year = if Int64
y Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
70 then Int64
y Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
2000 else Int64
y Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1900
            in  (Date -> Date)
-> (DateTime, TimezoneOffset) -> (DateTime, TimezoneOffset)
forall {b}. (Date -> Date) -> (DateTime, b) -> (DateTime, b)
modDate (Int64 -> Date -> Date
setYear Int64
year) (DateTime, TimezoneOffset)
acc
    )
    (Either String (Int64, String)
 -> Either String ((DateTime, TimezoneOffset), String))
-> Either String (Int64, String)
-> Either String ((DateTime, TimezoneOffset), String)
forall a b. (a -> b) -> a -> b
$ Int -> String -> Either String (Int64, String)
getNDigitNum Int
2 String
s
  processOne (DateTime, TimezoneOffset)
acc TimeFormatElem
Format_Month2 String
s = (Int64 -> (DateTime, TimezoneOffset))
-> Either String (Int64, String)
-> Either String ((DateTime, TimezoneOffset), String)
forall {t} {a} {a} {b}.
(t -> a) -> Either a (t, b) -> Either a (a, b)
onSuccess
    ( \Int64
m -> (Date -> Date)
-> (DateTime, TimezoneOffset) -> (DateTime, TimezoneOffset)
forall {b}. (Date -> Date) -> (DateTime, b) -> (DateTime, b)
modDate (Month -> Date -> Date
setMonth (Month -> Date -> Date) -> Month -> Date -> Date
forall a b. (a -> b) -> a -> b
$ Int -> Month
forall a. Enum a => Int -> a
toEnum ((Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
12)) (DateTime, TimezoneOffset)
acc
    )
    (Either String (Int64, String)
 -> Either String ((DateTime, TimezoneOffset), String))
-> Either String (Int64, String)
-> Either String ((DateTime, TimezoneOffset), String)
forall a b. (a -> b) -> a -> b
$ Int -> String -> Either String (Int64, String)
getNDigitNum Int
2 String
s
  processOne (DateTime, TimezoneOffset)
acc TimeFormatElem
Format_MonthName_Short String
s =
    (Month -> (DateTime, TimezoneOffset))
-> Either String (Month, String)
-> Either String ((DateTime, TimezoneOffset), String)
forall {t} {a} {a} {b}.
(t -> a) -> Either a (t, b) -> Either a (a, b)
onSuccess (\Month
m -> (Date -> Date)
-> (DateTime, TimezoneOffset) -> (DateTime, TimezoneOffset)
forall {b}. (Date -> Date) -> (DateTime, b) -> (DateTime, b)
modDate (Month -> Date -> Date
setMonth Month
m) (DateTime, TimezoneOffset)
acc) (Either String (Month, String)
 -> Either String ((DateTime, TimezoneOffset), String))
-> Either String (Month, String)
-> Either String ((DateTime, TimezoneOffset), String)
forall a b. (a -> b) -> a -> b
$ String -> Either String (Month, String)
getMonth String
s
  processOne (DateTime, TimezoneOffset)
acc TimeFormatElem
Format_Day2 String
s =
    (Int64 -> (DateTime, TimezoneOffset))
-> Either String (Int64, String)
-> Either String ((DateTime, TimezoneOffset), String)
forall {t} {a} {a} {b}.
(t -> a) -> Either a (t, b) -> Either a (a, b)
onSuccess (\Int64
d -> (Date -> Date)
-> (DateTime, TimezoneOffset) -> (DateTime, TimezoneOffset)
forall {b}. (Date -> Date) -> (DateTime, b) -> (DateTime, b)
modDate (Int64 -> Date -> Date
forall {a}. Integral a => a -> Date -> Date
setDay Int64
d) (DateTime, TimezoneOffset)
acc) (Either String (Int64, String)
 -> Either String ((DateTime, TimezoneOffset), String))
-> Either String (Int64, String)
-> Either String ((DateTime, TimezoneOffset), String)
forall a b. (a -> b) -> a -> b
$ Int -> String -> Either String (Int64, String)
getNDigitNum Int
2 String
s
  processOne (DateTime, TimezoneOffset)
acc TimeFormatElem
Format_Hour String
s =
    (Int64 -> (DateTime, TimezoneOffset))
-> Either String (Int64, String)
-> Either String ((DateTime, TimezoneOffset), String)
forall {t} {a} {a} {b}.
(t -> a) -> Either a (t, b) -> Either a (a, b)
onSuccess (\Int64
h -> (TimeOfDay -> TimeOfDay)
-> (DateTime, TimezoneOffset) -> (DateTime, TimezoneOffset)
forall {b}.
(TimeOfDay -> TimeOfDay) -> (DateTime, b) -> (DateTime, b)
modTime (Int64 -> TimeOfDay -> TimeOfDay
setHour Int64
h) (DateTime, TimezoneOffset)
acc) (Either String (Int64, String)
 -> Either String ((DateTime, TimezoneOffset), String))
-> Either String (Int64, String)
-> Either String ((DateTime, TimezoneOffset), String)
forall a b. (a -> b) -> a -> b
$ Int -> String -> Either String (Int64, String)
getNDigitNum Int
2 String
s
  processOne (DateTime, TimezoneOffset)
acc TimeFormatElem
Format_Minute String
s =
    (Int64 -> (DateTime, TimezoneOffset))
-> Either String (Int64, String)
-> Either String ((DateTime, TimezoneOffset), String)
forall {t} {a} {a} {b}.
(t -> a) -> Either a (t, b) -> Either a (a, b)
onSuccess (\Int64
mi -> (TimeOfDay -> TimeOfDay)
-> (DateTime, TimezoneOffset) -> (DateTime, TimezoneOffset)
forall {b}.
(TimeOfDay -> TimeOfDay) -> (DateTime, b) -> (DateTime, b)
modTime (Int64 -> TimeOfDay -> TimeOfDay
setMin Int64
mi) (DateTime, TimezoneOffset)
acc) (Either String (Int64, String)
 -> Either String ((DateTime, TimezoneOffset), String))
-> Either String (Int64, String)
-> Either String ((DateTime, TimezoneOffset), String)
forall a b. (a -> b) -> a -> b
$ Int -> String -> Either String (Int64, String)
getNDigitNum Int
2 String
s
  processOne (DateTime, TimezoneOffset)
acc TimeFormatElem
Format_Second String
s =
    (Int64 -> (DateTime, TimezoneOffset))
-> Either String (Int64, String)
-> Either String ((DateTime, TimezoneOffset), String)
forall {t} {a} {a} {b}.
(t -> a) -> Either a (t, b) -> Either a (a, b)
onSuccess (\Int64
sec -> (TimeOfDay -> TimeOfDay)
-> (DateTime, TimezoneOffset) -> (DateTime, TimezoneOffset)
forall {b}.
(TimeOfDay -> TimeOfDay) -> (DateTime, b) -> (DateTime, b)
modTime (Int64 -> TimeOfDay -> TimeOfDay
setSec Int64
sec) (DateTime, TimezoneOffset)
acc) (Either String (Int64, String)
 -> Either String ((DateTime, TimezoneOffset), String))
-> Either String (Int64, String)
-> Either String ((DateTime, TimezoneOffset), String)
forall a b. (a -> b) -> a -> b
$ Int -> String -> Either String (Int64, String)
getNDigitNum Int
2 String
s
  processOne (DateTime, TimezoneOffset)
acc TimeFormatElem
Format_MilliSecond String
s =
    (Int64 -> (DateTime, TimezoneOffset))
-> Either String (Int64, String)
-> Either String ((DateTime, TimezoneOffset), String)
forall {t} {a} {a} {b}.
(t -> a) -> Either a (t, b) -> Either a (a, b)
onSuccess (\Int64
ms -> (TimeOfDay -> TimeOfDay)
-> (DateTime, TimezoneOffset) -> (DateTime, TimezoneOffset)
forall {b}.
(TimeOfDay -> TimeOfDay) -> (DateTime, b) -> (DateTime, b)
modTime ((Int, Int) -> Int64 -> TimeOfDay -> TimeOfDay
setNsMask (Int
6,Int
3) Int64
ms) (DateTime, TimezoneOffset)
acc) (Either String (Int64, String)
 -> Either String ((DateTime, TimezoneOffset), String))
-> Either String (Int64, String)
-> Either String ((DateTime, TimezoneOffset), String)
forall a b. (a -> b) -> a -> b
$ Int -> String -> Either String (Int64, String)
getNDigitNum Int
3 String
s
  processOne (DateTime, TimezoneOffset)
acc TimeFormatElem
Format_MicroSecond String
s =
    (Int64 -> (DateTime, TimezoneOffset))
-> Either String (Int64, String)
-> Either String ((DateTime, TimezoneOffset), String)
forall {t} {a} {a} {b}.
(t -> a) -> Either a (t, b) -> Either a (a, b)
onSuccess (\Int64
us -> (TimeOfDay -> TimeOfDay)
-> (DateTime, TimezoneOffset) -> (DateTime, TimezoneOffset)
forall {b}.
(TimeOfDay -> TimeOfDay) -> (DateTime, b) -> (DateTime, b)
modTime ((Int, Int) -> Int64 -> TimeOfDay -> TimeOfDay
setNsMask (Int
3,Int
3) Int64
us) (DateTime, TimezoneOffset)
acc) (Either String (Int64, String)
 -> Either String ((DateTime, TimezoneOffset), String))
-> Either String (Int64, String)
-> Either String ((DateTime, TimezoneOffset), String)
forall a b. (a -> b) -> a -> b
$ Int -> String -> Either String (Int64, String)
getNDigitNum Int
3 String
s
  processOne (DateTime, TimezoneOffset)
acc TimeFormatElem
Format_NanoSecond String
s =
    (Int64 -> (DateTime, TimezoneOffset))
-> Either String (Int64, String)
-> Either String ((DateTime, TimezoneOffset), String)
forall {t} {a} {a} {b}.
(t -> a) -> Either a (t, b) -> Either a (a, b)
onSuccess (\Int64
ns -> (TimeOfDay -> TimeOfDay)
-> (DateTime, TimezoneOffset) -> (DateTime, TimezoneOffset)
forall {b}.
(TimeOfDay -> TimeOfDay) -> (DateTime, b) -> (DateTime, b)
modTime ((Int, Int) -> Int64 -> TimeOfDay -> TimeOfDay
setNsMask (Int
0,Int
3) Int64
ns) (DateTime, TimezoneOffset)
acc) (Either String (Int64, String)
 -> Either String ((DateTime, TimezoneOffset), String))
-> Either String (Int64, String)
-> Either String ((DateTime, TimezoneOffset), String)
forall a b. (a -> b) -> a -> b
$ Int -> String -> Either String (Int64, String)
getNDigitNum Int
3 String
s
  processOne (DateTime, TimezoneOffset)
acc (Format_Precision Int
p) String
s =
    (Int64 -> (DateTime, TimezoneOffset))
-> Either String (Int64, String)
-> Either String ((DateTime, TimezoneOffset), String)
forall {t} {a} {a} {b}.
(t -> a) -> Either a (t, b) -> Either a (a, b)
onSuccess (\Int64
num -> (TimeOfDay -> TimeOfDay)
-> (DateTime, TimezoneOffset) -> (DateTime, TimezoneOffset)
forall {b}.
(TimeOfDay -> TimeOfDay) -> (DateTime, b) -> (DateTime, b)
modTime (Int64 -> TimeOfDay -> TimeOfDay
setNS Int64
num) (DateTime, TimezoneOffset)
acc) (Either String (Int64, String)
 -> Either String ((DateTime, TimezoneOffset), String))
-> Either String (Int64, String)
-> Either String ((DateTime, TimezoneOffset), String)
forall a b. (a -> b) -> a -> b
$ Int -> String -> Either String (Int64, String)
getNDigitNum Int
p String
s
  processOne (DateTime, TimezoneOffset)
acc TimeFormatElem
Format_UnixSecond String
s =
    (Int64 -> (DateTime, TimezoneOffset))
-> Either String (Int64, String)
-> Either String ((DateTime, TimezoneOffset), String)
forall {t} {a} {a} {b}.
(t -> a) -> Either a (t, b) -> Either a (a, b)
onSuccess (\Int64
sec ->
      let newDate :: DateTime
newDate =
            ElapsedP -> DateTime
dateTimeFromUnixEpochP (ElapsedP -> DateTime) -> ElapsedP -> DateTime
forall a b. (a -> b) -> a -> b
$ (Elapsed -> NanoSeconds -> ElapsedP)
-> NanoSeconds -> Elapsed -> ElapsedP
forall a b c. (a -> b -> c) -> b -> a -> c
flip Elapsed -> NanoSeconds -> ElapsedP
ElapsedP NanoSeconds
0 (Elapsed -> ElapsedP) -> Elapsed -> ElapsedP
forall a b. (a -> b) -> a -> b
$ Seconds -> Elapsed
Elapsed (Seconds -> Elapsed) -> Seconds -> Elapsed
forall a b. (a -> b) -> a -> b
$ Int64 -> Seconds
Seconds Int64
sec
      in  (DateTime -> DateTime)
-> (DateTime, TimezoneOffset) -> (DateTime, TimezoneOffset)
forall {t} {a} {b}. (t -> a) -> (t, b) -> (a, b)
modDT (DateTime -> DateTime -> DateTime
forall a b. a -> b -> a
const DateTime
newDate) (DateTime, TimezoneOffset)
acc) (Either String (Int64, String)
 -> Either String ((DateTime, TimezoneOffset), String))
-> Either String (Int64, String)
-> Either String ((DateTime, TimezoneOffset), String)
forall a b. (a -> b) -> a -> b
$ String -> Either String (Int64, String)
forall a. Num a => String -> Either String (a, String)
isNumber String
s
  processOne (DateTime, TimezoneOffset)
acc TimeFormatElem
Format_TzHM_Colon_Z a :: String
a@(Char
c:String
s)
    | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'Z'  = ((DateTime, TimezoneOffset), String)
-> Either String ((DateTime, TimezoneOffset), String)
forall a b. b -> Either a b
Right ((DateTime, TimezoneOffset)
acc, String
s)
    | Bool
otherwise = (DateTime, TimezoneOffset)
-> TimeFormatElem
-> String
-> Either String ((DateTime, TimezoneOffset), String)
processOne (DateTime, TimezoneOffset)
acc TimeFormatElem
Format_TzHM_Colon String
a
  processOne (DateTime, TimezoneOffset)
acc TimeFormatElem
Format_TzHM_Colon (Char
c:String
s) =
    Bool
-> (DateTime, TimezoneOffset)
-> Char
-> String
-> Either String ((DateTime, TimezoneOffset), String)
forall {a} {t}.
Bool
-> (a, t)
-> Char
-> String
-> Either String ((a, TimezoneOffset), String)
parseHMSign Bool
True (DateTime, TimezoneOffset)
acc Char
c String
s
  processOne (DateTime, TimezoneOffset)
acc TimeFormatElem
Format_TzHM (Char
c:String
s) =
    Bool
-> (DateTime, TimezoneOffset)
-> Char
-> String
-> Either String ((DateTime, TimezoneOffset), String)
forall {a} {t}.
Bool
-> (a, t)
-> Char
-> String
-> Either String ((a, TimezoneOffset), String)
parseHMSign Bool
False (DateTime, TimezoneOffset)
acc Char
c String
s

  processOne (DateTime, TimezoneOffset)
acc TimeFormatElem
Format_Spaces (Char
' ':String
s) = ((DateTime, TimezoneOffset), String)
-> Either String ((DateTime, TimezoneOffset), String)
forall a b. b -> Either a b
Right ((DateTime, TimezoneOffset)
acc, String
s)
  -- catch all for unimplemented format.

  processOne (DateTime, TimezoneOffset)
_ TimeFormatElem
f String
_ = String -> Either String ((DateTime, TimezoneOffset), String)
forall a. HasCallStack => String -> a
error (String
"unimplemented parsing format: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TimeFormatElem -> String
forall a. Show a => a -> String
show TimeFormatElem
f)

  parseHMSign :: Bool
-> (a, t)
-> Char
-> String
-> Either String ((a, TimezoneOffset), String)
parseHMSign Bool
expectColon (a, t)
acc Char
signChar String
afterSign =
    case Char
signChar of
      Char
'+' -> Bool
-> Bool
-> String
-> (a, t)
-> Either String ((a, TimezoneOffset), String)
forall {a} {t}.
Bool
-> Bool
-> String
-> (a, t)
-> Either String ((a, TimezoneOffset), String)
parseHM Bool
False Bool
expectColon String
afterSign (a, t)
acc
      Char
'-' -> Bool
-> Bool
-> String
-> (a, t)
-> Either String ((a, TimezoneOffset), String)
forall {a} {t}.
Bool
-> Bool
-> String
-> (a, t)
-> Either String ((a, TimezoneOffset), String)
parseHM Bool
True Bool
expectColon String
afterSign (a, t)
acc
      Char
_   -> Bool
-> Bool
-> String
-> (a, t)
-> Either String ((a, TimezoneOffset), String)
forall {a} {t}.
Bool
-> Bool
-> String
-> (a, t)
-> Either String ((a, TimezoneOffset), String)
parseHM Bool
False Bool
expectColon (Char
signCharChar -> ShowS
forall a. a -> [a] -> [a]
:String
afterSign) (a, t)
acc

  parseHM :: Bool
-> Bool
-> String
-> (a, t)
-> Either String ((a, TimezoneOffset), String)
parseHM Bool
isNeg Bool
True (Char
h1:Char
h2:Char
':':Char
m1:Char
m2:String
xs) (a, t)
acc
    | String -> Bool
allDigits [Char
h1,Char
h2,Char
m1,Char
m2] = let tz :: TimezoneOffset
tz = Bool -> Char -> Char -> Char -> Char -> TimezoneOffset
toTZ Bool
isNeg Char
h1 Char
h2 Char
m1 Char
m2
                                in  ((a, TimezoneOffset), String)
-> Either String ((a, TimezoneOffset), String)
forall a b. b -> Either a b
Right ((t -> TimezoneOffset) -> (a, t) -> (a, TimezoneOffset)
forall {t} {b} {a}. (t -> b) -> (a, t) -> (a, b)
modTZ (TimezoneOffset -> t -> TimezoneOffset
forall a b. a -> b -> a
const TimezoneOffset
tz) (a, t)
acc, String
xs)
    | Bool
otherwise = String -> Either String ((a, TimezoneOffset), String)
forall a b. a -> Either a b
Left (String
"not digits chars: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show [Char
h1,Char
h2,Char
m1,Char
m2])
  parseHM Bool
isNeg Bool
False (Char
h1:Char
h2:Char
m1:Char
m2:String
xs) (a, t)
acc
    | String -> Bool
allDigits [Char
h1,Char
h2,Char
m1,Char
m2] = let tz :: TimezoneOffset
tz = Bool -> Char -> Char -> Char -> Char -> TimezoneOffset
toTZ Bool
isNeg Char
h1 Char
h2 Char
m1 Char
m2
                                in  ((a, TimezoneOffset), String)
-> Either String ((a, TimezoneOffset), String)
forall a b. b -> Either a b
Right ((t -> TimezoneOffset) -> (a, t) -> (a, TimezoneOffset)
forall {t} {b} {a}. (t -> b) -> (a, t) -> (a, b)
modTZ (TimezoneOffset -> t -> TimezoneOffset
forall a b. a -> b -> a
const TimezoneOffset
tz) (a, t)
acc, String
xs)
    | Bool
otherwise = String -> Either String ((a, TimezoneOffset), String)
forall a b. a -> Either a b
Left (String
"not digits chars: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show [Char
h1,Char
h2,Char
m1,Char
m2])
  parseHM Bool
_ Bool
_    String
_ (a, t)
_ = String -> Either String ((a, TimezoneOffset), String)
forall a b. a -> Either a b
Left String
"invalid timezone format"

  toTZ :: Bool -> Char -> Char -> Char -> Char -> TimezoneOffset
toTZ Bool
isNeg Char
h1 Char
h2 Char
m1 Char
m2 = Int -> TimezoneOffset
TimezoneOffset ((if Bool
isNeg then Int -> Int
forall a. Num a => a -> a
negate else Int -> Int
forall a. a -> a
id) Int
minutes)
   where
    minutes :: Int
minutes = (String -> Int
forall a. Num a => String -> a
toInt [Char
h1,Char
h2] Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall a. Num a => String -> a
toInt [Char
m1,Char
m2]

  onSuccess :: (t -> a) -> Either a (t, b) -> Either a (a, b)
onSuccess t -> a
f (Right (t
v, b
s')) = (a, b) -> Either a (a, b)
forall a b. b -> Either a b
Right (t -> a
f t
v, b
s')
  onSuccess t -> a
_ (Left a
s)        = a -> Either a (a, b)
forall a b. a -> Either a b
Left a
s

  isNumber :: Num a => String -> Either String (a, String)
  isNumber :: forall a. Num a => String -> Either String (a, String)
isNumber String
s =
    case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
s of
      (String
"", String
s2) -> String -> Either String (a, String)
forall a b. a -> Either a b
Left (String
"no digits chars:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s2)
      (String
s1, String
s2) -> (a, String) -> Either String (a, String)
forall a b. b -> Either a b
Right (String -> a
forall a. Num a => String -> a
toInt String
s1, String
s2)

  getNDigitNum :: Int -> String -> Either String (Int64, String)
  getNDigitNum :: Int -> String -> Either String (Int64, String)
getNDigitNum Int
n String
s =
    case Int -> String -> Either String (String, String)
getNChar Int
n String
s of
      Left String
err                            -> String -> Either String (Int64, String)
forall a b. a -> Either a b
Left String
err
      Right (String
s1, String
s2)
        | Bool -> Bool
not (String -> Bool
allDigits String
s1) -> String -> Either String (Int64, String)
forall a b. a -> Either a b
Left (String
"not a digit chars in " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
s1)
        | Bool
otherwise          -> (Int64, String) -> Either String (Int64, String)
forall a b. b -> Either a b
Right (String -> Int64
forall a. Num a => String -> a
toInt String
s1, String
s2)

  getMonth :: String -> Either String (Month, String)
  getMonth :: String -> Either String (Month, String)
getMonth String
s =
    Int -> String -> Either String (String, String)
getNChar Int
3 String
s Either String (String, String)
-> ((String, String) -> Either String (Month, String))
-> Either String (Month, String)
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(String
s1, String
s2) -> String -> Either String Month
monthFromShort String
s1 Either String Month
-> (Month -> Either String (Month, String))
-> Either String (Month, String)
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Month
m -> (Month, String) -> Either String (Month, String)
forall a b. b -> Either a b
Right (Month
m, String
s2)

  getNChar :: Int -> String -> Either String (String, String)
  getNChar :: Int -> String -> Either String (String, String)
getNChar Int
n String
s
    | String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n =
        String -> Either String (String, String)
forall a b. a -> Either a b
Left (String
"not enough chars: expecting " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
s1)
    | Bool
otherwise = (String, String) -> Either String (String, String)
forall a b. b -> Either a b
Right (String
s1, String
s2)
   where
    (String
s1, String
s2) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n String
s

  toInt :: Num a => String -> a
  toInt :: forall a. Num a => String -> a
toInt = (a -> Char -> a) -> a -> String -> a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\a
acc Char
w -> a
acc a -> a -> a
forall a. Num a => a -> a -> a
* a
10 a -> a -> a
forall a. Num a => a -> a -> a
+ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0')) a
0

  allDigits :: String -> Bool
allDigits = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit

  ini :: (DateTime, TimezoneOffset)
ini = (Date -> TimeOfDay -> DateTime
DateTime (Int -> Month -> Int -> Date
Date Int
0 (Int -> Month
forall a. Enum a => Int -> a
toEnum Int
0) Int
0) (Hours -> Minutes -> Seconds -> NanoSeconds -> TimeOfDay
TimeOfDay Hours
0 Minutes
0 Seconds
0 NanoSeconds
0), Int -> TimezoneOffset
TimezoneOffset Int
0)

  modDT :: (t -> a) -> (t, b) -> (a, b)
modDT   t -> a
f (t
dt, b
tz) = (t -> a
f t
dt, b
tz)
  modDate :: (Date -> Date) -> (DateTime, b) -> (DateTime, b)
modDate Date -> Date
f (DateTime Date
d TimeOfDay
tp, b
tz) = (Date -> TimeOfDay -> DateTime
DateTime (Date -> Date
f Date
d) TimeOfDay
tp, b
tz)
  modTime :: (TimeOfDay -> TimeOfDay) -> (DateTime, b) -> (DateTime, b)
modTime TimeOfDay -> TimeOfDay
f (DateTime Date
d TimeOfDay
tp, b
tz) = (Date -> TimeOfDay -> DateTime
DateTime Date
d (TimeOfDay -> TimeOfDay
f TimeOfDay
tp), b
tz)
  modTZ :: (t -> b) -> (a, t) -> (a, b)
modTZ   t -> b
f (a
dt, t
tz) = (a
dt, t -> b
f t
tz)

  setYear :: Int64 -> Date -> Date
  setYear :: Int64 -> Date -> Date
setYear  Int64
y (Date Int
_ Month
m Int
d) = Int -> Month -> Int -> Date
Date (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
y) Month
m Int
d
  setMonth :: Month -> Date -> Date
setMonth Month
m (Date Int
y Month
_ Int
d) = Int -> Month -> Int -> Date
Date Int
y Month
m Int
d
  setDay :: a -> Date -> Date
setDay   a
d (Date Int
y Month
m Int
_) = Int -> Month -> Int -> Date
Date Int
y Month
m (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
d)
  setHour :: Int64 -> TimeOfDay -> TimeOfDay
setHour  Int64
h (TimeOfDay Hours
_ Minutes
m Seconds
s NanoSeconds
ns) = Hours -> Minutes -> Seconds -> NanoSeconds -> TimeOfDay
TimeOfDay (Int64 -> Hours
Hours Int64
h) Minutes
m Seconds
s NanoSeconds
ns
  setMin :: Int64 -> TimeOfDay -> TimeOfDay
setMin   Int64
m (TimeOfDay Hours
h Minutes
_ Seconds
s NanoSeconds
ns) = Hours -> Minutes -> Seconds -> NanoSeconds -> TimeOfDay
TimeOfDay Hours
h (Int64 -> Minutes
Minutes Int64
m) Seconds
s NanoSeconds
ns
  setSec :: Int64 -> TimeOfDay -> TimeOfDay
setSec   Int64
s (TimeOfDay Hours
h Minutes
m Seconds
_ NanoSeconds
ns) = Hours -> Minutes -> Seconds -> NanoSeconds -> TimeOfDay
TimeOfDay Hours
h Minutes
m (Int64 -> Seconds
Seconds Int64
s) NanoSeconds
ns
  setNS :: Int64 -> TimeOfDay -> TimeOfDay
setNS    Int64
v (TimeOfDay Hours
h Minutes
m Seconds
s NanoSeconds
_ ) = Hours -> Minutes -> Seconds -> NanoSeconds -> TimeOfDay
TimeOfDay Hours
h Minutes
m Seconds
s (Int64 -> NanoSeconds
NanoSeconds Int64
v)

  setNsMask :: (Int, Int) -> Int64 -> TimeOfDay -> TimeOfDay
  setNsMask :: (Int, Int) -> Int64 -> TimeOfDay -> TimeOfDay
setNsMask (Int
shift, Int
mask) Int64
val (TimeOfDay Hours
h Minutes
mins Seconds
seconds (NanoSeconds Int64
ns)) =
    let (Int64
nsD,Int64
keepL) = Int64
ns Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int64
s
        (Int64
keepH,Int64
_)   = Int64
nsD Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int64
m
        v :: Int64
v           = ((Int64
keepH Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
m Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
val) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
s) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
keepL
    in  Hours -> Minutes -> Seconds -> NanoSeconds -> TimeOfDay
TimeOfDay Hours
h Minutes
mins Seconds
seconds (Int64 -> NanoSeconds
NanoSeconds Int64
v)
   where
    s :: Int64
s = Int64
10 Int64 -> Int -> Int64
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
shift
    m :: Int64
m = Int64
10 Int64 -> Int -> Int64
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
mask

-- | Given the specified format, try to parse the given string as time value.

--

-- On failure, returns 'Nothing'.

--

-- If successful, yields 'Just' the parsed value.

--

-- For more elaborate needs use 'localTimeParseE'.

localTimeParse ::
     TimeFormat format
  => format -- ^ The format to use for parsing.

  -> String -- ^ The string to parse.

  -> Maybe (LocalTime DateTime)
localTimeParse :: forall format.
TimeFormat format =>
format -> String -> Maybe (LocalTime DateTime)
localTimeParse format
fmt String
s =
  ((TimeFormatElem, String) -> Maybe (LocalTime DateTime))
-> ((LocalTime DateTime, String) -> Maybe (LocalTime DateTime))
-> Either (TimeFormatElem, String) (LocalTime DateTime, String)
-> Maybe (LocalTime DateTime)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (LocalTime DateTime)
-> (TimeFormatElem, String) -> Maybe (LocalTime DateTime)
forall a b. a -> b -> a
const Maybe (LocalTime DateTime)
forall a. Maybe a
Nothing) (LocalTime DateTime -> Maybe (LocalTime DateTime)
forall a. a -> Maybe a
Just (LocalTime DateTime -> Maybe (LocalTime DateTime))
-> ((LocalTime DateTime, String) -> LocalTime DateTime)
-> (LocalTime DateTime, String)
-> Maybe (LocalTime DateTime)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LocalTime DateTime, String) -> LocalTime DateTime
forall a b. (a, b) -> a
fst) (Either (TimeFormatElem, String) (LocalTime DateTime, String)
 -> Maybe (LocalTime DateTime))
-> Either (TimeFormatElem, String) (LocalTime DateTime, String)
-> Maybe (LocalTime DateTime)
forall a b. (a -> b) -> a -> b
$ format
-> String
-> Either (TimeFormatElem, String) (LocalTime DateTime, String)
forall format.
TimeFormat format =>
format
-> String
-> Either (TimeFormatElem, String) (LocalTime DateTime, String)
localTimeParseE format
fmt String
s

-- | Like 'localTimeParseE' but the time value is automatically converted to

-- global time.

timeParseE ::
     TimeFormat format
  => format
  -> String
  -> Either (TimeFormatElem, String) (DateTime, String)
timeParseE :: forall format.
TimeFormat format =>
format
-> String -> Either (TimeFormatElem, String) (DateTime, String)
timeParseE format
fmt String
timeString =
  (\(LocalTime DateTime
d, String
s) -> (DateTime, String)
-> Either (TimeFormatElem, String) (DateTime, String)
forall a b. b -> Either a b
Right (LocalTime DateTime -> DateTime
forall t. Time t => LocalTime t -> t
localTimeToGlobal LocalTime DateTime
d, String
s)) ((LocalTime DateTime, String)
 -> Either (TimeFormatElem, String) (DateTime, String))
-> Either (TimeFormatElem, String) (LocalTime DateTime, String)
-> Either (TimeFormatElem, String) (DateTime, String)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< format
-> String
-> Either (TimeFormatElem, String) (LocalTime DateTime, String)
forall format.
TimeFormat format =>
format
-> String
-> Either (TimeFormatElem, String) (LocalTime DateTime, String)
localTimeParseE format
fmt String
timeString

-- | Like 'localTimeParse' but the time value is automatically converted to

-- global time.

timeParse :: TimeFormat format => format -> String -> Maybe DateTime
timeParse :: forall format.
TimeFormat format =>
format -> String -> Maybe DateTime
timeParse format
fmt String
s = LocalTime DateTime -> DateTime
forall t. Time t => LocalTime t -> t
localTimeToGlobal (LocalTime DateTime -> DateTime)
-> Maybe (LocalTime DateTime) -> Maybe DateTime
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` format -> String -> Maybe (LocalTime DateTime)
forall format.
TimeFormat format =>
format -> String -> Maybe (LocalTime DateTime)
localTimeParse format
fmt String
s