git.iko.soy/typeable/aeson
on master help sign in
Speed up UTCTime encoding by 3x
commitc532301139f1b8f6341a6408b10304ba3f7c2c49 authorBryan O'Sullivan <bos@serpentine.com> dateMon 20 Jul 2015, 20:09 (11 years ago) parentb7ad8c1
2 files changed+65−6
compare with master
unifiedsplit
Data/Aeson/Encode/Builder.hs+57−1 Data/Aeson/Types/Instances.hs+8−5
Data/Aeson/Encode/Builder.hs+57−1
@@ -24,19 +24,24 @@ module Data.Aeson.Encode.Builder
2424 , string
2525 , unquoted
2626 , number
27+ , day
28+ , timeOfDay
2729 , ascii2
2830 , ascii4
2931 , ascii5
3032 ) where
3133
34+import Data.Aeson.Functions (fromPico)
3235import Data.Aeson.Types.Internal (Encoding(..), Value(..))
3336import Data.ByteString.Builder as B
3437import Data.ByteString.Builder.Prim as BP
3538import Data.ByteString.Builder.Scientific (scientificBuilder)
36−import Data.Char (ord)
39+import Data.Char (chr, ord)
3740import Data.Foldable (foldMap)
3841import Data.Monoid ((<>))
3942import Data.Scientific (Scientific, base10Exponent, coefficient)
43+import Data.Time.Calendar (Day(..), toGregorian)
44+import Data.Time.LocalTime (TimeOfDay(..))
4045import Data.Word (Word8)
4146import qualified Data.HashMap.Strict as HMS
4247import qualified Data.Text as T
@@ -147,3 +152,54 @@ ascii5 :: (Char, (Char, (Char, (Char, Char)))) -> BP.BoundedPrim a
147152ascii5 cs = BP.liftFixedToBounded $ (const cs) >$<
148153 BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7
149154{-# INLINE ascii5 #-}
155+
156+ascii6 :: (Char, (Char, (Char, (Char, (Char, Char))))) -> BP.BoundedPrim a
157+ascii6 cs = BP.liftFixedToBounded $ (const cs) >$<
158+ BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7
159+{-# INLINE ascii6 #-}
160+
161+ascii8 :: (Char, (Char, (Char, (Char, (Char, (Char, (Char, Char)))))))
162+ -> BP.BoundedPrim a
163+ascii8 cs = BP.liftFixedToBounded $ (const cs) >$<
164+ BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7 >*<
165+ BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7
166+{-# INLINE ascii8 #-}
167+
168+day :: Day -> Builder
169+day dd = B.integerDec y <>
170+ BP.primBounded (ascii6 ('-',(mh,(ml,('-',(dh,dl)))))) ()
171+ where (y,m,d) = toGregorian dd
172+ !(T mh ml) = twoDigits m
173+ !(T dh dl) = twoDigits d
174+{-# INLINE day #-}
175+
176+timeOfDay :: TimeOfDay -> Builder
177+timeOfDay (TimeOfDay h m s)
178+ | micro100 < 5 = hhmmss -- omit trailing milliseconds if zero
179+ | otherwise = hhmmss <> BP.primBounded (ascii4 ('.',(a,(b,c)))) ()
180+ where
181+ hhmmss = BP.primBounded (ascii8 (hh,(hl,(':',(mh,(ml,(':',(sh,sl)))))))) ()
182+ !(T hh hl) = twoDigits h
183+ !(T mh ml) = twoDigits m
184+ !(T sh sl) = twoDigits (fromIntegral real)
185+ picos = fromPico s
186+ (real,frac) = picos `quotRem` 1000000000000
187+ -- Units of 100 microseconds (tenths of a millisecond), which we
188+ -- round up so that milliseconds >= 0.5 render correctly.
189+ micro100
190+ | d `rem` 10 < 5 = d
191+ | otherwise = d + 10
192+ where d = fromIntegral (frac `quot` 100000000)
193+ !(T a b) = twoDigits ab
194+ (ab,cc) = micro100 `quotRem` 100
195+ !c = digit (cc `quot` 10)
196+{-# INLINE timeOfDay #-}
197+
198+data T = T {-# UNPACK #-} !Char {-# UNPACK #-} !Char
199+
200+twoDigits :: Int -> T
201+twoDigits a = T (digit hi) (digit lo)
202+ where (hi,lo) = a `quotRem` 10
203+
204+digit :: Int -> Char
205+digit x = chr (x + 48)
Data/Aeson/Types/Instances.hs+8−5
@@ -58,6 +58,7 @@ module Data.Aeson.Types.Instances
5858import Control.Applicative ((<$>), (<*>), pure)
5959import qualified Data.Aeson.Encode.Builder as E
6060import qualified Data.ByteString.Builder as B
61+import qualified Data.ByteString.Lazy as L
6162import Data.Aeson.Functions
6263import Data.Monoid ((<>), mempty)
6364import Data.Aeson.Encode.Functions (brackets, builder, foldable, list)
@@ -78,6 +79,7 @@ import Data.Ratio (Ratio, (%), numerator, denominator)
7879import Data.Text (Text, pack, unpack)
7980import Data.Time (UTCTime(..), ZonedTime(..), TimeZone(..))
8081import Data.Time.Format (FormatTime, formatTime, parseTime)
82+import Data.Time.LocalTime (timeToTimeOfDay)
8183import Data.Traversable as Tr (sequence, traverse)
8284import Data.Vector (Vector)
8385import Data.Word (Word, Word8, Word16, Word32, Word64)
@@ -92,6 +94,7 @@ import qualified Data.Set as Set
9294import qualified Data.Sequence as Seq
9395import qualified Data.Tree as Tree
9496import qualified Data.Text as T
97+import qualified Data.Text.Encoding as T
9598import qualified Data.Text.Lazy as LT
9699import qualified Data.Vector as V
97100import qualified Data.Vector.Generic as VG
@@ -731,13 +734,13 @@ instance FromJSON ZonedTime where
731734 parseJSON = withText "ZonedTime" (Time.run Time.zonedTime)
732735
733736instance ToJSON UTCTime where
734− toJSON = toJSON . utcTime
737+ toJSON = String . T.decodeLatin1 . L.toStrict . B.toLazyByteString . utcTime
735738
736− toEncoding = toEncoding . utcTime
739+ toEncoding t = Encoding (utcTime t)
737740
738−utcTime :: UTCTime -> String
739−utcTime t = formatTime defaultTimeLocale format t
740− where format = "%FT%T." ++ formatSubseconds t ++ "Z"
741+utcTime :: UTCTime -> B.Builder
742+utcTime (UTCTime day secs) =
743+ E.day day <> B.char7 'T' <> E.timeOfDay (timeToTimeOfDay secs) <> B.char7 'Z'
741744
742745instance FromJSON UTCTime where
743746 parseJSON = withText "UTCTime" (Time.run Time.utcTime)