@@ -1,4 +1,4 @@
1−{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}
1+{-# LANGUAGE BangPatterns, ScopedTypeVariables, CPP #-}
22
33-- |
44-- Module: Data.Aeson.Parser.Time
@@ -20,7 +20,7 @@ module Data.Aeson.Parser.Time
2020 , zonedTime
2121 ) where
2222
23−import Control.Applicative ((<$>), (<|>), empty)
23+import Control.Applicative ((<$>), (<*>), (<*), (*>))
2424import Control.Monad (when, void)
2525import Data.Attoparsec.Text as A
2626import Data.Bits ((.&.))
@@ -34,6 +34,17 @@ import Data.Time.Clock (UTCTime(..))
3434import qualified Data.Aeson.Types.Internal as Aeson
3535import qualified Data.Text as T
3636import qualified Data.Time.LocalTime as Local
37+#if !MIN_VERSION_base(4,7,0)
38+import Unsafe.Coerce
39+
40+mkPico :: Integer -> Pico
41+mkPico = unsafeCoerce
42+#else
43+import Data.Fixed (Fixed(MkFixed))
44+
45+mkPico :: Integer -> Pico
46+mkPico = MkFixed
47+#endif
3748
3849-- | Run an attoparsec parser as an aeson parser.
3950run :: Parser a -> Text -> Aeson.Parser a
@@ -75,10 +86,19 @@ seconds = do
7586 mc <- peekChar
7687 case mc of
7788 Just '.' -> do
78− (t, frac :: Int64) <- anyChar *> match decimal
79− return $! fromIntegral real + fromIntegral frac / 10 ^ T.length t
89+ t <- anyChar *> takeWhile1 (\c -> c >= '0' && c <= '9')
90+ return $! parsePicos real t
8091 _ -> return $! fromIntegral real
8192
93+parsePicos :: Int -> T.Text -> Pico
94+parsePicos a0 t =
95+ let (n,t') = T.foldl' step (12 :: Int, fromIntegral a0 :: Int64) t
96+ in mkPico (fromIntegral (t' * 10^n))
97+ where step na@(n,a) c
98+ | n <= 0 = na
99+ | otherwise = mkPair (n-1) (10 * a + fromIntegral (ord c) .&. 15)
100+ mkPair !x !y = (x,y)
101+
82102-- | Parse a time zone, and return 'Nothing' if the offset from UTC is
83103-- zero. (This makes some speedups possible.)
84104timeZone :: Parser (Maybe Local.TimeZone)