{-# 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
TimeFormat (..)
, TimeFormatString (..)
, TimeFormatElem (..)
, TimeFormatFct (..)
-- ** Common built-in formats
, ISO8601_Date (..)
, ISO8601_DateAndTime (..)
-- ** Format methods
, timePrint
, timeParse
, timeParseE
, localTimePrint
, localTimeParse
, localTimeParseE
) where
import Data.Char ( isDigit, isSpace, ord )
import Data.Int ( Int64 )
import Time.Calendar ( getDayOfTheYear )
import Time.Internal ( dateTimeFromUnixEpochP )
import Time.LocalTime
( LocalTime (..), localTime, localTimeToGlobal )
import Time.Time
( Period (..), Timeable (..), dateAddPeriod
, timeGetDateTimeOfDay
)
import Time.Timezone ( Timezone (..), TimezoneMinutes (..) )
import Time.Utils ( pad2, pad3, 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-digit 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 the month (@Jan@, @Feb@, ..).
| Format_DayYear
-- ^ Day of the year (@1@ to @365@, @366@ for leap years).
| Format_DayYear3
-- ^ Day of the year padded to 3 characters (@001@ 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 padded to 2 characters (@00@ to @23@).
| Format_Minute
-- ^ Minutes padded to 2 characters (@00@ to @59@).
| Format_Second
-- ^ Seconds padded to 2 characters (@00@ to @59@, @60@ for leap seconds).
| Format_UnixSecond
-- ^ Number of non-leap seconds since the Unix epoch
-- (1970-01-01 00:00:00 UTC).
| Format_MilliSecond
-- ^ The millisecond component only, padded to 3 characters (@000@ to
-- @999@). See 'Format_MicroSecond' and 'Format_NanoSecond' for other
-- named sub-second components.
| Format_MicroSecond
-- ^ The microseconds component only, padded to 3 characters (@000@ to
-- @999@). See 'Format_MilliSecond' and 'Format_NanoSecond' for other
-- named sub-second components.
| Format_NanoSecond
-- ^ The nanoseconds component only, padded to 3 characters (@000@ to
-- @999@). See 'Format_MilliSecond' and 'Format_MicroSecond' for other
-- named sub-second components.
| Format_Precision Int
-- ^ Sub-second display with a precision of n digits, with n between @1@
-- and @9@.
| Format_TimezoneName
-- ^ Timezone name.
| Format_TzHM_Colon_Z
-- ^ Zero UTC offset (@Z@) or timezone offset with colon (for example,
-- @02:00@, @+02:00@ or @-02:00@).
| Format_TzHM_Colon
-- ^ Timezone offset with colon (for example, @02:00@, @+02:00@ or
-- @-02:00@).
| Format_TzHM
-- ^ Timezone offset without colon (for example, @0200@, @+0200@ or
-- @-0200@).
| Format_Tz_Offset
-- ^ Timezone offset in minutes (for example, @120@, @+120@ or @-120@).
| Format_Spaces
-- ^ One or more space-like characters.
| Format_Text Char
-- ^ A verbatim character.
| Format_Fct TimeFormatFct
-- ^ A custom time format function. See v'TimeFormatFct'.
deriving (Eq, Show)
-- | Type representing format functions.
data TimeFormatFct = TimeFormatFct
{ timeFormatFctName :: String
-- ^ The name of the format function.
, timeFormatParse ::
(DateTime, TimezoneOffset)
-> String
-> Either String ((DateTime, TimezoneOffset), String)
-- ^ A parser of a given 'String'. The first argument is the
-- @(@v'DateTime'@,@ v'TimezoneOffset'@)@ value before the parser is
-- applied. If the parser fails, the 'Left' value provides an error message.
-- If it succeeds, the 'Right' value provides a pair of a
-- @(@v'DateTime'@,@ v'TimezoneOffset'@)@ value and any input not consumed
-- by the parser.
, timeFormatPrint :: DateTime -> TimezoneOffset -> String
-- ^ A printer of a given v'DateTime' value and v'TimezoneOffset' value.
}
-- | Show the 'timeFormatFctName' field.
instance Show TimeFormatFct where
show = timeFormatFctName
instance Eq TimeFormatFct where
t1 == t2 = timeFormatFctName t1 == timeFormatFctName t2
-- | Type representing time format strings, composed of list
-- of t'TimeFormatElem'.
newtype TimeFormatString = TimeFormatString [TimeFormatElem]
deriving (Eq, Show)
-- | A type class promising the ability to convert values to
-- a t'TimeFormatString'.
--
-- 'String' is an instance of 'TimeFormat'. Sequences of characters are
-- interpreted as follows (case-sensitive). The longest valid sequence is parsed
-- first:
--
-- [@YY@]: 'Format_Year2'. 2-digit years (@70@ is 1970, @69@ is 2069).
-- [@YYYY@]: 'Format_Year4'. 4-digit years.
-- [@M@]: 'Format_Month'. Months (@1@ to @12@).
-- [@MM@]: 'Format_Month2'. Months padded to 2 characters (@01@ to @12@).
-- [@Mon@]: 'Format_MonthName_Short'. Short name of the month (@Jan@, @Feb@,
-- ..).
-- [@JJJ@]: 'Format_DayYear3'. Day of the year padded to 3 characters (@001@
-- to @365@, @366@ for leap years).
-- [@DD@]: 'Format_Day2'. Day of the month padded to 2 characters (@01@ to
-- @31@).
-- [@H@]: 'Format_Hour'. Hours padded to 2 characters (@00@ to @23@).
-- [@MI@]: 'Format_Minute'. Minutes padded to 2 characters (@00@ to @59@).
-- [@S@]: 'Format_Second'. Seconds padded to 2 characters (@00@ to @59@,
-- @60@ for leap seconds).
-- [@EPOCH@]: 'Format_UnixSecond'. Number of non-leap seconds since the Unix
-- epoch (1970-01-01 00:00:00 UTC).
-- [@ms@]: 'Format_MilliSecond'. The millisecond component only, padded to 3
-- characters (@000@ to @999@). See @us@/@μ@ and @ns@ for other named
-- sub-second components.
-- [@us@]: 'Format_MicroSecond'. The microseconds component only, padded to 3
-- characters (@000@ to @999@). See @ms@ and @ns@ for other named
-- sub-second components.
-- [@μ@]: 'Format_MicroSecond'. As above.
-- [@ns@]: 'Format_NanoSecond'. The nanoseconds component only, padded to 3
-- characters (@000@ to @999@). See @ms@ and @us@/@μ@ for other named
-- sub-second components.
-- [@p\<n\>@]: 'Format_Precision' @\<n\>@. Sub-second display with a precision
-- of @\<n\>@ digit(s), where @\<n\>@ is @1@ to @9@.
-- [@TZH:M@]: 'Format_TzHM_Colon'. Timezone offset with colon (for example,
-- @02:00@, @+02:00@ or @-02:00@).
-- [@TZHM@]: 'Format_TzHM'. Timezone offset without colon (for example,
-- @0200@, @+0200@ or @-0200@).
-- [@TZOFS@]: 'Format_Tz_Offset'. Timezone offset in minutes (for example,
-- @120@, @+120@ or @-120@).
-- [@\<space\>@]: 'Format_Spaces'. One or more space-like characters.
-- [@\\\<character\>@]: 'Format_Text' @\<character\>@. A verbatim character.
-- [@\<character\>@]: 'Format_Text' @\<character\>@. A verbatim character.
--
-- For example:
--
-- >>> let mDateTime = timeParse ("ms \\ms us \\us ns \\ns") "123 ms 456 us 789 ns"
-- >>> timeGetNanoSeconds <$> mDateTime
-- Just 123456789ns
--
-- >>> timePrint "ms \\ms us \\us ns \\ns" <$> mDateTime
-- Just "123 ms 456 us 789 ns"
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 (Eq, 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 (Eq, Show)
instance TimeFormat [TimeFormatElem] where
toFormat = TimeFormatString
instance TimeFormat TimeFormatString where
toFormat = id
-- | For information about this instance, see the documentation for
-- 'TimeFormat'.
instance TimeFormat String where
toFormat = TimeFormatString . toFormatElem
where
toFormatElem [] = []
toFormatElem ('Y':'Y':'Y':'Y':r) = Format_Year4 : toFormatElem r
toFormatElem ('Y':'Y':r) = Format_Year2 : toFormatElem r
toFormatElem ('M':'M':r) = Format_Month2 : toFormatElem r
toFormatElem ('M':'o':'n':r) = Format_MonthName_Short : toFormatElem r
toFormatElem ('M':'I':r) = Format_Minute : toFormatElem r
toFormatElem ('M':r) = Format_Month : toFormatElem r
toFormatElem ('J':'J':'J':r) = Format_DayYear3 : toFormatElem r
toFormatElem ('D':'D':r) = Format_Day2 : toFormatElem r
toFormatElem ('H':r) = Format_Hour : toFormatElem r
toFormatElem ('S':r) = Format_Second : toFormatElem r
toFormatElem ('m':'s':r) = Format_MilliSecond : toFormatElem r
toFormatElem ('u':'s':r) = Format_MicroSecond : toFormatElem r
toFormatElem ('μ':r) = Format_MicroSecond : toFormatElem r
toFormatElem ('n':'s':r) = Format_NanoSecond : toFormatElem r
toFormatElem ('p':'1':r) = Format_Precision 1 : toFormatElem r
toFormatElem ('p':'2':r) = Format_Precision 2 : toFormatElem r
toFormatElem ('p':'3':r) = Format_Precision 3 : toFormatElem r
toFormatElem ('p':'4':r) = Format_Precision 4 : toFormatElem r
toFormatElem ('p':'5':r) = Format_Precision 5 : toFormatElem r
toFormatElem ('p':'6':r) = Format_Precision 6 : toFormatElem r
toFormatElem ('p':'7':r) = Format_Precision 7 : toFormatElem r
toFormatElem ('p':'8':r) = Format_Precision 8 : toFormatElem r
toFormatElem ('p':'9':r) = Format_Precision 9 : toFormatElem r
-----------------------------------------------------------
toFormatElem ('E':'P':'O':'C':'H':r) = Format_UnixSecond : toFormatElem r
-----------------------------------------------------------
toFormatElem ('T':'Z':'H':'M':r) = Format_TzHM : toFormatElem r
toFormatElem ('T':'Z':'H':':':'M':r) = Format_TzHM_Colon : toFormatElem r
toFormatElem ('T':'Z':'O':'F':'S':r) = Format_Tz_Offset : toFormatElem r
-----------------------------------------------------------
toFormatElem ('\\':c:r) = Format_Text c : toFormatElem r
toFormatElem (' ':r) = Format_Spaces : toFormatElem r
toFormatElem (c:r) = Format_Text c : toFormatElem r
instance TimeFormat ISO8601_Date where
toFormat _ =
TimeFormatString [Format_Year, dash, Format_Month2, dash, Format_Day2]
where
dash = Format_Text '-'
instance TimeFormat ISO8601_DateAndTime where
toFormat _ = TimeFormatString
[ Format_Year, dash, Format_Month2, dash, Format_Day2 -- date
, Format_Text 'T'
, Format_Hour, colon, Format_Minute, colon, Format_Second -- time
, Format_TzHM_Colon_Z
-- Either timezone offset with colon (±HH:MM) or UTC zero offset (Z).
]
where
dash = Format_Text '-'
colon = Format_Text ':'
monthFromShort :: String -> Either String Month
monthFromShort str =
case str of
"Jan" -> Right January
"Feb" -> Right February
"Mar" -> Right March
"Apr" -> Right April
"May" -> Right May
"Jun" -> Right June
"Jul" -> Right July
"Aug" -> Right August
"Sep" -> Right September
"Oct" -> Right October
"Nov" -> Right November
"Dec" -> Right December
_ -> Left $ "unknown month: " ++ str
printWith ::
(TimeFormat format, Timeable t)
=> format
-> t
-> TimezoneOffset
-> String
printWith fmt t tzOfs@(TimezoneOffset tz) = concatMap fmtToString fmtElems
where
fmtToString Format_Year = show (dateYear date)
fmtToString Format_Year4 = pad4 (dateYear date)
fmtToString Format_Year2 = pad2 (dateYear date - 1900)
fmtToString Format_Month2 = pad2 (fromEnum (dateMonth date) + 1)
fmtToString Format_Month = show (fromEnum (dateMonth date) + 1)
fmtToString Format_MonthName_Short = take 3 $ show (dateMonth date)
fmtToString Format_DayYear = show (getDayOfTheYear date)
fmtToString Format_DayYear3 = pad3 (getDayOfTheYear date)
fmtToString Format_Day2 = pad2 (dateDay date)
fmtToString Format_Day = show (dateDay date)
fmtToString Format_Hour = pad2 (fromIntegral (todHour tm) :: Int)
fmtToString Format_Minute = pad2 (fromIntegral (todMin tm) :: Int)
fmtToString Format_Second = pad2 (fromIntegral (todSec tm) :: Int)
fmtToString Format_MilliSecond = padN 3 (ns `div` 1000000)
fmtToString Format_MicroSecond = padN 3 ((ns `div` 1000) `mod` 1000)
fmtToString Format_NanoSecond = padN 3 (ns `mod` 1000)
fmtToString (Format_Precision n)
| n >= 1 && n <= 9 = padN n (ns `div` (10 ^ (9 - n)))
| otherwise = error "invalid precision format"
fmtToString Format_UnixSecond = show unixSecs
fmtToString Format_TimezoneName = timezoneName $ TimezoneMinutes tz
fmtToString Format_Tz_Offset = show tz
fmtToString Format_TzHM = show tzOfs
fmtToString Format_TzHM_Colon_Z
| tz == 0 = "Z"
| otherwise = fmtToString Format_TzHM_Colon
fmtToString Format_TzHM_Colon =
let (tzH, tzM) = abs tz `divMod` 60
sign = if tz < 0 then "-" else "+"
in sign ++ pad2 tzH ++ ":" ++ pad2 tzM
fmtToString Format_Spaces = " "
fmtToString (Format_Text c) = [c]
fmtToString (Format_Fct tff) = timeFormatPrint tff dateTime tzOfs
(TimeFormatString fmtElems) = toFormat fmt
(Elapsed (Seconds unixSecs)) = timeGetElapsed t
dateTime@(DateTime date tm) = timeGetDateTimeOfDay t
(NanoSeconds ns) = timeGetNanoSeconds t
-- | Given the specified format, pretty print the given local time.
--
-- A v'Format_TimezoneName' will print using the ±HH:MM format, where @0@
-- offset is printed as @-00:00@.
--
-- A v'Format_TzHM' will print using the ±HHMM format, where @0@ offset is
-- printed as @+0000@.
--
-- A v'Format_TzHM_Colon' will print using the ±HH:MM format, where @0@ offset
-- is printed as @+00:00@.
--
-- A v'Format_TzHM_Colon_Z' will print using the ±HH:MM format, but where @0@
-- offset is printed as @Z@.
--
-- A v'Format_Tz_Offset' will print non-negative offsets without using an
-- initial @+@.
--
-- A v'Format_Spaces' will print a single space character.
localTimePrint ::
(TimeFormat format, Timeable t)
=> format -- ^ The format to use for printing.
-> LocalTime t -- ^ The local time to print.
-> String
localTimePrint fmt lt =
printWith fmt (localTimeUnwrap lt) (localTimeGetTimezone lt)
-- | Like 'localTimePrint' but the time zone of the time to print will be taken
-- to be UTC.
timePrint ::
(TimeFormat format, Timeable t)
=> format -- ^ The format to use for printing.
-> t -- ^ The time to print.
-> String
timePrint fmt t = printWith fmt t timezone_UTC
-- | Given the specified format, try to parse the given string as
-- a t'LocalTime' t'DateTime' value.
--
-- On failure, yields a 'Left' value with a pair of the
-- current t'TimeFormatElem' value and the reason for the failure.
--
-- If successful, yields a 'Right' value with a pair of the parsed value and
-- the remaining unparsed string.
--
-- The default parsed t'LocalTime' t'DateTime' value is \'all zeros'\. For
-- example:
--
-- >>> let zeroDate = Date 0 January 0
-- >>> let zeroTime = TimeOfDay 0 0 0 0
-- >>> let zeroLocalTime = localTime timezone_UTC (DateTime zeroDate zeroTime)
-- >>> localTimeParseE "" "" == Right (zeroLocalTime, "")
-- True
--
-- Later t'TimeFormatElem' values can modify the result of earlier
-- t'TimeFormatElem' values. For example:
--
-- >>> let toYear = dateYear . dtDate . localTimeUnwrap . fst
-- >>> toYear <$> (localTimeParseE "YYYY YYYY" "2025 2024")
-- Right 2024
--
-- A v'Format_DayYear' or v'Format_DayYear3' value interprets the day of year
-- based on the previously parsed year or, by default, a leap year. For example:
--
-- >>> let toMonth = dateMonth . dtDate . localTimeUnwrap . fst
-- >>> let format1 = [Format_Year4, Format_Spaces, Format_DayYear]
-- >>> let format2 = [Format_DayYear, Format_Spaces, Format_Year4]
-- >>> toMonth <$> (localTimeParseE format1 "2025 60")
-- Right March
-- >>> toMonth <$> (localTimeParseE format2 "60 2025")
-- Right February
--
-- A v'Format_TimezoneName' will parse one or more non-white space characters
-- but will not modify the previously parsed, or default, date and time.
--
-- A v'Format_Month', v'Format_DayYear', v'Format_DayYear3', v'Format_Day'
-- and v'Format_Tz_Offset' will check that the parsed number is within bounds.
-- However, 'localTimeParseE' does not check that any resulting date or time is
-- a valid one.
localTimeParseE ::
TimeFormat format
=> format -- ^ The format to use for parsing.
-> String -- ^ The string to parse.
-> Either (TimeFormatElem, String) (LocalTime DateTime, String)
localTimeParseE fmt = loop ini fmtElems
where
(TimeFormatString fmtElems) = toFormat fmt
toLocal (dt, tz) = localTime tz dt
loop acc [] s = Right (toLocal acc, s)
loop _ (x:_) [] = Left (x, "empty")
loop acc (x:xs) s =
case processOne acc x s of
Left err -> Left (x, err)
Right (nacc, s') -> loop nacc xs s'
processOne ::
(DateTime, TimezoneOffset)
-> TimeFormatElem
-> [Char]
-> Either String ((DateTime, TimezoneOffset), [Char])
processOne _ _ [] = Left "empty"
processOne acc (Format_Text c) (x:xs)
| c == x = Right (acc, xs)
| otherwise = Left ("unexpected char, got: " ++ show x)
processOne acc Format_Year s =
onSuccess (\y -> modDate (setYear y) acc) $ isNumber s
processOne acc Format_Year4 s =
onSuccess (\y -> modDate (setYear y) acc) $ getNDigitNum 4 s
processOne acc Format_Year2 s = onSuccess
( \y -> let year = if y < 70 then y + 2000 else y + 1900
in modDate (setYear year) acc
)
$ getNDigitNum 2 s
processOne acc Format_Month s =
let result = isNumber s :: Either String (Int, String)
in case result of
Left err -> Left err
Right (m, s')
| m > 0 && m <= 12 ->
Right (modDate (setMonth (toEnum (m - 1))) acc, s')
| otherwise -> Left ("month invalid, got: " <> show m)
processOne acc Format_Month2 s = onSuccess
( \m -> modDate (setMonth $ toEnum ((fromIntegral m - 1) `mod` 12)) acc
)
$ getNDigitNum 2 s
processOne acc Format_MonthName_Short s =
onSuccess (\m -> modDate (setMonth m) acc) $ getMonth s
processOne acc Format_DayYear s =
let y = (dateYear . dtDate . fst) acc
result = isNumber s :: Either String (Int, String)
in case result of
Left err -> Left err
Right (d, s')
-- We can't be more helpful because we may not yet know the
-- intended year
| d > 0 && d <= 366 ->
let p = Period 0 0 (d - 1)
startOfYear = Date y January 1
in Right (modDate (const (dateAddPeriod startOfYear p)) acc, s')
| otherwise -> Left ("day of year invalid, got: " <> show d)
processOne acc Format_DayYear3 s =
let y = (dateYear . dtDate . fst) acc
result = getNDigitNum 3 s :: Either String (Int64, String)
in case result of
Left err -> Left err
Right (d, s')
-- We can't be more helpful because we may not yet know the
-- intended year
| d > 0 && d <= 366 ->
let p = Period 0 0 (fromIntegral d - 1)
startOfYear = Date y January 1
in Right (modDate (const (dateAddPeriod startOfYear p)) acc, s')
| otherwise -> Left ("day of year invalid, got: " <> show d)
processOne acc Format_Day s =
let result = isNumber s :: Either String (Int, String)
in case result of
Left err -> Left err
Right (d, s')
-- We can't be more helpful because we may not yet know the
-- intended month and year
| d > 0 && d <= 31 -> Right (modDate (setDay d) acc, s')
| otherwise -> Left ("day of month invalid, got: " <> show d)
processOne acc Format_Day2 s =
onSuccess (\d -> modDate (setDay d) acc) $ getNDigitNum 2 s
processOne acc Format_Hour s =
onSuccess (\h -> modTime (setHour h) acc) $ getNDigitNum 2 s
processOne acc Format_Minute s =
onSuccess (\mi -> modTime (setMin mi) acc) $ getNDigitNum 2 s
processOne acc Format_Second s =
onSuccess (\sec -> modTime (setSec sec) acc) $ getNDigitNum 2 s
processOne acc Format_MilliSecond s =
onSuccess (\ms -> modTime (setNsMask (6,3) ms) acc) $ getNDigitNum 3 s
processOne acc Format_MicroSecond s =
onSuccess (\us -> modTime (setNsMask (3,3) us) acc) $ getNDigitNum 3 s
processOne acc Format_NanoSecond s =
onSuccess (\ns -> modTime (setNsMask (0,3) ns) acc) $ getNDigitNum 3 s
processOne acc (Format_Precision p) s =
onSuccess (\num -> modTime (setNS num) acc) $ getNDigitNum p s
processOne acc Format_TimezoneName s = case break isSpace s of
("", _) -> Left ("no non-white space at start of: " <> s)
(_, s2) -> Right (acc, s2)
processOne acc Format_UnixSecond s =
onSuccess (\sec ->
let newDate =
dateTimeFromUnixEpochP $ flip ElapsedP 0 $ Elapsed $ Seconds sec
in modDT (const newDate) acc) $ isNumber s
processOne acc Format_TzHM_Colon_Z a@(c:s)
| c == 'Z' = Right (acc, s)
| otherwise = processOne acc Format_TzHM_Colon a
processOne acc Format_TzHM_Colon (c:s) =
parseHMSign True acc c s
processOne acc Format_TzHM (c:s) =
parseHMSign False acc c s
processOne acc Format_Tz_Offset s@(c:cs) = case c of
'-' -> process True (12 * 60) cs
'+' -> process False (14 * 60) cs
_ -> process False (14 * 60) s
where
(dt, _) = acc
process isNeg limit s' =
let result = isNumber s' :: Either String (Int, String)
in case result of
Left err -> Left err
Right (mins, rest)
| mins >= 0 && mins <= limit ->
let mins' = if isNeg then negate mins else mins
in Right ((dt, TimezoneOffset mins'), rest)
| otherwise ->
let sign = if isNeg then "-" else "+"
in Left ("offset invalid, got: " <> sign <> show mins)
processOne acc Format_Spaces s = case span isSpace s of
("", _) -> Left ("no white space at start of: " <> s)
(_, s2) -> Right (acc, s2)
processOne acc (Format_Fct tff) s = timeFormatParse tff acc s
parseHMSign expectColon acc signChar afterSign =
case signChar of
'+' -> parseHM False expectColon afterSign acc
'-' -> parseHM True expectColon afterSign acc
_ -> parseHM False expectColon (signChar:afterSign) acc
parseHM isNeg True (h1:h2:':':m1:m2:xs) acc
| allDigits [h1,h2,m1,m2] = let tz = toTZ isNeg h1 h2 m1 m2
in Right (modTZ (const tz) acc, xs)
| otherwise = Left ("non-digit char(s) in: " ++ show [h1,h2,m1,m2])
parseHM isNeg False (h1:h2:m1:m2:xs) acc
| allDigits [h1,h2,m1,m2] = let tz = toTZ isNeg h1 h2 m1 m2
in Right (modTZ (const tz) acc, xs)
| otherwise = Left ("non-digit char(s) in: " ++ show [h1,h2,m1,m2])
parseHM _ _ _ _ = Left "invalid timezone format"
toTZ isNeg h1 h2 m1 m2 = TimezoneOffset ((if isNeg then negate else id) minutes)
where
minutes = (toInt [h1,h2] * 60) + toInt [m1,m2]
onSuccess f (Right (v, s')) = Right (f v, s')
onSuccess _ (Left s) = Left s
isNumber :: Num a => String -> Either String (a, String)
isNumber s =
case span isDigit s of
("", s2) -> Left ("no digits at start of:" ++ s2)
(s1, s2) -> Right (toInt s1, s2)
getNDigitNum :: Int -> String -> Either String (Int64, String)
getNDigitNum n s =
case getNChar n s of
Left err -> Left err
Right (s1, s2)
| not (allDigits s1) -> Left ("non-digit char(s) in " ++ show s1)
| otherwise -> Right (toInt s1, s2)
getMonth :: String -> Either String (Month, String)
getMonth s =
getNChar 3 s >>= \(s1, s2) -> monthFromShort s1 >>= \m -> Right (m, s2)
getNChar :: Int -> String -> Either String (String, String)
getNChar n s
| length s1 < n =
Left ("not enough chars: expecting " ++ show n ++ " got " ++ show s1)
| otherwise = Right (s1, s2)
where
(s1, s2) = splitAt n s
toInt :: Num a => String -> a
toInt = foldl (\acc w -> acc * 10 + fromIntegral (ord w - ord '0')) 0
allDigits = all isDigit
ini = (DateTime (Date 0 (toEnum 0) 0) (TimeOfDay 0 0 0 0), TimezoneOffset 0)
modDT f (dt, tz) = (f dt, tz)
modDate f (DateTime d tp, tz) = (DateTime (f d) tp, tz)
modTime f (DateTime d tp, tz) = (DateTime d (f tp), tz)
modTZ f (dt, tz) = (dt, f tz)
setYear :: Int64 -> Date -> Date
setYear y (Date _ m d) = Date (fromIntegral y) m d
setMonth m (Date y _ d) = Date y m d
setDay d (Date y m _) = Date y m (fromIntegral d)
setHour h (TimeOfDay _ m s ns) = TimeOfDay (Hours h) m s ns
setMin m (TimeOfDay h _ s ns) = TimeOfDay h (Minutes m) s ns
setSec s (TimeOfDay h m _ ns) = TimeOfDay h m (Seconds s) ns
setNS v (TimeOfDay h m s _ ) = TimeOfDay h m s (NanoSeconds v)
setNsMask :: (Int, Int) -> Int64 -> TimeOfDay -> TimeOfDay
setNsMask (shift, mask) val (TimeOfDay h mins seconds (NanoSeconds ns)) =
let (nsD,keepL) = ns `divMod` s
(keepH,_) = nsD `divMod` m
v = ((keepH * m + fromIntegral val) * s) + keepL
in TimeOfDay h mins seconds (NanoSeconds v)
where
s = 10 ^ shift
m = 10 ^ mask
-- | Like 'localTimeParseE', but with simpler handing of failure. Does not yield
-- the remaining unparsed string on success.
--
-- On failure, returns 'Nothing'. If successful, yields 'Just' the parsed value.
localTimeParse ::
TimeFormat format
=> format -- ^ The format to use for parsing.
-> String -- ^ The string to parse.
-> Maybe (LocalTime DateTime)
localTimeParse fmt s =
either (const Nothing) (Just . fst) $ localTimeParseE fmt s
-- | Like 'localTimeParseE' but the time value is automatically converted to
-- global time.
timeParseE ::
TimeFormat format
=> format
-> String
-> Either (TimeFormatElem, String) (DateTime, String)
timeParseE fmt timeString =
(\(d, s) -> Right (localTimeToGlobal d, s)) =<< localTimeParseE fmt timeString
-- | Like 'localTimeParse' but the time value is automatically converted to
-- global time.
timeParse :: TimeFormat format => format -> String -> Maybe DateTime
timeParse fmt s = localTimeToGlobal `fmap` localTimeParse fmt s