From be5ca292125dedc72bfc7118f5062512b624fb74 Mon Sep 17 00:00:00 2001 From: Ondrej Palkovsky Date: Fri, 27 May 2016 20:31:53 +0200 Subject: [PATCH 1/5] Added fast parsing instance for Aeson + aeson tests using scanner. Fast encoding of UTCTime to JSON. --- src/Data/Thyme/Format/Aeson.hs | 17 +++-- src/Data/Thyme/Format/DateEncode.hs | 109 ++++++++++++++++++++++++++ src/Data/Thyme/Format/DateFast.hs | 114 ++++++++++++++++++++++++++++ tests/bench.hs | 23 +++++- tests/sanity.hs | 16 +++- thyme.cabal | 13 ++-- 6 files changed, 276 insertions(+), 16 deletions(-) create mode 100644 src/Data/Thyme/Format/DateEncode.hs create mode 100644 src/Data/Thyme/Format/DateFast.hs diff --git a/src/Data/Thyme/Format/Aeson.hs b/src/Data/Thyme/Format/Aeson.hs index 0d8345f..35cd579 100644 --- a/src/Data/Thyme/Format/Aeson.hs +++ b/src/Data/Thyme/Format/Aeson.hs @@ -23,8 +23,13 @@ import Data.Data import Data.Monoid #endif import Data.Text (pack, unpack) +import Data.Text.Encoding (decodeUtf8) import qualified Data.Text as T import Data.Thyme +import Data.Thyme.Format.DateFast (parseFastUtc) +import Data.Thyme.Format.DateEncode (utcTimeBuilder, quote) +import Data.ByteString.Builder (toLazyByteString) +import Data.ByteString.Lazy (toStrict) -- Copyright: (c) 2011, 2012, 2013 Bryan O'Sullivan -- (c) 2011 MailRank, Inc. @@ -94,15 +99,11 @@ instance FromJSON ZonedTime where parseJSON v = typeMismatch "ZonedTime" v instance ToJSON UTCTime where - toJSON t = String $ pack $ formatTime defaultTimeLocale format t - where - format = "%FT%T." ++ formatMillis t ++ "Z" + toEncoding t = unsafeToEncoding $ quote (utcTimeBuilder t) + {-# INLINE toEncoding #-} + toJSON t = String $ decodeUtf8 $ toStrict $ toLazyByteString (utcTimeBuilder t) {-# INLINE toJSON #-} instance FromJSON UTCTime where - parseJSON = withText "UTCTime" $ \t -> - case parseTime defaultTimeLocale "%FT%T%QZ" (unpack t) of - Just d -> pure d - _ -> fail "could not parse ISO-8601 date" + parseJSON = withText "UTCTime" $ parseFastUtc {-# INLINE parseJSON #-} - diff --git a/src/Data/Thyme/Format/DateEncode.hs b/src/Data/Thyme/Format/DateEncode.hs new file mode 100644 index 0000000..06e1458 --- /dev/null +++ b/src/Data/Thyme/Format/DateEncode.hs @@ -0,0 +1,109 @@ +{-# LANGUAGE BangPatterns, OverloadedStrings #-} +{-# OPTIONS_HADDOCK hide #-} + +-- | +-- Copied and adapted from aeson +-- Copyright: (c) 2011 MailRank, Inc. +-- (c) 2013 Simon Meier +-- License: BSD3 +-- Maintainer: Bryan O'Sullivan + +module Data.Thyme.Format.DateEncode + ( + utcTimeBuilder + , quote + ) where + +import Control.Lens (view) +import Data.ByteString.Builder as B +import Data.ByteString.Builder.Prim as BP +import Data.Char (chr) +import Data.Monoid ((<>)) +import Data.Thyme.Clock +import Data.Thyme.Calendar + +-- | Add quotes surrounding a builder +quote :: Builder -> Builder +quote b = B.char8 '"' <> b <> B.char8 '"' + +ascii4 :: (Char, (Char, (Char, Char))) -> BP.BoundedPrim a +ascii4 cs = BP.liftFixedToBounded $ (const cs) >$< + BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7 +{-# INLINE ascii4 #-} + +ascii6 :: (Char, (Char, (Char, (Char, (Char, Char))))) -> BP.BoundedPrim a +ascii6 cs = BP.liftFixedToBounded $ (const cs) >$< + BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7 +{-# INLINE ascii6 #-} + +ascii8 :: (Char, (Char, (Char, (Char, (Char, (Char, (Char, Char))))))) + -> BP.BoundedPrim a +ascii8 cs = BP.liftFixedToBounded $ (const cs) >$< + BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7 >*< + BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7 +{-# INLINE ascii8 #-} + +day :: Day -> Builder +day dd = encodeYear yr <> + BP.primBounded (ascii6 ('-',(mh,(ml,('-',(dh,dl)))))) () + where (yr,m,d) = toGregorian dd + !(T mh ml) = twoDigits m + !(T dh dl) = twoDigits d + encodeYear y + | y >= 1000 = B.intDec y + | y > 0 = + let (ab,c) = y `quotRem` 10 + (a,b) = ab `quotRem` 10 + in BP.primBounded (ascii4 ('0',(digit a,(digit b,digit c)))) () + | otherwise = + error "Data.Aeson.Encode.Builder.day: years BCE not supported" +{-# INLINE day #-} + +timeOfDay64 :: DiffTime -> Builder +timeOfDay64 nom + | frac == 0 = hhmmss -- omit subseconds if 0 + | otherwise = hhmmss <> BP.primBounded showFrac frac + where + micros = toMicroseconds nom + (h, m') = micros `quotRem` (3600 * micro) + (m, s) = m' `quotRem` (60 * micro) + + hhmmss = BP.primBounded (ascii8 (hh,(hl,(':',(mh,(ml,(':',(sh,sl)))))))) () + !(T hh hl) = twoDigits (fromIntegral h) + !(T mh ml) = twoDigits (fromIntegral m) + !(T sh sl) = twoDigits (fromIntegral real) + (real,frac) = s `quotRem` micro + showFrac = (\x -> ('.', x)) >$< (BP.liftFixedToBounded BP.char7 >*< trunc6) + trunc6 = ((`quotRem` milli) . fromIntegral) >$< + BP.condB (\(_,y) -> y == 0) (fst >$< trunc3) (digits3 >*< trunc3) + digits3 = (`quotRem` 10) >$< (digits2 >*< digits1) + digits2 = (`quotRem` 10) >$< (digits1 >*< digits1) + digits1 = BP.liftFixedToBounded (digit >$< BP.char7) + trunc3 = BP.condB (== 0) BP.emptyB $ + (`quotRem` 100) >$< (digits1 >*< trunc2) + trunc2 = BP.condB (== 0) BP.emptyB $ + (`quotRem` 10) >$< (digits1 >*< trunc1) + trunc1 = BP.condB (== 0) BP.emptyB digits1 + + micro = 1000000 -- number of microseconds in 1 second + milli = 1000 -- number of milliseconds in 1 second +{-# INLINE timeOfDay64 #-} + +dayTime :: Day -> DiffTime -> Builder +dayTime d t = day d <> B.char7 'T' <> timeOfDay64 t +{-# INLINE dayTime #-} + +utcTimeBuilder :: UTCTime -> B.Builder +utcTimeBuilder utc = dayTime d s <> B.char7 'Z' + where + UTCView d s = view utcTime utc +{-# INLINE utcTimeBuilder #-} + +data T = T {-# UNPACK #-} !Char {-# UNPACK #-} !Char + +twoDigits :: Int -> T +twoDigits a = T (digit hi) (digit lo) + where (hi,lo) = a `quotRem` 10 + +digit :: Int -> Char +digit x = chr (x + 48) diff --git a/src/Data/Thyme/Format/DateFast.hs b/src/Data/Thyme/Format/DateFast.hs new file mode 100644 index 0000000..18d94e4 --- /dev/null +++ b/src/Data/Thyme/Format/DateFast.hs @@ -0,0 +1,114 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_HADDOCK hide #-} + +module Data.Thyme.Format.DateFast ( + parseFastUtc +) where + +import Control.Lens (from, view) +import Control.Monad (unless, void) +import qualified Data.ByteString as BS +import Data.Int (Int64) +import Data.List (foldl1') +import qualified Data.Text as T +import Data.Text.Encoding (encodeUtf8) +import Data.Thyme.Calendar (fromGregorian) +import Data.Thyme.Clock +import Data.Word (Word8) +import Scanner (Scanner) +import qualified Scanner as S + +satisfy :: (Word8 -> Bool) -> Scanner Word8 +satisfy f = do + c <- S.anyWord8 + unless (f c) $ fail $ "Unexpected " ++ show c + return c +{-# INLINE satisfy #-} + +satisfyChar :: (Char -> Bool) -> Scanner Char +satisfyChar f = do + c <- S.anyChar8 + unless (f c) $ fail $ "Unexpected " ++ show c + return c +{-# INLINE satisfyChar #-} + +digit :: Scanner Int +digit = do + c <- satisfy (\c -> c >= 48 && c <= 57) + return $ fromIntegral c - 48 +{-# INLINE digit #-} + +many1digit :: Scanner [Int] +many1digit = do + start <- digit + rest <- S.takeWhile (\c -> c >=48 && c <= 57) + let nums = map (fromIntegral . subtract 48) $ BS.unpack rest + return (start : nums) +{-# INLINE many1digit #-} + +-- | Parse integer number read up to maxdigits; stop if different character is found +parseNumber2 :: Scanner Int +parseNumber2 = do -- Specialized version for 2 digits + c1 <- digit + c2 <- digit + return (10 * c1 + c2) +{-# INLINE parseNumber2 #-} + +parseNumber4 :: Scanner Int +parseNumber4 = do -- Specialized version for 2 digits + c1 <- digit + c2 <- digit + c3 <- digit + c4 <- digit + return (1000 * c1 + 100 * c2 + 10 * c3 + c4) +{-# INLINE parseNumber4 #-} + +toffset :: Scanner Int64 +toffset = do + hours <- parseNumber2 + S.char8 ':' + minutes <- parseNumber2 + return $ fromIntegral $ hours * 3600 + minutes * 60 +{-# INLINE toffset #-} + + +parserRfc :: Scanner UTCTime +parserRfc = do + year <- parseNumber4 + S.char8 '-' + month <- parseNumber2 + S.char8 '-' + dayofmonth <- parseNumber2 + S.char8 'T' + hour <- fromIntegral <$> parseNumber2 + S.char8 ':' + minute <- fromIntegral <$> parseNumber2 + S.char8 ':' + seconds <- fromIntegral <$> parseNumber2 + dot <- S.lookAheadChar8 + micros <- case dot of + Just '.' -> do + void S.anyChar8 + numlst <- take 6 <$> many1digit + let num = foldl1' (\a b -> 10 * a + b) numlst + return $ fromIntegral $ num * (10 ^ (6 - length numlst)) + Just _ -> return 0 + Nothing -> fail "Not enough input" + zone <- satisfyChar (\c -> c == '+' || c == '-' || c == 'Z') + offset <- case zone of + 'Z' -> return 0 + '+' -> toffset + '-' -> negate <$> toffset + _ -> fail "Expected Z/+/- while parsing date." + let totalMicro = micros + 1000000 * seconds + 1000000 * 60 * minute + 1000000 * 3600 * hour + - offset * 1000000 :: Int64 + tdiff = view (from microseconds) totalMicro + tday = fromGregorian year month dayofmonth + return $ UTCTime tday tdiff + +parseFastUtc :: Monad m => T.Text -> m UTCTime +parseFastUtc t = + case S.scanOnly parserRfc (encodeUtf8 t) of + Right d -> pure d + Left err -> fail $ "could not parse ISO-8601 date: " ++ err diff --git a/tests/bench.hs b/tests/bench.hs index 377b6b5..bd27e3d 100644 --- a/tests/bench.hs +++ b/tests/bench.hs @@ -1,2 +1,23 @@ +module Main where + +import Criterion.Main + +import Data.Thyme.Clock as TH +import Data.Thyme.Format.Aeson () +import Data.Time.Clock as TI +import qualified Data.Aeson as AE +import qualified Data.ByteString.Lazy as BL + main :: IO () -main = return () +main = do + tinow <- TI.getCurrentTime + thnow <- TH.getCurrentTime + + let encoded = AE.encode thnow + + defaultMain [ + bgroup "time encode" [ bench "time/encode" $ nf AE.encode tinow + , bench "thyme/encode" $ nf AE.encode thnow ] + , bgroup "time decode" [ bench "time/decode" $ nf (AE.decode :: BL.ByteString -> Maybe TI.UTCTime) encoded + , bench "thyme/decode" $ nf (AE.decode :: BL.ByteString -> Maybe TH.UTCTime) encoded ] + ] diff --git a/tests/sanity.hs b/tests/sanity.hs index 466860e..d3f0666 100644 --- a/tests/sanity.hs +++ b/tests/sanity.hs @@ -17,6 +17,8 @@ import Data.Thyme.Time import qualified Data.Time as T import qualified Data.Time.Calendar.OrdinalDate as T import Test.QuickCheck +import qualified Data.Aeson as AE +import Data.Thyme.Format.Aeson () import Common @@ -49,6 +51,17 @@ prop_toOrdinalDate :: Day -> Bool prop_toOrdinalDate day = fromIntegral `first` toOrdinalDate day == T.toOrdinalDate (thyme # day) +newtype AcUTCTime = AcUTCTime { getAc :: UTCTime } deriving (Show) +instance Arbitrary AcUTCTime where + arbitrary = AcUTCTime <$> (arbitrary `suchThat` (\d -> d >= year1 && d < yearMax)) + where + year1 = UTCTime (fromGregorian 1 1 1) 0 + yearMax = UTCTime (fromGregorian 10000 1 1) 0 + shrink (AcUTCTime a) = map AcUTCTime (shrink a) + +prop_aeson :: AcUTCTime -> Bool +prop_aeson a = AE.decode (AE.encode (getAc a)) == Just (getAc a) + prop_formatTime :: Spec -> RecentTime -> Property prop_formatTime (Spec spec) (RecentTime t@(review thyme -> t')) #if MIN_VERSION_QuickCheck(2,7,0) @@ -90,9 +103,8 @@ main = exit . all isSuccess =<< sequence , qc 10000 prop_toOrdinalDate , qc 1000 prop_formatTime , qc 1000 prop_parseTime - + , qc 1000 prop_aeson ] where isSuccess r = case r of Success {} -> True; _ -> False qc :: Testable prop => Int -> prop -> IO Result qc n = quickCheckWithResult stdArgs {maxSuccess = n, maxSize = n} - diff --git a/thyme.cabal b/thyme.cabal index d1c1d57..6c62c7c 100644 --- a/thyme.cabal +++ b/thyme.cabal @@ -81,7 +81,8 @@ library Data.Thyme.Calendar.Internal Data.Thyme.Clock.Internal Data.Thyme.Format.Internal - Data.Thyme.TrueName + Data.Thyme.Format.DateFast + Data.Thyme.Format.DateEncode if !(flag(lens) || flag(docs)) other-modules: Control.Lens build-depends: @@ -101,8 +102,8 @@ library time >= 1.4, vector >= 0.9, vector-th-unbox >= 0.2.1.0, - vector-space >= 0.8 - + vector-space >= 0.8, + scanner if os(windows) build-depends: Win32 if os(darwin) || os(freebsd) @@ -139,6 +140,7 @@ test-suite sanity text, thyme, time, + aeson, vector-space if flag(lens) build-depends: lens @@ -189,7 +191,9 @@ benchmark bench thyme, time, vector, - vector-space + vector-space, + aeson, + bytestring if flag(lens) build-depends: lens else @@ -197,4 +201,3 @@ benchmark bench ghc-options: -Wall -- vim: et sw=4 ts=4 sts=4: - From 49948de6e12ea594286d394180f5d16d1866347c Mon Sep 17 00:00:00 2001 From: Ondrej Palkovsky Date: Fri, 27 May 2016 23:22:23 +0200 Subject: [PATCH 2/5] Compatibility tweaks for older GHC versions. --- src/Data/Thyme/Calendar/WeekDate.hs | 3 +-- src/Data/Thyme/Clock/TAI.hs | 5 +++-- src/Data/Thyme/Format.hs | 4 +++- src/Data/Thyme/Format/Aeson.hs | 3 +++ src/Data/Thyme/Format/DateFast.hs | 8 ++++++-- tests/sanity.hs | 21 ++++++++++++++++----- thyme.cabal | 1 + 7 files changed, 33 insertions(+), 12 deletions(-) diff --git a/src/Data/Thyme/Calendar/WeekDate.hs b/src/Data/Thyme/Calendar/WeekDate.hs index fcc8ea1..cbad7e5 100644 --- a/src/Data/Thyme/Calendar/WeekDate.hs +++ b/src/Data/Thyme/Calendar/WeekDate.hs @@ -3,7 +3,7 @@ {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -fno-warn-orphans #-} #if __GLASGOW_HASKELL__ == 706 -{-# OPTIONS_GHC -fsimpl-tick-factor=120 #-} -- 7.6.3 only, it seems; fixes #29 +{-# OPTIONS_GHC -fsimpl-tick-factor=180 #-} -- 7.6.3 only, it seems; fixes #29 #endif #include "thyme.h" @@ -120,4 +120,3 @@ fromWeekDate y w d = weekDate # WeekDate y w d {-# INLINE fromWeekDateValid #-} fromWeekDateValid :: Year -> WeekOfYear -> DayOfWeek -> Maybe Day fromWeekDateValid y w d = weekDateValid (WeekDate y w d) - diff --git a/src/Data/Thyme/Clock/TAI.hs b/src/Data/Thyme/Clock/TAI.hs index 23c034c..337cd53 100644 --- a/src/Data/Thyme/Clock/TAI.hs +++ b/src/Data/Thyme/Clock/TAI.hs @@ -40,7 +40,9 @@ module Data.Thyme.Clock.TAI import Prelude #if !MIN_VERSION_base(4,8,0) import Control.Applicative +import Data.Monoid (mempty) #endif + import Control.DeepSeq import Control.Lens import Control.Monad @@ -353,5 +355,4 @@ utcToTAITime m = view (absoluteTime m) -- @ {-# INLINE taiToUTCTime #-} taiToUTCTime :: TAIUTCMap -> AbsoluteTime -> UTCTime -taiToUTCTime m = review (absoluteTime m) - +taiToUTCTime m = review (absoluteTime m) \ No newline at end of file diff --git a/src/Data/Thyme/Format.hs b/src/Data/Thyme/Format.hs index 5c9e43d..ede1161 100644 --- a/src/Data/Thyme/Format.hs +++ b/src/Data/Thyme/Format.hs @@ -31,6 +31,9 @@ import Control.Applicative #if SHOW_INTERNAL import Control.Arrow #endif +#if !MIN_VERSION_base(4,8,0) +import Data.Monoid (mempty) +#endif import Control.Lens import Control.Monad.Trans import Control.Monad.State.Strict @@ -986,4 +989,3 @@ timeZoneParser = zone "TAI" 0 False <|> zone "UT1" 0 False zone name offset dst = TimeZone offset dst name <$ P.string (S.pack name) ($+) h m = h * 60 + m ($-) h m = negate (h * 60 + m) - diff --git a/src/Data/Thyme/Format/Aeson.hs b/src/Data/Thyme/Format/Aeson.hs index 35cd579..dd1e200 100644 --- a/src/Data/Thyme/Format/Aeson.hs +++ b/src/Data/Thyme/Format/Aeson.hs @@ -99,11 +99,14 @@ instance FromJSON ZonedTime where parseJSON v = typeMismatch "ZonedTime" v instance ToJSON UTCTime where +#if MIN_VERSION_aeson(0,11,2) toEncoding t = unsafeToEncoding $ quote (utcTimeBuilder t) {-# INLINE toEncoding #-} +#endif toJSON t = String $ decodeUtf8 $ toStrict $ toLazyByteString (utcTimeBuilder t) {-# INLINE toJSON #-} +-- For some unexaplainable reason the fast Scanner parser doesn't seem to work on 7.6 instance FromJSON UTCTime where parseJSON = withText "UTCTime" $ parseFastUtc {-# INLINE parseJSON #-} diff --git a/src/Data/Thyme/Format/DateFast.hs b/src/Data/Thyme/Format/DateFast.hs index 18d94e4..72d0dbe 100644 --- a/src/Data/Thyme/Format/DateFast.hs +++ b/src/Data/Thyme/Format/DateFast.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK hide #-} @@ -6,6 +7,9 @@ module Data.Thyme.Format.DateFast ( parseFastUtc ) where +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +#endif import Control.Lens (from, view) import Control.Monad (unless, void) import qualified Data.ByteString as BS @@ -105,10 +109,10 @@ parserRfc = do - offset * 1000000 :: Int64 tdiff = view (from microseconds) totalMicro tday = fromGregorian year month dayofmonth - return $ UTCTime tday tdiff + return $ view (from utcTime) (UTCView tday tdiff) parseFastUtc :: Monad m => T.Text -> m UTCTime parseFastUtc t = case S.scanOnly parserRfc (encodeUtf8 t) of - Right d -> pure d + Right d -> return d Left err -> fail $ "could not parse ISO-8601 date: " ++ err diff --git a/tests/sanity.hs b/tests/sanity.hs index d3f0666..cd6079c 100644 --- a/tests/sanity.hs +++ b/tests/sanity.hs @@ -7,6 +7,9 @@ import Prelude +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +#endif import Control.Arrow import Control.Lens import qualified Data.Attoparsec.ByteString.Char8 as P @@ -51,16 +54,24 @@ prop_toOrdinalDate :: Day -> Bool prop_toOrdinalDate day = fromIntegral `first` toOrdinalDate day == T.toOrdinalDate (thyme # day) -newtype AcUTCTime = AcUTCTime { getAc :: UTCTime } deriving (Show) +newtype AcUTCTime = AcUTCTime UTCTime deriving (Show) instance Arbitrary AcUTCTime where arbitrary = AcUTCTime <$> (arbitrary `suchThat` (\d -> d >= year1 && d < yearMax)) where - year1 = UTCTime (fromGregorian 1 1 1) 0 - yearMax = UTCTime (fromGregorian 10000 1 1) 0 + year1 = view (from utcTime) $ UTCView (fromGregorian 1 1 1) 0 + yearMax = view (from utcTime) $ UTCView (fromGregorian 10000 1 1) 0 shrink (AcUTCTime a) = map AcUTCTime (shrink a) -prop_aeson :: AcUTCTime -> Bool -prop_aeson a = AE.decode (AE.encode (getAc a)) == Just (getAc a) +prop_aeson :: AcUTCTime -> Property +prop_aeson (AcUTCTime t') = +#if MIN_VERSION_QuickCheck(2,7,0) + counterexample desc (t == Just [t']) +#else + printTestCase desc (t == Just [t']) +#endif + where + t = AE.decode (AE.encode [t']) + desc = "Orig: " ++ show t' ++ ", Aeson: " ++ show (AE.encode t') ++ ", BackOrig: " ++ show t prop_formatTime :: Spec -> RecentTime -> Property prop_formatTime (Spec spec) (RecentTime t@(review thyme -> t')) diff --git a/thyme.cabal b/thyme.cabal index 6c62c7c..7ff581c 100644 --- a/thyme.cabal +++ b/thyme.cabal @@ -91,6 +91,7 @@ library aeson >= 0.6, base >= 4.5 && < 5, bytestring >= 0.9, + bytestring-builder, containers >= 0.5, deepseq >= 1.2, hashable >= 1.2, From 030f51e04a2285ae81a5e047228fa329c8570cae Mon Sep 17 00:00:00 2001 From: Ondrej Palkovsky Date: Tue, 14 Mar 2017 16:13:27 +0100 Subject: [PATCH 3/5] ':' is optional in parsing ISO format (not strictly ISO though) --- src/Data/Thyme/Format/DateFast.hs | 6 ++++-- thyme.cabal | 1 + 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/src/Data/Thyme/Format/DateFast.hs b/src/Data/Thyme/Format/DateFast.hs index 72d0dbe..ee3c4ce 100644 --- a/src/Data/Thyme/Format/DateFast.hs +++ b/src/Data/Thyme/Format/DateFast.hs @@ -11,7 +11,7 @@ module Data.Thyme.Format.DateFast ( import Control.Applicative #endif import Control.Lens (from, view) -import Control.Monad (unless, void) +import Control.Monad (unless, when, void) import qualified Data.ByteString as BS import Data.Int (Int64) import Data.List (foldl1') @@ -71,7 +71,9 @@ parseNumber4 = do -- Specialized version for 2 digits toffset :: Scanner Int64 toffset = do hours <- parseNumber2 - S.char8 ':' + -- optional ':' + colon <- S.lookAheadChar8 + when (colon == Just ':') (S.char8 ':') minutes <- parseNumber2 return $ fromIntegral $ hours * 3600 + minutes * 60 {-# INLINE toffset #-} diff --git a/thyme.cabal b/thyme.cabal index 7ff581c..1b83920 100644 --- a/thyme.cabal +++ b/thyme.cabal @@ -105,6 +105,7 @@ library vector-th-unbox >= 0.2.1.0, vector-space >= 0.8, scanner + build-tools: hsc2hs if os(windows) build-depends: Win32 if os(darwin) || os(freebsd) From 4377eb1a1ad5812315de5f4065d17d0bf7f1e1d3 Mon Sep 17 00:00:00 2001 From: Ondrej Palkovsky Date: Sat, 30 May 2020 22:19:57 +0200 Subject: [PATCH 4/5] Uprava na novy haskell. --- src/Data/Thyme/Format/DateFast.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Thyme/Format/DateFast.hs b/src/Data/Thyme/Format/DateFast.hs index ee3c4ce..ddeeb2d 100644 --- a/src/Data/Thyme/Format/DateFast.hs +++ b/src/Data/Thyme/Format/DateFast.hs @@ -113,7 +113,7 @@ parserRfc = do tday = fromGregorian year month dayofmonth return $ view (from utcTime) (UTCView tday tdiff) -parseFastUtc :: Monad m => T.Text -> m UTCTime +parseFastUtc :: MonadFail m => T.Text -> m UTCTime parseFastUtc t = case S.scanOnly parserRfc (encodeUtf8 t) of Right d -> return d From 2896f20b4941423bf738e62c140750f4dbdc51d9 Mon Sep 17 00:00:00 2001 From: Tim McGilchrist Date: Sat, 11 Mar 2023 12:07:52 +1100 Subject: [PATCH 5/5] Add TrueName module. --- thyme.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/thyme.cabal b/thyme.cabal index 1b83920..63e933e 100644 --- a/thyme.cabal +++ b/thyme.cabal @@ -83,6 +83,7 @@ library Data.Thyme.Format.Internal Data.Thyme.Format.DateFast Data.Thyme.Format.DateEncode + Data.Thyme.TrueName if !(flag(lens) || flag(docs)) other-modules: Control.Lens build-depends: