time-exts 2.0.0 → 2.1.0
raw patch · 6 files changed
+877/−83 lines, 6 filesdep +attoparsecdep +data-defaultdep +mtl
Dependencies added: attoparsec, data-default, mtl, old-locale, text
Files
- src/Data/Time/Exts.hs +4/−0
- src/Data/Time/Exts/Local.hs +5/−5
- src/Data/Time/Exts/Parser.hs +770/−0
- src/Data/Time/Exts/Test.hs +7/−6
- src/Data/Time/Exts/Zone.hs +77/−69
- time-exts.cabal +14/−3
src/Data/Time/Exts.hs view
@@ -16,6 +16,9 @@ -- ** UTC and Local Timestamps , module Data.Time.Exts.Local + -- ** Timestamp Parsers+ , module Data.Time.Exts.Parser+ -- ** Locations and Time Zones , module Data.Time.Exts.Zone @@ -27,5 +30,6 @@ import Data.Time.Exts.Base hiding (TimeZone) import Data.Time.Exts.C import Data.Time.Exts.Local+import Data.Time.Exts.Parser import Data.Time.Exts.Unix import Data.Time.Exts.Zone
src/Data/Time/Exts/Local.hs view
@@ -261,23 +261,23 @@ maxBound = LocalDate 2932896 maxzone instance Bounded LocalDateTime where- minBound = LocalDateTime 43200 0+ minBound = LocalDateTime 0 0 maxBound = LocalDateTime 253402257624 maxzone instance Bounded LocalDateTimeMillis where- minBound = LocalDateTimeMillis 43200000 0+ minBound = LocalDateTimeMillis 0 0 maxBound = LocalDateTimeMillis 253402257624999 maxzone instance Bounded LocalDateTimeMicros where- minBound = LocalDateTimeMicros 43200000000 0+ minBound = LocalDateTimeMicros 0 0 maxBound = LocalDateTimeMicros 253402257624999999 maxzone instance Bounded LocalDateTimeNanos where- minBound = LocalDateTimeNanos 43200000000 0 0+ minBound = LocalDateTimeNanos 0 0 0 maxBound = LocalDateTimeNanos 253402257624999999 999 maxzone instance Bounded LocalDateTimePicos where- minBound = LocalDateTimePicos 43200000000 0 0+ minBound = LocalDateTimePicos 0 0 0 maxBound = LocalDateTimePicos 253402257624999999 999999 maxzone instance Local LocalDate where
+ src/Data/Time/Exts/Parser.hs view
@@ -0,0 +1,770 @@+--------------------------------------------------------------------------------+-- Copyright (c) 2014, Enzo Haussecker, Steve Severance. All rights reserved. --+--------------------------------------------------------------------------------++{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UnicodeSyntax #-}+{-# OPTIONS -Wall #-}++-- | Timestamp parsers and related utilities.+module Data.Time.Exts.Parser (++ -- ** Utilities+ FormatText+ , ParseError(..)++ -- ** Parse Unix Timestamps+ , parseUnixDate+ , parseUnixTime+ , parseUnixTimeMillis+ , parseUnixTimeMicros+ , parseUnixTimeNanos+ , parseUnixTimePicos+ , parseUnixDateTime+ , parseUnixDateTimeMillis+ , parseUnixDateTimeMicros+ , parseUnixDateTimeNanos+ , parseUnixDateTimePicos++ -- ** Parse UTC and Local Timestamps+ , parseLocalDate+ , parseLocalDateTime+ , parseLocalDateTimeMillis+ , parseLocalDateTimeMicros+ , parseLocalDateTimeNanos+ , parseLocalDateTimePicos++ -- ** Parse Unix Timestamps With Parameters+ , parseUnixDate'+ , parseUnixTime'+ , parseUnixTimeMillis'+ , parseUnixTimeMicros'+ , parseUnixTimeNanos'+ , parseUnixTimePicos'+ , parseUnixDateTime'+ , parseUnixDateTimeMillis'+ , parseUnixDateTimeMicros'+ , parseUnixDateTimeNanos'+ , parseUnixDateTimePicos'++ -- ** Parse UTC and Local Timestamps With Parameters+ , parseLocalDate'+ , parseLocalDateTime'+ , parseLocalDateTimeMillis'+ , parseLocalDateTimeMicros'+ , parseLocalDateTimeNanos'+ , parseLocalDateTimePicos'++ ) where++import Control.Applicative ((<|>), (<$>), (*>))+import Control.Arrow ((***))+import Control.Exception (Exception)+import Control.Monad+import Control.Monad.State.Strict (execState, State)+import Data.Attoparsec.Text as P hiding (decimal)+import Data.Convertible (Convertible(..), prettyConvertError)+import Data.Char (isAlpha)+import Data.Default (def)+import Data.Label ((:->), mkLabels)+import Data.Label.Monadic (puts, modify)+import Data.List as L (foldl', foldl1, map, zip)+import Data.String (IsString(..))+import Data.Text as T+import Data.Time.Exts.Base hiding (TimeZone)+import Data.Time.Exts.Local+import Data.Time.Exts.Unix+import Data.Time.Exts.Zone+import Data.Typeable (Typeable)+import System.Locale (TimeLocale(..))++-- | The format string is composed of various %-codes, each+-- representing time-related information described below.+--+-- [@%%@] A literal '%' character.+--+-- [@%A@] The full weekday name according to the current locale.+--+-- [@%a@] The abbreviated weekday name according to the current locale.+--+-- [@%B@] The full month name according to the current locale.+--+-- [@%b@] The abbreviated month name according to the current locale.+--+-- [@%D@] Equivalent to %m\/%d\/%y.+--+-- [@%d@] The day of the month as a decimal number (range 01 to 31).+--+-- [@%e@] Like %d, the day of the month as a decimal number, but a leading zero is replaced by a space.+--+-- [@%F@] Equivalent to %Y-%m-%d (the ISO 8601 date format).+--+-- [@%H@] The hour as a decimal number using a 24-hour clock (range 00 to 23).+--+-- [@%h@] Equivalent to %b.+--+-- [@%I@] The hour as a decimal number using a 12-hour clock (range 01 to 12).+--+-- [@%l@] Like %I, the hour as a decimal number using a 12-hour clock, but a leading zero is replaced by a space.+--+-- [@%M@] The minute as a decimal number (range 00 to 59).+--+-- [@%m@] The month as a decimal number (range 01 to 12).+--+-- [@%P@] Like %p, the period of the day according to the current locale, but lowercase.+--+-- [@%p@] The period of the day according to the current locale.+--+-- [@%Q@] The fraction of the second as a decimal number (range 0 to 999999999999).+--+-- [@%R@] Equivalent to %H:%M.+--+-- [@%r@] Equivalent to %I:%M:%S %p.+--+-- [@%S@] The second as a decimal number (range 00 to 60).+--+-- [@%T@] Equivalent to %H:%M:%S.+--+-- [@%Y@] The year as a decimal number (range 1970 to 9999).+--+-- [@%y@] The year as a decimal number without a century (range 00 to 99). +--+-- [@%Z@] The timezone abbreviation. +type FormatText = Text++-- | Error handling type.+newtype ParseError = ParseError String deriving (Show,Typeable)++instance Exception ParseError++instance IsString ParseError where+ fromString = ParseError++-- | A struct with date, time, and time zone+-- components, plus component modifiers.+data TZ = TZ {+ _set_year :: Year+ , _set_mon :: Month+ , _set_mday :: Day+ , _set_wday :: DayOfWeek+ , _set_hour :: Hour+ , _set_min :: Minute+ , _set_sec :: Double+ , _set_frac :: Double -> Double+ , _set_ampm :: Hour -> Hour+ , _set_zone :: TimeZone+ }++mkLabels [''TZ]++-- | Parse a Unix date.+--+-- > >>> parseUnixDate "%A, %B %e, %Y" "Tuesday, March 4, 2014"+-- > Right 2014-03-04+--+parseUnixDate :: FormatText -> Text -> Either ParseError UnixDate+parseUnixDate = parseUnixDate' def++-- | Same as @parseUnixDate@, except takes an additional locale parameter.+--+-- > >>> let german = defaultTimeLocale { wDays = [("Sonntag","So"),("Montag","Mo")...+-- > >>> parseUnixDate' german "%A, %B %e, %Y" "Dienstag, März 4, 2014"+-- > Right 2014-03-04+--+parseUnixDate' :: TimeLocale -> FormatText -> Text -> Either ParseError UnixDate+parseUnixDate' locale format text = fun <$> parseTimestamp locale Universal format text+ where fun TZ{..} = createUnixDate _set_year _set_mon _set_mday++-- | Parse a Unix time.+--+-- > >>> parseUnixTime "%T" "15:32:19"+-- > Right 15:32:19+--+parseUnixTime :: FormatText -> Text -> Either ParseError UnixTime+parseUnixTime = parseUnixTime' def++-- | Same as @parseUnixTime@, except takes an additional locale parameter. +--+-- > >>> let albanian = defaultTimeLocale { wDays = [("e diel","Die"),("e hënë ","Hën")...+-- > >>> parseUnixTime' albanian "%l:%M:%S %p" "12:28:47 PD"+-- > Right 00:28:47+--+parseUnixTime' :: TimeLocale -> FormatText -> Text -> Either ParseError UnixTime+parseUnixTime' locale format text = fun <$> parseTimestamp locale Universal format text+ where fun TZ{..} = createUnixTime hour _set_min sec+ where hour = _set_ampm _set_hour+ sec = truncate _set_sec++-- | Parse a Unix time with millisecond granularity.+--+-- > >>> parseUnixTimeMillis "%I:%M:%S.%Q %p" "09:41:09.313 PM"+-- > Right 21:41:09.313+--+parseUnixTimeMillis :: FormatText -> Text -> Either ParseError UnixTimeMillis+parseUnixTimeMillis = parseUnixTimeMillis' def++-- | Same as @parseUnixTimeMillis@, except takes an additional locale parameter.+--+-- > >>> let urdu = defaultTimeLocale { wDays = [("پير","پير"),("اتوار","اتوار")...+-- > >>> parseUnixTimeMillis' urdu "%l:%M:%S.%Q %p" " 3:12:47.624 ش"+-- > Right 15:12:47.624+--+parseUnixTimeMillis' :: TimeLocale -> FormatText -> Text -> Either ParseError UnixTimeMillis+parseUnixTimeMillis' locale format text = fun <$> parseTimestamp locale Universal format text+ where fun TZ{..} = createUnixTimeMillis hour _set_min sec mil+ where hour = _set_ampm _set_hour+ (,) sec mil = properFracMillis $ _set_frac _set_sec++-- | Parse a Unix time with microsecond granularity.+--+-- > >>> parseUnixTimeMicros "%R:%S.%Q" "03:15:50.513439"+-- > Right 03:15:50.513439+--+parseUnixTimeMicros :: FormatText -> Text -> Either ParseError UnixTimeMicros+parseUnixTimeMicros = parseUnixTimeMicros' def++-- | Same as @parseUnixTimeMicros@, except takes an additional locale parameter.+--+-- > >>> let chinese = defaultTimeLocale { wDays = [("星期日","日"),("星期一","一")...+-- > >>> parseUnixTimeMicros' chinese "%p%I:%M:%S.%Q" "下午11:46:18.130561"+-- > Right 23:46:18.130561+--+parseUnixTimeMicros' :: TimeLocale -> FormatText -> Text -> Either ParseError UnixTimeMicros+parseUnixTimeMicros' locale format text = fun <$> parseTimestamp locale Universal format text+ where fun TZ{..} = createUnixTimeMicros hour _set_min sec mic+ where hour = _set_ampm _set_hour+ (,) sec mic = properFracMicros $ _set_frac _set_sec++-- | Parse a Unix time with nanosecond granularity.+--+-- > >>> parseUnixTimeNanos "%l:%M:%S.%Q %P" " 1:27:44.001256754 pm"+-- > Right 13:27:44.001256754+--+parseUnixTimeNanos :: FormatText -> Text -> Either ParseError UnixTimeNanos+parseUnixTimeNanos = parseUnixTimeNanos' def++-- | Same as @parseUnixTimeNanos@, except takes an additional locale parameter.+--+-- > >>> let swahili = defaultTimeLocale { wDays = [("Jumapili","J2"),("Jumatatu","J3")...+-- > >>> parseUnixTimeNanos' swahili "%H:%M:%S.%Q %p" "12:05:50.547621324 asubuhi"+-- > Right 00:05:50.547621324+--+parseUnixTimeNanos' :: TimeLocale -> FormatText -> Text -> Either ParseError UnixTimeNanos+parseUnixTimeNanos' locale format text = fun <$> parseTimestamp locale Universal format text+ where fun TZ{..} = createUnixTimeNanos hour _set_min sec nan+ where hour = _set_ampm _set_hour+ (,) sec nan = properFracNanos $ _set_frac _set_sec++-- | Parse a Unix time with picosecond granularity.+--+-- > >>> parseUnixTimePicos "%T.%Q" "13:09:23.247795919586"+-- > Right 13:09:23.247795919586+--+parseUnixTimePicos :: FormatText -> Text -> Either ParseError UnixTimePicos+parseUnixTimePicos = parseUnixTimePicos' def++-- | Same as @parseUnixTimePicos@, except takes an additional locale parameter.+--+-- > >>> let japanese = defaultTimeLocale { wDays = [("日曜日","日"),("月曜日","月")...+-- > >>> parseUnixTimePicos' japanese "%I:%M:%S.%Q %p" "04:20:15.340563315063 午前"+-- > Right 04:20:15.340563315063+--+parseUnixTimePicos' :: TimeLocale -> FormatText -> Text -> Either ParseError UnixTimePicos+parseUnixTimePicos' locale format text = fun <$> parseTimestamp locale Universal format text+ where fun TZ{..} = createUnixTimePicos hour _set_min sec pic+ where hour = _set_ampm _set_hour+ (,) sec pic = properFracPicos $ _set_frac _set_sec++-- | Parse a Unix date and time.+--+-- > >>> parseUnixDateTime "%FT%TZ" "2014-02-27T11:31:20Z"+-- > Right 2014-02-27 11:31:20+--+parseUnixDateTime :: FormatText -> Text -> Either ParseError UnixDateTime+parseUnixDateTime = parseUnixDateTime' def++-- | Same as @parseUnixDateTime@, except takes an additional locale parameter.+--+-- > >>> let somali = defaultTimeLocale { wDays = [("Axad","Axa"),("Isniin","Isn")...+-- > >>> parseUnixDateTime' somali "%A, %B %e, %r %Y" "Salaaso, Bisha Saddexaad 11, 03:41:33 galabnimo 2014"+-- > Right 2014-03-11 15:41:33+--+parseUnixDateTime' :: TimeLocale -> FormatText -> Text -> Either ParseError UnixDateTime+parseUnixDateTime' locale format text = fun <$> parseTimestamp locale Universal format text+ where fun TZ{..} = createUnixDateTime _set_year _set_mon _set_mday hour _set_min sec+ where hour = _set_ampm _set_hour+ sec = truncate _set_sec++-- | Parse a Unix date and time with millisecond granularity.+--+-- > >>> parseUnixDateTimeMillis "%a %B %e %I:%M:%S.%Q %p %Y" "Wed March 5 06:53:04.475 PM 2014"+-- > Right 2014-03-05 18:53:04.475+--+parseUnixDateTimeMillis :: FormatText -> Text -> Either ParseError UnixDateTimeMillis+parseUnixDateTimeMillis = parseUnixDateTimeMillis' def++-- | Same as @parseUnixDateTimeMillis@, except takes an additional locale parameter.+--+-- > >>> let turkish = defaultTimeLocale { wDays = [("Pazar","Paz"),("Pazartesi","Pzt")...+-- > >>> parseUnixDateTimeMillis' turkish "%a %B %e %I:%M:%S.%Q %p %Y" "Prş Mart 13 07:22:54.324 ÖS 2014"+-- > Right 2014-03-13 19:22:54.324+--+parseUnixDateTimeMillis' :: TimeLocale -> FormatText -> Text -> Either ParseError UnixDateTimeMillis+parseUnixDateTimeMillis' locale format text = fun <$> parseTimestamp locale Universal format text+ where fun TZ{..} = createUnixDateTimeMillis _set_year _set_mon _set_mday hour _set_min sec mil+ where hour = _set_ampm _set_hour+ (,) sec mil = properFracMillis $ _set_frac _set_sec++-- | Parse a Unix date and time with microsecond granularity.+--+-- > >>> parseUnixDateTimeMicros "%D %T.%Q" "03/06/14 17:26:55.148415"+-- > Right 2014-03-06 17:26:55.148415+--+parseUnixDateTimeMicros :: FormatText -> Text -> Either ParseError UnixDateTimeMicros+parseUnixDateTimeMicros = parseUnixDateTimeMicros' def++-- | Same as @parseUnixDateTimeMicros@, except takes an additional locale parameter.+--+-- > >>> let angika = defaultTimeLocale { wDays = [("रविवार","रवि"),("सोमवार","सोम")...+-- > >>> parseUnixDateTimeMicros' angika "%A %d %B %Y %I:%M:%S.%Q %p" "शुक्रवार 07 मार्च 2014 07:10:50.283025 अपराह्न"+-- > Right 2014-03-07 19:10:50.283025+--+parseUnixDateTimeMicros' :: TimeLocale -> FormatText -> Text -> Either ParseError UnixDateTimeMicros+parseUnixDateTimeMicros' locale format text = fun <$> parseTimestamp locale Universal format text+ where fun TZ{..} = createUnixDateTimeMicros _set_year _set_mon _set_mday hour _set_min sec mic+ where hour = _set_ampm _set_hour+ (,) sec mic = properFracMicros $ _set_frac _set_sec++-- | Parse a Unix date and time with nanosecond granularity.+--+-- > >>> parseUnixDateTimeNanos "%d.%m.%Y %I:%M:%S.%Q %p" "18.03.2014 07:06:43.774295132 PM"+-- > Right 2014-03-18 19:06:43.774295132+--+parseUnixDateTimeNanos :: FormatText -> Text -> Either ParseError UnixDateTimeNanos+parseUnixDateTimeNanos = parseUnixDateTimeNanos' def++-- | Same as @parseUnixDateTimeNanos@, except takes an additional locale parameter.+--+-- > >>> let russian = defaultTimeLocale { wDays = [("Воскресенье","Вс"),("Понедельник","Пн")...+-- > >>> parseUnixDateTimeNanos' russian "%a %d %b %Y %T.%Q" "Ср 11 дек 2013 22:17:42.146648836"+-- > Right 2013-12-11 22:17:42.146648836+--+parseUnixDateTimeNanos' :: TimeLocale -> FormatText -> Text -> Either ParseError UnixDateTimeNanos+parseUnixDateTimeNanos' locale format text = fun <$> parseTimestamp locale Universal format text+ where fun TZ{..} = createUnixDateTimeNanos _set_year _set_mon _set_mday hour _set_min sec nan+ where hour = _set_ampm _set_hour+ (,) sec nan = properFracNanos $ _set_frac _set_sec++-- | Parse a Unix date and time with picosecond granularity.+--+-- > >>> parseUnixDateTimePicos "%FT%T.%QZ" "2014-03-03T17:58:15.916795765305Z"+-- > Right 2014-03-03 17:58:15.916795765305+--+parseUnixDateTimePicos :: FormatText -> Text -> Either ParseError UnixDateTimePicos+parseUnixDateTimePicos = parseUnixDateTimePicos' def++-- | Same as @parseUnixDateTimePicos@, except takes an additional locale parameter.+--+-- > >>> let norwegian = defaultTimeLocale { wDays = [("søndag","sø."),("mandag","ma.")...+-- > >>> parseUnixDateTimePicos' norwegian "%a %d. %b %Y kl. %H.%M.%S.%Q" "fr. 07. mars 2014 kl. 21.11.55.837472109433"+-- > Right 2014-03-07 21:11:55.837472109433+--+parseUnixDateTimePicos' :: TimeLocale -> FormatText -> Text -> Either ParseError UnixDateTimePicos+parseUnixDateTimePicos' locale format text = fun <$> parseTimestamp locale Universal format text+ where fun TZ{..} = createUnixDateTimePicos _set_year _set_mon _set_mday hour _set_min sec pic+ where hour = _set_ampm _set_hour+ (,) sec pic = properFracPicos $ _set_frac _set_sec++-- | Parse a local date.+--+-- > >>> parseLocalDate "%A, %B %e, %Y (%Z)" "Monday, March 17, 2014 (PST)"+-- > Right 2014-03-17 PST+--+parseLocalDate :: FormatText -> Text -> Either ParseError LocalDate+parseLocalDate = parseLocalDate' def Universal++-- | Same as @parseLocalDate@, except takes an additional locale and city parameter.+--+-- > >>> parseLocalDate' defaultTimeLocale Kolkata "%A, %B %e, %Y (%Z)" "Monday, March 17, 2014 (IST)"+-- > Right 2014-03-17 IST+--+-- Note that the city parameter is required to distinguish between the India and Israel.+parseLocalDate' :: TimeLocale -> City -> FormatText -> Text -> Either ParseError LocalDate+parseLocalDate' locale city format text = fun <$> parseTimestamp locale city format text+ where fun TZ{..} = createLocalDate _set_year _set_mon _set_mday _set_zone++-- | Parse a local date and time.+--+-- > >>> parseLocalDateTime "%a %b %e %H:%M:%S %Z %Y" "Fri Mar 14 09:29:53 EST 2014"+-- > Right 2014-03-14 09:29:53 EST+--+parseLocalDateTime :: FormatText -> Text -> Either ParseError LocalDateTime+parseLocalDateTime = parseLocalDateTime' def Universal++-- | Same as @parseLocalDateTime@, except takes an additional locale and city parameter.+--+-- > >>> let french = defaultTimeLocale { wDays = [("dimanche","dim."),("lundi","lun.")...+-- > >>> parseLocalDateTime' french Paris "%a %d %b %T %Z %Y" "ven. 07 mars 22:49:03 UTC 2014"+-- > Right 2014-03-07 22:49:03 UTC+--+parseLocalDateTime' :: TimeLocale -> City -> FormatText -> Text -> Either ParseError LocalDateTime+parseLocalDateTime' locale city format text = fun <$> parseTimestamp locale city format text+ where fun TZ{..} = createLocalDateTime _set_year _set_mon _set_mday hour _set_min sec _set_zone+ where hour = _set_ampm _set_hour+ sec = truncate _set_sec++-- | Parse a local date and time with millisecond granularity.+--+-- > >>> parseLocalDateTimeMillis "%B %e %Y %I:%M:%S.%Q %p %Z" "July 1 2012 01:59:60.215 AM EET"+-- > Right 2012-07-01 01:59:60.215 EET+--+-- Note that the timestamp in the example above corresponds to a leap second.+parseLocalDateTimeMillis :: FormatText -> Text -> Either ParseError LocalDateTimeMillis+parseLocalDateTimeMillis = parseLocalDateTimeMillis' def Universal++-- | Same as @parseLocalDateTimeMillis@, except takes an additional locale and city parameter.+--+-- > >>> parseLocalDateTimeMillis' defaultTimeLocale Chicago "%B %e %Y %I:%M:%S.%Q %p %Z" "July 13 2013 12:15:30.985 AM CDT"+-- > Right 2013-07-13 00:15:30.985 CDT+--+-- Note that the city parameter is required to distinguish between the United States and China.+parseLocalDateTimeMillis' :: TimeLocale -> City -> FormatText -> Text -> Either ParseError LocalDateTimeMillis+parseLocalDateTimeMillis' locale city format text = fun <$> parseTimestamp locale city format text+ where fun TZ{..} = createLocalDateTimeMillis _set_year _set_mon _set_mday hour _set_min sec mil _set_zone+ where hour = _set_ampm _set_hour+ (,) sec mil = properFracMillis $ _set_frac _set_sec++-- | Parse a local date and time with microsecond granularity.+--+-- > >>> parseLocalDateTimeMicros "%F %T.%Q (%Z)" "2014-03-04 02:45:42.827495 (HKT)"+-- > Right 2014-03-04 02:45:42.827495 HKT+--+parseLocalDateTimeMicros :: FormatText -> Text -> Either ParseError LocalDateTimeMicros+parseLocalDateTimeMicros = parseLocalDateTimeMicros' def Universal++-- | Same as @parseLocalDateTimeMicros@, except takes an additional locale and city parameter.+--+-- > >>> let spanish = defaultTimeLocale { wDays = [("domingo","dom"),("lunes","lun")...+-- > >>> parseLocalDateTimeMicros' spanish Paris "%a %d %b %I:%M:%S.%Q %P %Y %Z" "dom 26 ene 04:27:16.743312 pm 2014 CET"+-- > Right 2014-01-26 16:27:16.743312 CET+--+parseLocalDateTimeMicros' :: TimeLocale -> City -> FormatText -> Text -> Either ParseError LocalDateTimeMicros+parseLocalDateTimeMicros' locale city format text = fun <$> parseTimestamp locale city format text+ where fun TZ{..} = createLocalDateTimeMicros _set_year _set_mon _set_mday hour _set_min sec mic _set_zone+ where hour = _set_ampm _set_hour+ (,) sec mic = properFracMicros $ _set_frac _set_sec++-- | Parse a local date and time with nanosecond granularity.+--+-- > >>> parseLocalDateTimeNanos "%b. %d, %T.%Q %Z %Y" "Mar. 09, 18:53:55.856423459 UTC 2014"+-- > Right 2014-03-09 18:53:55.856423459 UTC+--+parseLocalDateTimeNanos :: FormatText -> Text -> Either ParseError LocalDateTimeNanos+parseLocalDateTimeNanos = parseLocalDateTimeNanos' def Universal++-- | Same as @parseLocalDateTimeNanos@, except takes an additional locale and city parameter.+--+-- > >>> let italian = defaultTimeLocale { wDays = [("domenica","dom"),("lunedì","lun")...+-- > >>> parseLocalDateTimeNanos' italian Paris "%a %e %b %Y %T.%Q %Z" "sab 12 apr 2014 04:59:21.528207540 CEST"+-- > Right 2014-04-12 04:59:21.528207540 CEST+--+parseLocalDateTimeNanos' :: TimeLocale -> City -> FormatText -> Text -> Either ParseError LocalDateTimeNanos+parseLocalDateTimeNanos' locale city format text = fun <$> parseTimestamp locale city format text+ where fun TZ{..} = createLocalDateTimeNanos _set_year _set_mon _set_mday hour _set_min sec nan _set_zone+ where hour = _set_ampm _set_hour+ (,) sec nan = properFracNanos $ _set_frac _set_sec++-- | Parse a local date and time with picosecond granularity.+--+-- > >>> parseLocalDateTimePicos "%d.%m.%Y %T.%Q %Z" "09.04.2014 05:22:56.587234905781 SGT"+-- > Right 2014-04-09 05:22:56.587234905781 SGT+--+parseLocalDateTimePicos :: FormatText -> Text -> Either ParseError LocalDateTimePicos+parseLocalDateTimePicos = parseLocalDateTimePicos' def Universal++-- | Same as @parseLocalDateTimePicos@, except takes an additional locale and city parameter.+--+-- > >>> parseLocalDateTimePicos' defaultTimeLocale Shanghai "%a %b %d %Y %T.%Q %Z" "Sat Mar 08 2014 22:51:47.264356423524 CST"+-- > Right 2014-03-08 22:51:47.264356423524 CST+--+-- Note that the city parameter is required to distinguish between the United States and China.+parseLocalDateTimePicos' :: TimeLocale -> City -> FormatText -> Text -> Either ParseError LocalDateTimePicos+parseLocalDateTimePicos' locale city format text = fun <$> parseTimestamp locale city format text+ where fun TZ{..} = createLocalDateTimePicos _set_year _set_mon _set_mday hour _set_min sec pic _set_zone+ where hour = _set_ampm _set_hour+ (,) sec pic = properFracPicos $ _set_frac _set_sec++-- | Initialize timestamp components.+initTZ :: TZ+initTZ = TZ 1970 January 1 Thursday 0 0 0.0 id id utc++-- | Parse timestamp components.+parseTimestamp+ :: TimeLocale+ -> City+ -> FormatText+ -> Text+ -> Either ParseError TZ+parseTimestamp locale city format text =+ either left Right $ do+ parser <- parseFormat locale city format+ parseOnly parser text+ where left = Left . ParseError++-- | Parse format text.+parseFormat+ :: TimeLocale+ -> City+ -> FormatText+ -> Either String (Parser TZ)+parseFormat locale city =+ fmap exec . parseOnly parser+ where parser = many' $ createParser locale city+ exec x = flip execState initTZ <$> sequence <$> sequence x++-- | Create a format text parser.+createParser+ :: TimeLocale+ -> City+ -> Parser (Parser (State TZ ()))+createParser locale city =+ matchLit "%%"+ <|> matchSet "%A" set_wday (weekLong locale)+ <|> matchSet "%a" set_wday (weekShort locale)+ <|> matchSet "%B" set_mon (monthLong locale)+ <|> matchSet "%b" set_mon (monthShort locale)+ <|> matchMDY "%D" set_year set_mon set_mday+ <|> matchSet "%d" set_mday (fixInt 2)+ <|> matchSet "%e" set_mday padIntTwo+ <|> matchYMD "%F" set_year set_mon set_mday+ <|> matchSet "%H" set_hour (fixInt 2)+ <|> matchSet "%h" set_mon (monthShort locale)+ <|> matchSet "%I" set_hour (fixInt 2)+ <|> matchSet "%l" set_hour padIntTwo+ <|> matchSet "%M" set_min (fixInt 2)+ <|> matchSet "%m" set_mon monthInt+ <|> matchSet "%P" set_ampm (period locale toLower)+ <|> matchSet "%p" set_ampm (period locale id)+ <|> matchSet "%Q" set_frac fraction+ <|> matchHM "%R" set_hour set_min+ <|> matchT12 "%r" set_hour set_min set_sec locale+ <|> matchSet "%S" set_sec second+ <|> matchHMS "%T" set_hour set_min set_sec+ <|> matchSet "%Y" set_year (fixInt 4)+ <|> matchSet "%y" set_year yearTwo+ <|> matchSet "%Z" set_zone (timezone city)+ <|> matchTxt++-- | Match a percent literal.+matchLit+ :: Text+ -> Parser (Parser (State TZ ()))+matchLit code =+ string code *>+ return (char '%' *> return (return ()))++-- | Match a percent code and update the field+-- with the value returned by the parser.+matchSet + :: Text+ -> (TZ :-> a)+ -> Parser a+ -> Parser (Parser (State TZ ()))+matchSet code field parser =+ string code *> return (puts field <$> parser)++-- | Match a year-month-day percent code and update+-- the fields with the values returned by the parser.+matchYMD+ :: Text+ -> (TZ :-> Year )+ -> (TZ :-> Month)+ -> (TZ :-> Day )+ -> Parser (Parser (State TZ ()))+matchYMD code _year _mon _day =+ string code *> return parser where+ parser = do+ y <- fixInt 4; _ <- char '-'+ m <- monthInt; _ <- char '-'+ d <- fixInt 2+ return $!+ puts _year y *>+ puts _mon m *>+ puts _day d++-- | Match a month-day-year percent code and update+-- the fields with the values returned by the parser.+matchMDY+ :: Text+ -> (TZ :-> Year )+ -> (TZ :-> Month)+ -> (TZ :-> Day )+ -> Parser (Parser (State TZ ()))+matchMDY code _year _mon _day =+ string code *> return parser where+ parser = do+ m <- monthInt; _ <- char '/'+ d <- fixInt 2; _ <- char '/'+ y <- yearTwo+ return $!+ puts _year y *>+ puts _mon m *>+ puts _day d++-- | Match a hour-minute percent code and update the+-- fields with the values returned by the parser.+matchHM+ :: Text+ -> (TZ :-> Hour )+ -> (TZ :-> Minute)+ -> Parser (Parser (State TZ ()))+matchHM code _hour _min =+ string code *> return parser where+ parser = do+ h <- fixInt 2; _ <- char ':'+ m <- fixInt 2+ return $!+ puts _hour h *>+ puts _min m++-- | Match a hour-minute-second percent code and update+-- the fields with the values returned by the parser.+matchHMS+ :: Text+ -> (TZ :-> Hour )+ -> (TZ :-> Minute)+ -> (TZ :-> Double)+ -> Parser (Parser (State TZ ()))+matchHMS code _hour _min _sec =+ string code *> return parser where+ parser = do+ h <- fixInt 2; _ <- char ':'+ m <- fixInt 2; _ <- char ':'+ s <- second+ return $!+ puts _hour h *>+ puts _min m *>+ puts _sec s++-- | Match a hour-minute-second-period percent code and+-- update the fields with the values returned by the parser.+matchT12+ :: Text+ -> (TZ :-> Hour )+ -> (TZ :-> Minute)+ -> (TZ :-> Double)+ -> TimeLocale+ -> Parser (Parser (State TZ ()))+matchT12 code _hour _min _sec locale =+ string code *> return parser where+ parser = do+ h <- fixInt 2; _ <- char ':'+ m <- fixInt 2; _ <- char ':'+ s <- second ; _ <- char ' '+ f <- period locale id+ return $!+ puts _hour h *>+ puts _min m *>+ puts _sec s *>+ modify _hour f++-- | Match any other character sequence.+matchTxt :: Parser (Parser (State TZ ()))+matchTxt = takeWhile1 (/='%') >>= return . \ src -> do+ trg <- P.take $ T.length src+ if src == trg then return (return ())+ else fail "matchTxt: mismatch"++-- | Parse an integral type of exactly @n@ digits.+fixInt :: Integral a => Int -> Parser a+fixInt n = do+ s <- replicateM n digit+ return $! fromIntegral $ L.foldl' step 0 s+ where step a c = a * 10 + fromEnum c - 48++-- | Parse an integral type of two digits+-- or one digit preceded by a space.+padIntTwo :: Integral a => Parser a+padIntTwo = do+ let f a b = a * 10 + b+ liftM2 f getDigit getDigit+ <|> do char ' ' >> getDigit+ where getDigit = do+ d <- digit+ return $! fromIntegral $ fromEnum d - 48++-- | Parse a year in two digit format.+yearTwo :: Parser Year+yearTwo = f <$> fixInt 2+ where f y = if y <= 69 then 2000 + y else 1900 + y++-- | Parse a month in two digit format.+monthInt :: Parser Month+monthInt = do+ m <- fixInt 2+ if 1 <= m && m <= 12+ then return $! toEnum (m-1)+ else fail $ "monthInt: out of bounds"++-- | Parse a month in short text format.+monthShort :: TimeLocale -> Parser Month+monthShort = fromList . flip L.zip monthList . L.map (pack . snd) . months++-- | Parse a month in long text format.+monthLong :: TimeLocale -> Parser Month+monthLong = fromList . flip L.zip monthList . L.map (pack . fst) . months++-- | Parse a day of week in short text format.+weekShort :: TimeLocale -> Parser DayOfWeek+weekShort = fromList . flip L.zip weekList . L.map (pack . snd) . wDays++-- | Parse a day of week in long text format. +weekLong :: TimeLocale -> Parser DayOfWeek+weekLong = fromList . flip L.zip weekList . L.map (pack . fst) . wDays++-- | Parse a second in two digit format.+second :: Parser Double+second = (realToFrac :: Int -> Double) <$> fixInt 2++-- | Parse a decimal in zero to twelve digit format.+fraction :: Parser (Double -> Double)+fraction = do+ (,) n l <- foldM step (0,0) [1..12]+ return $! (+ realToFrac n * 10 ** (- realToFrac l))+ where step :: (Int, Int) -> Int -> Parser (Int, Int)+ step acc@(n,_) l = option acc . try $ do+ c <- digit+ let n' = n * 10 + fromEnum c - 48+ return $! (n', l)++-- | Parse period symbols.+period :: TimeLocale -> (Text -> Text) -> Parser (Hour -> Hour)+period TimeLocale{amPm = (am, pm)} casify = fromList+ [(toText am, \ case 12 -> 00; x -> x )+ ,(toText pm, \ case 12 -> 12; x -> x + 12)]+ where toText = casify . pack++-- | Parse a time zone.+timezone :: City -> Parser TimeZone+timezone city = do+ t <- takeWhile1 isAlpha+ case safeConvert . TimeZoneAbbr city $ unpack t of+ Left err -> fail $ prettyConvertError err+ Right zone -> return $! zone++-- | Create a parser from a list of key-value pairs.+fromList :: [(Text, a)] -> Parser a+fromList = L.foldl1 (<|>) . L.map (uncurry (*>) . (string *** return))++-- | List of days of the week.+weekList :: [DayOfWeek]+weekList = [Sunday, Monday, Tuesday, Wednesday, Thursday, Friday, Saturday]++-- | List of months of the year.+monthList :: [Month]+monthList = [January, February, March, April, May, June, July, August, September, October, November, December]
src/Data/Time/Exts/Test.hs view
@@ -9,6 +9,7 @@ module Main where +import Control.Monad import Data.Convertible import Data.Time.Calendar as Calendar import Data.Time.Clock@@ -59,19 +60,19 @@ arbitrary = choose (minBound, maxBound) instance Arbitrary LocalDateTime where- arbitrary = choose (minBound, maxBound)+ arbitrary = choose (minBound `plus` Second 43200, maxBound) instance Arbitrary LocalDateTimeMillis where- arbitrary = choose (minBound, maxBound)+ arbitrary = choose (minBound `plus` Second 43200, maxBound) instance Arbitrary LocalDateTimeMicros where- arbitrary = choose (minBound, maxBound)+ arbitrary = choose (minBound `plus` Second 43200, maxBound) instance Arbitrary LocalDateTimeNanos where- arbitrary = choose (minBound, maxBound)+ arbitrary = choose (minBound `plus` Second 43200, maxBound) instance Arbitrary LocalDateTimePicos where- arbitrary = choose (minBound, maxBound)+ arbitrary = choose (minBound `plus` Second 43200, maxBound) -- | Test Unix date and time component equality. test1 :: (Bounded x, DateTime x, Duration x Second, Show x, Unix x) => x -> Bool@@ -143,7 +144,7 @@ -- | Test properties. main :: IO ()-main = do+main = replicateM_ 100 $ do quickCheck (test1 :: UnixDateTime -> Bool) quickCheck (test1 :: UnixDateTimeMillis -> Bool) quickCheck (test1 :: UnixDateTimeMicros -> Bool)
src/Data/Time/Exts/Zone.hs view
@@ -4,6 +4,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} {-# OPTIONS -Wall #-}@@ -34,12 +35,13 @@ ) where -import Control.Arrow (first)-import Data.Aeson (FromJSON, ToJSON)-import Data.Map.Strict (Map, (!), fromDistinctAscList)-import Data.Typeable (Typeable)-import GHC.Generics (Generic)-import System.Random (Random(..))+import Control.Arrow (first)+import Data.Aeson (FromJSON, ToJSON)+import Data.Convertible (convError, convert, Convertible(..))+import Data.Map.Strict (Map, (!), fromDistinctAscList)+import Data.Typeable (Typeable)+import GHC.Generics (Generic)+import System.Random (Random(..)) -- | Cities from around the world. data City =@@ -360,6 +362,73 @@ , abbr_str :: String -- ^ time zone abbreviation string } deriving (Eq,Generic,Typeable) +instance Convertible TimeZoneAbbr TimeZone where+ safeConvert abbr@TimeZoneAbbr{..} = + case abbr_str of+ "AFT" -> Right Afghanistan_Time+ "AHDT" -> Right Alaska_Hawaii_Daylight_Time+ "AHST" -> Right Alaska_Hawaii_Standard_Time+ "AKDT" -> Right Alaska_Daylight_Time+ "AKST" -> Right Alaska_Standard_Time+ "ADT" -> Right Arabia_Daylight_Time+ "AST" -> Right Arabia_Standard_Time+ "BRST" -> Right Brasilia_Summer_Time+ "BRT" -> Right Brasilia_Time+ "BST" -> Right British_Summer_Time+ "CAT" -> Right Central_Africa_Time+ "CDT" -> case abbr_city of+ Chicago -> Right Central_Daylight_Time+ Shanghai -> Right China_Daylight_Time+ _ -> collision+ "CEST" -> Right Central_European_Summer_Time+ "CET" -> Right Central_European_Time+ "CST" -> case abbr_city of+ Chicago -> Right Central_Standard_Time+ Shanghai -> Right China_Standard_Time+ _ -> collision+ "EAT" -> Right East_Africa_Time+ "EDT" -> Right Eastern_Daylight_Time+ "EEST" -> Right Eastern_European_Summer_Time+ "EET" -> Right Eastern_European_Time+ "EST" -> Right Eastern_Standard_Time+ "FET" -> Right Further_Eastern_European_Time+ "GMT" -> Right Greenwich_Mean_Time+ "GST" -> Right Gulf_Standard_Time+ "HST" -> Right Hawaii_Aleutian_Standard_Time+ "HKST" -> Right Hong_Kong_Summer_Time+ "HKT" -> Right Hong_Kong_Time+ "IDT" -> Right Israel_Daylight_Time+ "IRDT" -> Right Iran_Daylight_Time+ "IRST" -> Right Iran_Standard_Time+ "IST" -> case abbr_city of+ Kolkata -> Right India_Standard_Time+ Tel_Aviv -> Right Israel_Standard_Time+ _ -> collision+ "JST" -> Right Japan_Standard_Time+ "KART" -> Right Karachi_Time+ "KDT" -> Right Korea_Daylight_Time+ "KST" -> Right Korea_Standard_Time+ "MDT" -> Right Mountain_Daylight_Time+ "MSD" -> Right Moscow_Daylight_Time+ "MSK" -> Right Moscow_Standard_Time+ "MST" -> Right Mountain_Standard_Time+ "NZDT" -> Right New_Zealand_Daylight_Time+ "NZST" -> Right New_Zealand_Standard_Time+ "PDT" -> Right Pacific_Daylight_Time+ "PKST" -> Right Pakistan_Summer_Time+ "PKT" -> Right Pakistan_Standard_Time+ "PST" -> Right Pacific_Standard_Time+ "SAST" -> Right South_Africa_Standard_Time+ "SGT" -> Right Singapore_Time+ "UTC" -> Right Coordinated_Universal_Time+ "WAT" -> Right West_Africa_Time+ "YST" -> Right Yukon_Standard_Time+ _ -> convError "undefined time zone abbreviation string" abbr+ where collision = convError "reference location collision" abbr++instance Convertible TimeZone TimeZoneAbbr where+ safeConvert = Right . (!) abbreviations+ instance FromJSON TimeZoneAbbr instance Show TimeZoneAbbr where@@ -369,72 +438,11 @@ -- | Abbreviate a time zone. abbreviate :: TimeZone -> TimeZoneAbbr-abbreviate = (!) abbreviations+abbreviate = convert -- | Unabbreviate a time zone. unabbreviate :: TimeZoneAbbr -> TimeZone-unabbreviate TimeZoneAbbr{..} =- case abbr_str of- "AFT" -> Afghanistan_Time- "AHDT" -> Alaska_Hawaii_Daylight_Time- "AHST" -> Alaska_Hawaii_Standard_Time- "AKDT" -> Alaska_Daylight_Time- "AKST" -> Alaska_Standard_Time- "ADT" -> Arabia_Daylight_Time- "AST" -> Arabia_Standard_Time- "BRST" -> Brasilia_Summer_Time- "BRT" -> Brasilia_Time- "BST" -> British_Summer_Time- "CAT" -> Central_Africa_Time- "CDT" -> case abbr_city of- Chicago -> Central_Daylight_Time- Shanghai -> China_Daylight_Time- _ -> missing abbr_city- "CEST" -> Central_European_Summer_Time- "CET" -> Central_European_Time- "CST" -> case abbr_city of- Chicago -> Central_Standard_Time- Shanghai -> China_Standard_Time- _ -> missing abbr_city- "EAT" -> East_Africa_Time- "EDT" -> Eastern_Daylight_Time- "EEST" -> Eastern_European_Summer_Time- "EET" -> Eastern_European_Time- "EST" -> Eastern_Standard_Time- "FET" -> Further_Eastern_European_Time- "GMT" -> Greenwich_Mean_Time- "GST" -> Gulf_Standard_Time- "HST" -> Hawaii_Aleutian_Standard_Time- "HKST" -> Hong_Kong_Summer_Time- "HKT" -> Hong_Kong_Time- "IDT" -> Israel_Daylight_Time- "IRDT" -> Iran_Daylight_Time- "IRST" -> Iran_Standard_Time- "IST" -> case abbr_city of- Kolkata -> India_Standard_Time- Tel_Aviv -> Israel_Standard_Time- _ -> missing abbr_city- "JST" -> Japan_Standard_Time- "KART" -> Karachi_Time- "KDT" -> Korea_Daylight_Time- "KST" -> Korea_Standard_Time- "MDT" -> Mountain_Daylight_Time- "MSD" -> Moscow_Daylight_Time- "MSK" -> Moscow_Standard_Time- "MST" -> Mountain_Standard_Time- "NZDT" -> New_Zealand_Daylight_Time- "NZST" -> New_Zealand_Standard_Time- "PDT" -> Pacific_Daylight_Time- "PKST" -> Pakistan_Summer_Time- "PKT" -> Pakistan_Standard_Time- "PST" -> Pacific_Standard_Time- "SAST" -> South_Africa_Standard_Time- "SGT" -> Singapore_Time- "UTC" -> Coordinated_Universal_Time- "WAT" -> West_Africa_Time- "YST" -> Yukon_Standard_Time- _ -> error $ "safeConvert: missing time zone abbreviation `" ++ abbr_str ++ "'"- where missing city = error $ "safeConvert: missing reference location `" ++ show city ++ "'"+unabbreviate = convert -- | A map from time zones to time zone abbreviations. abbreviations :: Map TimeZone TimeZoneAbbr
time-exts.cabal view
@@ -1,18 +1,18 @@ Name: time-exts-Version: 2.0.0+Version: 2.1.0 License: BSD3 License-File: LICENSE Copyright: Copyright (c) 2014, Enzo Haussecker. All rights reserved. Author: Enzo Haussecker <enzo@ucsd.edu> Maintainer: Enzo Haussecker <enzo@ucsd.edu>-Stability: Experimental+Stability: Stable Category: Time Synopsis: Efficient Timestamps Homepage: https://github.com/enzoh/time-exts Bug-Reports: https://github.com/enzoh/time-exts/issues Build-Type: Simple Cabal-Version: >= 1.16.0-Description: Extensions to the Haskell time library, providing efficient Unix, UTC, and local timestamps.+Description: Haskell timestamps in various bit length and granularity. Library Default-Language: Haskell2010@@ -21,17 +21,23 @@ Data.Time.Exts.Base Data.Time.Exts.C Data.Time.Exts.Local+ Data.Time.Exts.Parser Data.Time.Exts.Unix Data.Time.Exts.Zone Build-Depends: aeson,+ attoparsec, base >= 4 && < 5, bindings-DSL, containers, convertible,+ data-default, deepseq, fclabels,+ mtl,+ old-locale, QuickCheck, random,+ text, time, timezone-olson Build-Tools: hsc2hs@@ -42,14 +48,19 @@ Main-Is: Data/Time/Exts/Test.hs Other-Modules: Data.Time.Exts.C Build-Depends: aeson,+ attoparsec, base >= 4 && < 5, bindings-DSL, containers, convertible,+ data-default, deepseq, fclabels,+ mtl,+ old-locale, QuickCheck, random,+ text, time, timezone-olson Build-Tools: hsc2hs