diff --git a/Data/Hourglass/Format.hs b/Data/Hourglass/Format.hs --- a/Data/Hourglass/Format.hs +++ b/Data/Hourglass/Format.hs @@ -35,7 +35,8 @@ import Data.Hourglass.Calendar import Data.Hourglass.Local import Data.Hourglass.Utils -import Data.Char (isDigit) +import Data.Char (isDigit, ord) +import Data.Int -- | All the various formatter that can be part -- of a time format string @@ -240,31 +241,31 @@ | c == x = Right (acc, xs) | otherwise = Left ("unexpected char, got: " ++ show c) - processOne acc Format_Year s = + processOne acc Format_Year s = onSuccess (\y -> modDate (setYear y) acc) $ isNumber s - processOne acc Format_Year4 s = - onSuccess (\y -> modDate (setYear y) acc) $ is4Digit s - processOne acc Format_Year2 s = onSuccess + 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) - $ is2Digit s - processOne acc Format_Month2 s = - onSuccess (\m -> modDate (setMonth $ toEnum ((m - 1) `mod` 12)) acc) $ is2Digit s - processOne acc Format_Day2 s = - onSuccess (\d -> modDate (setDay d) acc) $ is2Digit s + $ getNDigitNum 2 s + processOne acc Format_Month2 s = + onSuccess (\m -> modDate (setMonth $ toEnum ((fromIntegral m - 1) `mod` 12)) acc) $ getNDigitNum 2 s + 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) $ is2Digit s + onSuccess (\h -> modTime (setHour h) acc) $ getNDigitNum 2 s processOne acc Format_Minute s = - onSuccess (\mi -> modTime (setMin mi) acc) $ is2Digit s + onSuccess (\mi -> modTime (setMin mi) acc) $ getNDigitNum 2 s processOne acc Format_Second s = - onSuccess (\sec -> modTime (setSec sec) acc) $ is2Digit s + onSuccess (\sec -> modTime (setSec sec) acc) $ getNDigitNum 2 s processOne acc Format_MilliSecond s = - onSuccess (\ms -> modTime (setNsMask (6,3) ms) acc) $ isNDigit 3 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) $ isNDigit 3 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) $ isNDigit 3 s + onSuccess (\ns -> modTime (setNsMask (0,3) ns) acc) $ getNDigitNum 3 s processOne acc (Format_Precision p) s = - onSuccess (\num -> modTime (setNS num) acc) $ isNDigit p s + onSuccess (\num -> modTime (setNS num) acc) $ getNDigitNum p s processOne acc Format_UnixSecond s = onSuccess (\sec -> let newDate = dateTimeFromUnixEpochP $ flip ElapsedP 0 $ Elapsed $ Seconds sec @@ -294,33 +295,28 @@ parseHM _ _ _ _ = Left ("invalid timezone format") toTZ isNeg h1 h2 m1 m2 = TimezoneOffset ((if isNeg then negate else id) minutes) - where minutes = (read [h1,h2] * 60) + read [m1,m2] + where minutes = (toInt [h1,h2] * 60) + toInt [m1,m2] onSuccess f (Right (v, s')) = Right (f v, s') onSuccess _ (Left s) = Left s - is4Digit (a:b:c:d:s) - | allDigits [a,b,c,d] = Right (read (a:b:c:d:[]), s) - | otherwise = Left ("not digits chars: " ++ show [a,b,c,d]) - is4Digit _ = Left ("not enough chars") - - is2Digit (a:b:s) - | isDigit a && isDigit b = Right (read (a:b:[]), s) - | otherwise = Left ("not digits chars: " ++ show [a,b]) - is2Digit _ = Left ("not enough chars") - - isNDigit n l - | length l1 < n = Left ("not enough chars") - | and $ map isDigit l1 = Right (read l1, l2) - | otherwise = Left ("not digits chars: " ++ show l) - where (l1, l2) = splitAt n l - - isNumber :: (Read a, Num a) => String -> Either String (a, String) + isNumber :: Num a => String -> Either String (a, String) isNumber s = case span isDigit s of ("",s2) -> Left ("no digits chars:" ++ s2) - (s1,s2) -> Right (read s1, s2) + (s1,s2) -> Right (toInt s1, s2) + getNDigitNum :: Int -> String -> Either String (Int64, String) + getNDigitNum n s + | length s1 < n = Left ("not enough chars: expecting " ++ show n ++ " got " ++ show s1) + | not (allDigits s1) = Left ("not a digit chars in " ++ show s1) + | otherwise = Right (toInt 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 = and . map isDigit ini = (DateTime (Date 0 (toEnum 0) 0) (TimeOfDay 0 0 0 0), TimezoneOffset 0) @@ -330,15 +326,16 @@ modTime f (DateTime d tp, tz) = (DateTime d (f tp), tz) modTZ f (dt, tz) = (dt, f tz) - setYear y (Date _ m d) = Date y m d + 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 d - setHour h (TimeOfDay _ m s ns) = TimeOfDay h m s ns - setMin m (TimeOfDay h _ s ns) = TimeOfDay h m s ns - setSec s (TimeOfDay h m _ ns) = TimeOfDay h m s ns - setNS v (TimeOfDay h m s _ ) = TimeOfDay h m s v + 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) -> Int -> TimeOfDay -> TimeOfDay + 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 diff --git a/hourglass.cabal b/hourglass.cabal --- a/hourglass.cabal +++ b/hourglass.cabal @@ -1,5 +1,5 @@ Name: hourglass -Version: 0.2.5 +Version: 0.2.6 Synopsis: simple performant time related library Description: Simple time library focusing on simple but powerful and performant API diff --git a/tests/Bench.hs b/tests/Bench.hs --- a/tests/Bench.hs +++ b/tests/Bench.hs @@ -75,7 +75,7 @@ , bench ("time/" ++ n v) $ nf time v ] where n (y,m,d,h,mi,s) = (intercalate "-" $ map show [y,m,d]) ++ " " ++ (intercalate ":" $ map show [h,mi,s]) - hourglass (y,m,d,h,mi,s) = timeGetElapsed $ DateTime (Date y (toEnum (m-1)) d) (TimeOfDay h mi s 0) + hourglass (y,m,d,h,mi,s) = timeGetElapsed $ DateTime (Date y (toEnum (m-1)) d) (TimeOfDay (fromIntegral h) (fromIntegral mi) (fromIntegral s) 0) time (y,m,d,h,mi,s) = let day = T.fromGregorian (fromIntegral y) m d diffTime = T.secondsToDiffTime $ fromIntegral (h * 3600 + mi * 60 + s) in T.utcTimeToPOSIXSeconds (T.UTCTime day diffTime) @@ -84,6 +84,7 @@ [ bench ("hourglass/p") $ nfIO timeCurrent , bench ("hourglass/ns") $ nfIO timeCurrentP , bench ("time/posixTime") $ nfIO T.getPOSIXTime + , bench ("time/utcTime") $ nfIO T.getCurrentTime ] showH :: Show a => a -> String diff --git a/tests/Tests.hs b/tests/Tests.hs --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -196,7 +196,7 @@ ed1 = localTimeParseE ISO8601_Date fmt md2 = T.parseTime T.defaultTimeLocale fmt "%F" in case (ed1,md2) of - (Left _, Nothing) -> error ("both cannot parse: " ++ show fmt) + (Left err, Nothing) -> error ("both cannot parse: " ++ show fmt ++ " hourglass-err=" ++ show err) (Left err, Just _) -> error ("error parsing string: " ++ show err) (Right (d1, ""), Just d2) -> dateEqual d1 d2 (Right (_,_), Nothing) -> True -- let (LocalTime tparsed _) = r in error ("time cannot parse: " ++ show tparsed ++ " " ++ fmt)