chronos 0.1.0 → 0.2.0

raw patch · 16 files changed

+439/−138 lines, 16 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• chronos.cabal +5/−4
• src/Chronos/Datetime.hs +25/−0
• src/Chronos/Datetime/Text.hs +35/−11
• src/Chronos/Day.hs +2/−2
• src/Chronos/Internal.hs +1/−0
• src/Chronos/Internal/CTimespec.hs +27/−8
• src/Chronos/Internal/Conversion.hs +19/−15
• src/Chronos/Internal/FastText.hs +40/−0
• src/Chronos/Locale/English/Text.hs +12/−0
• src/Chronos/Nanoseconds.hs +41/−1
• src/Chronos/OffsetDatetime/Text.hs +10/−3
• src/Chronos/Posix.hs +4/−4
• src/Chronos/TimeOfDay/Text.hs +122/−40
• src/Chronos/Types.hs +64/−27
• src/Lib.hs +0/−6
• test/Spec.hs +32/−17

@@ -1,6 +1,6 @@ name:                chronos-version:             0.1.0-synopsis:            Initial project template from stack+version:             0.2.0+synopsis:            A time library, encoding, decoding, and instances description:         Please see README.md homepage:            https://github.com/andrewthad/chronos#readme license:             BSD3@@ -16,13 +16,13 @@ library   hs-source-dirs:      src   exposed-modules:-      Lib-    , Chronos.Types+      Chronos.Types     , Chronos.Calendar     , Chronos.Match     , Chronos.Nanoseconds     , Chronos.Day     , Chronos.Date.Text+    , Chronos.Datetime     , Chronos.Datetime.Text     , Chronos.OffsetDatetime.Text     , Chronos.TimeOfDay.Text@@ -30,6 +30,7 @@     , Chronos.Internal.Format     , Chronos.Internal.Conversion     , Chronos.Internal.CTimespec+    , Chronos.Internal.FastText     , Chronos.Tai     , Chronos.Posix     , Chronos.Month

@@ -0,0 +1,25 @@+module Chronos.Datetime where++import Chronos.Types+import qualified Chronos.Internal.Conversion as Conv++fromYmdhms :: Int -> Int -> Int -> Int -> Int -> Int -> Datetime+fromYmdhms y m d h m' s = Datetime+  (Date+     (Year $ fromIntegral y)+     (Month mx)+     (DayOfMonth $ fromIntegral d)+  )+  (TimeOfDay+     (fromIntegral h)+     (fromIntegral m')+     (fromIntegral s * 1000000000)+  )+  where+  mx = if m >= 1 && m <= 12+    then fromIntegral (m - 1)+    else error "fromYmdhms: month must be between 1 and 12"+++-- toOffsetDatetime :: Offset -> Datetime -> OffsetDatetime+-- toOffsetDatetime =

@@ -20,29 +20,39 @@ import qualified Data.Text.Lazy.Builder as Builder import qualified Data.Text.Lazy.Builder.Int as Builder -encode_YmdHMS :: DatetimeFormat Char -> Datetime -> Text-encode_YmdHMS format =-  LText.toStrict . Builder.toLazyText . builder_YmdHMS format+encode_YmdHMS :: SubsecondPrecision -> DatetimeFormat Char -> Datetime -> Text+encode_YmdHMS sp format =+  LText.toStrict . Builder.toLazyText . builder_YmdHMS sp format +encode_YmdIMS_p :: MeridiemLocale Text -> SubsecondPrecision -> DatetimeFormat Char -> Datetime -> Text+encode_YmdIMS_p a sp b = LText.toStrict . Builder.toLazyText . builder_YmdIMS_p a sp b+ -- | This could be written much more efficiently since we know the --   exact size the resulting 'Text' will be.-builder_YmdHMS :: DatetimeFormat Char -> Datetime -> Builder-builder_YmdHMS (DatetimeFormat mdateSep msep mtimeSep) (Datetime date time) =+builder_YmdHMS :: SubsecondPrecision -> DatetimeFormat Char -> Datetime -> Builder+builder_YmdHMS sp (DatetimeFormat mdateSep msep mtimeSep) (Datetime date time) =   case msep of     Nothing -> Date.builder_Ymd mdateSep date-            <> TimeOfDay.builder_HMS mtimeSep time+            <> TimeOfDay.builder_HMS sp mtimeSep time     Just sep -> Date.builder_Ymd mdateSep date              <> Builder.singleton sep-             <> TimeOfDay.builder_HMS mtimeSep time+             <> TimeOfDay.builder_HMS sp mtimeSep time -builder_YmdIMS_p :: MeridiemLocale Text -> DatetimeFormat Char -> Datetime -> Builder-builder_YmdIMS_p locale (DatetimeFormat mdateSep msep mtimeSep) (Datetime date time) =+builder_YmdIMS_p :: MeridiemLocale Text -> SubsecondPrecision -> DatetimeFormat Char -> Datetime -> Builder+builder_YmdIMS_p locale sp (DatetimeFormat mdateSep msep mtimeSep) (Datetime date time) =      Date.builder_Ymd mdateSep date   <> maybe mempty Builder.singleton msep-  <> TimeOfDay.builder_IMS_p locale mtimeSep time+  <> TimeOfDay.builder_IMS_p locale sp mtimeSep time +builder_YmdIMSp :: MeridiemLocale Text -> SubsecondPrecision -> DatetimeFormat Char -> Datetime -> Builder+builder_YmdIMSp locale sp (DatetimeFormat mdateSep msep mtimeSep) (Datetime date time) =+     Date.builder_Ymd mdateSep date+  <> maybe mempty Builder.singleton msep+  <> TimeOfDay.builder_IMS_p locale sp mtimeSep time++ builderW3 :: Datetime -> Builder-builderW3 = builder_YmdHMS (DatetimeFormat (Just '-') (Just 'T') (Just ':'))+builderW3 = builder_YmdHMS SubsecondPrecisionAuto (DatetimeFormat (Just '-') (Just 'T') (Just ':'))  decode_YmdHMS :: DatetimeFormat Char -> Text -> Maybe Datetime decode_YmdHMS format =@@ -54,4 +64,18 @@   traverse_ Atto.char msep   time <- TimeOfDay.parser_HMS mtimeSep   return (Datetime date time)++parser_YmdHMS_opt_S :: DatetimeFormat Char -> Parser Datetime+parser_YmdHMS_opt_S (DatetimeFormat mdateSep msep mtimeSep) = do+  date <- Date.parser_Ymd mdateSep+  traverse_ Atto.char msep+  time <- TimeOfDay.parser_HMS_opt_S mtimeSep+  return (Datetime date time)++decode_YmdHMS_opt_S :: DatetimeFormat Char -> Text -> Maybe Datetime+decode_YmdHMS_opt_S format =+  either (const Nothing) Just . Atto.parseOnly (parser_YmdHMS_opt_S format)+++ 

@@ -3,9 +3,9 @@ import Chronos.Types import Data.Int -add :: Int32 -> Day -> Day+add :: Int -> Day -> Day add a (Day b) = Day (a + b) -diff :: Day -> Day -> Int32+diff :: Day -> Day -> Int diff (Day a) (Day b) = a - b 

@@ -87,4 +87,5 @@ clip a _ x | x < a = a clip _ b x | x > b = b clip _ _ x = x+{-# INLINE clip #-} 

@@ -1,18 +1,33 @@-module Chronos.Internal.CTimespec where+{-# LANGUAGE CPP #-} +module Chronos.Internal.CTimespec+  ( getPosixNanoseconds+  ) where+ import Foreign import Foreign.C -data CTimespec = MkCTimespec CTime CLong+#ifdef ghcjs_HOST_OS +-- Fix this at some point.+getPosixNanoseconds :: IO Int64+getPosixNanoseconds = return 0++#else++data CTimespec = CTimespec+  { ctimespecSeconds :: {-# UNPACK #-} !CTime+  , ctimespecNanoseconds :: {-# UNPACK #-} !CLong+  }+ instance Storable CTimespec where     sizeOf _ = (16)     alignment _ = alignment (undefined :: CLong)     peek p = do         s  <- (\hsc_ptr -> peekByteOff hsc_ptr 0) p         ns <- (\hsc_ptr -> peekByteOff hsc_ptr 8) p-        return (MkCTimespec s ns)-    poke p (MkCTimespec s ns) = do+        return (CTimespec s ns)+    poke p (CTimespec s ns) = do         (\hsc_ptr -> pokeByteOff hsc_ptr 0) p s         (\hsc_ptr -> pokeByteOff hsc_ptr 8) p ns @@ -20,11 +35,15 @@     clock_gettime :: Int32 -> Ptr CTimespec -> IO CInt  -- | Get the current POSIX time from the system clock.-getCTimespec :: IO CTimespec-getCTimespec = alloca (\ptspec -> do+getPosixNanoseconds :: IO Int64+getPosixNanoseconds = do+  CTimespec (CTime s) (CLong ns) <- alloca $ \ptspec -> do     throwErrnoIfMinus1_ "clock_gettime" $-        clock_gettime 0 ptspec+      clock_gettime 0 ptspec     peek ptspec-    )+  return ((s * 1000000000) + ns)++#endif+  

@@ -9,10 +9,10 @@ import qualified Data.Vector as Vector import qualified Data.Vector.Unboxed as UVector -dayLengthWord64 :: Word64-dayLengthWord64 = 86400000000000+dayLengthInt64 :: Int64+dayLengthInt64 = 86400000000000 -nanosecondsInMinute :: Word64+nanosecondsInMinute :: Int64 nanosecondsInMinute = 60000000000  -- | The first argument in the resulting tuple in a day@@ -20,23 +20,24 @@ --   offset should ever exceed 24 hours. offsetTimeOfDay :: Offset -> TimeOfDay -> (Days, TimeOfDay) offsetTimeOfDay (Offset offset) (TimeOfDay h m s) =-  (Days (fromIntegral dayAdjustment),TimeOfDay (fromIntegral h'') (fromIntegral m'') s)+  (Days dayAdjustment,TimeOfDay h'' m'' s)   where   (!dayAdjustment, !h'') = divMod h' 24   (!hourAdjustment, !m'') = divMod m' 60-  m' = (fromIntegral m :: Int16) + offset-  h' = fromIntegral h + hourAdjustment+  m' = m + offset+  h' = h + hourAdjustment -nanosecondsSinceMidnightToTimeOfDay :: Word64 -> TimeOfDay+nanosecondsSinceMidnightToTimeOfDay :: Int64 -> TimeOfDay nanosecondsSinceMidnightToTimeOfDay ns =-  if ns >= dayLengthWord64-    then TimeOfDay 23 59 (nanosecondsInMinute + (ns - dayLengthWord64))-    else TimeOfDay (fromIntegral h') (fromIntegral m') ns'+  if ns >= dayLengthInt64+    then TimeOfDay 23 59 (nanosecondsInMinute + (ns - dayLengthInt64))+    else TimeOfDay h' m' ns'   where-  (!m,!ns') = quotRem ns nanosecondsInMinute+  (!mInt64,!ns') = quotRem ns nanosecondsInMinute+  !m = fromIntegral mInt64   (!h',!m')  = quotRem m 60 -timeOfDayToNanosecondsSinceMidnight :: TimeOfDay -> Word64+timeOfDayToNanosecondsSinceMidnight :: TimeOfDay -> Int64 timeOfDayToNanosecondsSinceMidnight (TimeOfDay h m ns) =   fromIntegral h * 3600000000000 + fromIntegral m * 60000000000 + ns @@ -46,6 +47,9 @@   OrdinalDate year yd = dayToOrdinalDate day   MonthDate month dayOfMonth = dayOfYearToMonthAndDay (isLeapYear year) yd +-- datetimeToOffsetDatetime :: Offset -> Datetime -> OffsetDatetime+-- datetimeToOffsetDatetime offset+ utcTimeToOffsetDatetime :: Offset -> UtcTime -> OffsetDatetime utcTimeToOffsetDatetime offset (UtcTime (Day d) nanoseconds) =   let (!(Days dayAdjustment),!tod) = offsetTimeOfDay offset (nanosecondsSinceMidnightToTimeOfDay nanoseconds)@@ -131,15 +135,15 @@ internalMatchMonth :: MonthMatch a -> Month -> a internalMatchMonth (MonthMatch v) (Month ix) = Vector.unsafeIndex v (fromIntegral ix) -monthLength :: Bool -> Month -> Word8+monthLength :: Bool -> Month -> Int monthLength isLeap m = if isLeap   then internalMatchMonth leapYearMonthLength m   else internalMatchMonth leapYearMonthLength m -leapYearMonthLength :: MonthMatch Word8+leapYearMonthLength :: MonthMatch Int leapYearMonthLength = internalBuildMonthMatch 31 29 31 30 31 30 31 31 30 31 30 31 -normalYearMonthLength :: MonthMatch Word8+normalYearMonthLength :: MonthMatch Int normalYearMonthLength = internalBuildMonthMatch 31 30 31 30 31 30 31 31 30 31 30 31  leapYearDayOfYearDayOfMonthTable :: UVector.Vector DayOfMonth

@@ -0,0 +1,40 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE RankNTypes #-}++module Chronos.Internal.FastText where++import Data.Text (Text)+import Control.Monad.ST (ST)+import qualified Data.Text.Internal as I+import qualified Data.Text as Text+import qualified Data.Text.Array as A+import qualified Data.Text.Internal.Unsafe.Char as C++data MArrayAppend s = MArrayAppend (Int -> A.MArray s -> ST s Int) !Int++combine :: MArrayAppend s -> MArrayAppend s -> MArrayAppend s+combine (MArrayAppend f maxSizeA) (MArrayAppend g maxSizeB) = do+  MArrayAppend (\i marr -> f i marr >>= (\j -> g j marr)) (maxSizeA + maxSizeB)++runMArrayAppend :: (forall s. MArrayAppend s) -> Text+runMArrayAppend x =+  let (!arr, !word16Used) = A.run2 $ case x of+        MArrayAppend f maxSize -> do+          marr <- A.new maxSize+          finalSize <- f 0 marr+          return (marr,finalSize)+   in I.Text arr 0 word16Used++singleton :: Char -> MArrayAppend s+singleton c = MArrayAppend (\i marr -> do+  C.unsafeWrite marr i c+  ) 2++fromText :: Text -> MArrayAppend s+fromText (I.Text arr start len) = MArrayAppend (\i marr -> do+  let j = len + i+  A.copyI marr i arr start j+  return j ) len+++

@@ -6,6 +6,18 @@ import qualified Chronos.Month as Month import Data.Text (Text) +datetimeW3 :: DatetimeFormat Char+datetimeW3 = DatetimeFormat (Just '-') (Just 'T') (Just ':')++datetimeSlash :: DatetimeFormat Char+datetimeSlash = DatetimeFormat (Just '/') (Just ' ') (Just ':')++datetimeHyphen :: DatetimeFormat Char+datetimeHyphen = DatetimeFormat (Just '-') (Just ' ') (Just ':')++datetimeCompact :: DatetimeFormat Char+datetimeCompact = DatetimeFormat Nothing (Just 'T') Nothing+ meridiemLower :: MeridiemLocale Text meridiemLower = MeridiemLocale "am" "pm" 

@@ -1,11 +1,51 @@-module Chronos.Nanoseconds where+module Chronos.Nanoseconds+  ( -- * Arithmetic+    add+  , scale+    -- * From Duration+    -- $fromduration+  , fromSeconds+  , fromMinutes+  , fromHours+  , fromDays+  , fromWeeks+  ) where +import Prelude hiding (negate)+import qualified Prelude as Prelude import Data.Int import Chronos.Types  add :: Nanoseconds -> Nanoseconds -> Nanoseconds add (Nanoseconds a) (Nanoseconds b) = Nanoseconds (a + b) +negate :: Nanoseconds -> Nanoseconds+negate (Nanoseconds a) = Nanoseconds (Prelude.negate a)+ scale :: Int64 -> Nanoseconds -> Nanoseconds scale i (Nanoseconds x) = Nanoseconds (i * x)++{- $fromduration++These functions are at times convenient, but on a fundamental level,+all of them except for 'fromSeconds' are incorrect. If we account for+leap seconds, we must acknowledge that not all minutes contain 60 seconds.+Some contain 61 seconds, and in the future some may contain 59 seconds.++-}++fromSeconds :: Int64 -> Nanoseconds+fromSeconds = Nanoseconds . (1000000000 *)++fromMinutes :: Int64 -> Nanoseconds+fromMinutes = Nanoseconds . (60000000000 *)++fromHours :: Int64 -> Nanoseconds+fromHours = Nanoseconds . (3600000000000 *)++fromDays :: Int64 -> Nanoseconds+fromDays = Nanoseconds . (86400000000000 *)++fromWeeks :: Int64 -> Nanoseconds+fromWeeks = Nanoseconds . (604800000000000 *) 

@@ -30,9 +30,9 @@ import qualified Data.Text.Lazy.Builder as Builder import qualified Data.Text.Lazy.Builder.Int as Builder -builder_YmdHMSz :: OffsetFormat -> DatetimeFormat Char -> OffsetDatetime -> Builder-builder_YmdHMSz offsetFormat datetimeFormat (OffsetDatetime datetime offset) =-     Datetime.builder_YmdHMS datetimeFormat datetime+builder_YmdHMSz :: OffsetFormat -> SubsecondPrecision -> DatetimeFormat Char -> OffsetDatetime -> Builder+builder_YmdHMSz offsetFormat sp datetimeFormat (OffsetDatetime datetime offset) =+     Datetime.builder_YmdHMS sp datetimeFormat datetime   <> offsetBuilder offsetFormat offset  parser_YmdHMSz :: OffsetFormat -> DatetimeFormat Char -> Parser OffsetDatetime@@ -40,9 +40,16 @@   <$> Datetime.parser_YmdHMS datetimeFormat   <*> offsetParser offsetFormat +builder_YmdIMS_p_z :: OffsetFormat -> MeridiemLocale Text -> SubsecondPrecision -> DatetimeFormat Char -> OffsetDatetime -> Builder+builder_YmdIMS_p_z offsetFormat meridiemLocale sp datetimeFormat (OffsetDatetime datetime offset) =+     Datetime.builder_YmdIMS_p meridiemLocale sp datetimeFormat datetime+  <> " "+  <> offsetBuilder offsetFormat offset+ builderW3 :: OffsetDatetime -> Builder builderW3 = builder_YmdHMSz   OffsetFormatColonOn+  SubsecondPrecisionAuto   (DatetimeFormat (Just '-') (Just 'T') (Just ':'))  offsetBuilder :: OffsetFormat -> Offset -> Builder

@@ -43,7 +43,7 @@ -- | This probably needs to be wrapped in a bunch of CPP like --   the one in @time@ is. now :: IO PosixTime-now = fmap ctimespecToPosixSeconds getCTimespec+now = fmap PosixTime getPosixNanoseconds  -- | This may be wrong for dates before what we count as the --   first modified julian day.@@ -77,7 +77,7 @@ -- toDatetime (PosixTime i) = let (d,t) = divMod i (getNanoseconds dayLength) --  in UtcTime (Day.add (fromIntegral d) epochDay) (fromIntegral t) -ctimespecToPosixSeconds :: CTimespec -> PosixTime-ctimespecToPosixSeconds (MkCTimespec (CTime s) (CLong ns)) =-  PosixTime ((s * 1000000000) + ns)+-- ctimespecToPosixSeconds :: CTimespec -> PosixTime+-- ctimespecToPosixSeconds (MkCTimespec (CTime s) (CLong ns)) =+--   PosixTime ((s * 1000000000) + ns) 

@@ -13,6 +13,7 @@ import Control.Applicative import Data.Foldable import Data.Word+import Data.Int import Data.Char (isDigit) import qualified Chronos.Internal as I import qualified Data.Text as Text@@ -24,45 +25,37 @@  -- | This could be written much more efficiently since we know the --   exact size the resulting 'Text' will be.-builder_HMS :: Maybe Char -> TimeOfDay -> Builder-builder_HMS msep (TimeOfDay h m us) = case msep of-  Nothing -> I.indexTwoDigitTextBuilder h-          <> I.indexTwoDigitTextBuilder m-          <> I.indexTwoDigitTextBuilder s-          <> microsecondsBuilder usRemainder-  Just sep -> let sepBuilder = Builder.singleton sep in-             I.indexTwoDigitTextBuilder h-          <> sepBuilder-          <> I.indexTwoDigitTextBuilder m-          <> sepBuilder-          <> I.indexTwoDigitTextBuilder s-          <> microsecondsBuilder usRemainder-  where-  (!s,!usRemainder) = quotRem us 1000000000+builder_HMS :: SubsecondPrecision -> Maybe Char -> TimeOfDay -> Builder+builder_HMS sp msep (TimeOfDay h m ns) =+     I.indexTwoDigitTextBuilder h+  <> internalBuilder_NS sp msep m ns -builder_IMS_p :: MeridiemLocale Text -> Maybe Char -> TimeOfDay -> Builder-builder_IMS_p (MeridiemLocale am pm) msep (TimeOfDay h m us) = case msep of-  Nothing -> I.indexTwoDigitTextBuilder h-          <> I.indexTwoDigitTextBuilder m-          <> I.indexTwoDigitTextBuilder s-          <> microsecondsBuilder usRemainder-          <> " "-          <> meridiemBuilder-  Just sep -> let sepBuilder = Builder.singleton sep in-             I.indexTwoDigitTextBuilder h-          <> sepBuilder-          <> I.indexTwoDigitTextBuilder m-          <> sepBuilder-          <> I.indexTwoDigitTextBuilder s-          <> microsecondsBuilder usRemainder-          <> " "-          <> meridiemBuilder-  where-  (!s,!usRemainder) = quotRem us 1000000000-  meridiemBuilder = if h > 11-    then Builder.fromText pm-    else Builder.fromText am+builder_IMS_p :: MeridiemLocale Text -> SubsecondPrecision -> Maybe Char -> TimeOfDay -> Builder+builder_IMS_p meridiemLocale sp msep (TimeOfDay h m ns) =+     internalBuilder_I h+  <> internalBuilder_NS sp msep h ns+  <> " "+  <> internalBuilder_p meridiemLocale h +internalBuilder_I :: Int -> Builder+internalBuilder_I h =+  I.indexTwoDigitTextBuilder $ if h > 12+    then h - 12+    else if h == 0+      then 12+      else h++internalBuilder_p :: MeridiemLocale Text -> Int -> Builder+internalBuilder_p (MeridiemLocale am pm) h = if h > 11+  then Builder.fromText pm+  else Builder.fromText am++builder_IMSp :: MeridiemLocale Text -> SubsecondPrecision -> Maybe Char -> TimeOfDay -> Builder+builder_IMSp meridiemLocale sp msep (TimeOfDay h m ns) =+     internalBuilder_I h+  <> internalBuilder_NS sp msep h ns+  <> internalBuilder_p meridiemLocale h+ parser_HMS :: Maybe Char -> Parser TimeOfDay parser_HMS msep = do   h <- I.parseFixedDigits 2@@ -71,6 +64,46 @@   m <- I.parseFixedDigits 2   when (m > 59) (fail "minute must be between 0 and 59")   traverse_ Atto.char msep+  ns <- parseSecondsAndNanoseconds+  return (TimeOfDay h m ns)++-- | Parses text that is formatted as either of the following:+--+-- * @%H:%M@+-- * @%H:%M:%S@+--+-- That is, the seconds and subseconds part is optional. If it is+-- not provided, it is assumed to be zero. This format shows up+-- in Google Chrome\'s @datetime-local@ inputs.+parser_HMS_opt_S :: Maybe Char -> Parser TimeOfDay+parser_HMS_opt_S msep = do+  h <- I.parseFixedDigits 2+  when (h > 23) (fail "hour must be between 0 and 23")+  traverse_ Atto.char msep+  m <- I.parseFixedDigits 2+  when (m > 59) (fail "minute must be between 0 and 59")+  mc <- Atto.peekChar+  case mc of+    Nothing -> return (TimeOfDay h m 0)+    Just c -> case msep of+      Just sep -> if c == sep+        then do+          _ <- Atto.anyChar -- should be the separator+          ns <- parseSecondsAndNanoseconds+          return (TimeOfDay h m ns)+        else return (TimeOfDay h m 0)+      -- if there is no separator, we will try to parse the+      -- remaining part as seconds. We commit to trying to+      -- parse as seconds if we see any number as the next+      -- character.+      Nothing -> if isDigit c+        then do+          ns <- parseSecondsAndNanoseconds+          return (TimeOfDay h m ns)+        else return (TimeOfDay h m 0)++parseSecondsAndNanoseconds :: Parser Int64+parseSecondsAndNanoseconds = do   s <- I.parseFixedDigits 2   when (s > 60) (fail "seconds must be between 0 and 60")   nanoseconds <-@@ -85,7 +118,7 @@                  else quot x (I.raiseTenTo (totalDigits - 9))          return (fromIntegral result)     ) <|> return 0-  return (TimeOfDay h m (s * 1000000000 + nanoseconds))+  return (s * 1000000000 + nanoseconds)  countZeroes :: Parser Int countZeroes = go 0 where@@ -97,8 +130,8 @@         then Atto.anyChar *> go (i + 1)         else return i -microsecondsBuilder :: Word64 -> Builder-microsecondsBuilder w+nanosecondsBuilder :: Int64 -> Builder+nanosecondsBuilder w   | w == 0 = mempty   | w > 99999999 = "." <> Builder.decimal w   | w > 9999999 = ".0" <> Builder.decimal w@@ -109,4 +142,53 @@   | w > 99 = ".000000" <> Builder.decimal w   | w > 9 = ".0000000" <> Builder.decimal w   | otherwise = ".00000000" <> Builder.decimal w++microsecondsBuilder :: Int64 -> Builder+microsecondsBuilder w+  | w == 0 = mempty+  | w > 99999 = "." <> Builder.decimal w+  | w > 9999 = ".0" <> Builder.decimal w+  | w > 999 = ".00" <> Builder.decimal w+  | w > 99 = ".000" <> Builder.decimal w+  | w > 9 = ".0000" <> Builder.decimal w+  | otherwise = ".00000" <> Builder.decimal w++millisecondsBuilder :: Int64 -> Builder+millisecondsBuilder w+  | w == 0 = mempty+  | w > 99 = "." <> Builder.decimal w+  | w > 9 = ".0" <> Builder.decimal w+  | otherwise = ".00" <> Builder.decimal w++prettyNanosecondsBuilder :: SubsecondPrecision -> Int64 -> Builder+prettyNanosecondsBuilder sp nano = case sp of+  SubsecondPrecisionAuto+    | milliRem == 0 -> millisecondsBuilder milli+    | microRem == 0 -> microsecondsBuilder micro+    | otherwise -> nanosecondsBuilder nano+  SubsecondPrecisionFixed d -> if d == 0+    then mempty+    else+      let newSubsecondPart = quot nano (I.raiseTenTo (9 - d))+       in "."+          <> Builder.fromText (Text.replicate (d - I.countDigits newSubsecondPart) "0")+          <> Builder.decimal newSubsecondPart+  where+  (milli,milliRem) = quotRem nano 1000000+  (micro,microRem) = quotRem nano 1000++internalBuilder_NS :: SubsecondPrecision -> Maybe Char -> Int -> Int64 -> Builder+internalBuilder_NS sp msep m ns = case msep of+  Nothing -> I.indexTwoDigitTextBuilder m+          <> I.indexTwoDigitTextBuilder s+          <> prettyNanosecondsBuilder sp nsRemainder+  Just sep -> let sepBuilder = Builder.singleton sep in+             sepBuilder+          <> I.indexTwoDigitTextBuilder m+          <> sepBuilder+          <> I.indexTwoDigitTextBuilder s+          <> prettyNanosecondsBuilder sp nsRemainder+  where+  (!sInt64,!nsRemainder) = quotRem ns 1000000000+  !s = fromIntegral sInt64 

@@ -4,6 +4,35 @@ {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE DeriveGeneric #-} +{- | Data types for representing different date and time-related+     information.++     Internally, the types 'Int' and 'Int64' are used to+     represent everything. These are used even when negative+     values are not appropriate and even if a smaller fixed-size+     integer could hold the information. The only cases when+     'Int64' is used are when it is neccessary to represent values+     with numbers @2^29@ or higher. These are typically fields+     that represent nanoseconds.++     Unlike the types in the venerable @time@ library, the types+     here do not allow the user to work with all dates. Since this+     library uses fixed-precision integral values instead of 'Integer',+     all of the usual problems with overflow should be considered. Notably,+     'PosixTime' and 'TaiTime' can only be used to represent time between the years+     1680 and 2260. All other types in this library correctly represent time+     a million years before or after 1970.++     The vector unbox instances, not yet available, will store+     data in a reasonably compact manner. For example, the instance+     for 'Day' has three unboxed vectors: 'Int' for the year, 'Int8'+     for the month, and 'Int8' for the day. This only causes+     corruption of data if the user is trying to use out-of-bounds+     values for the month and the day. Users are advised to not+     use the data types provided here to model non-existent times.++-}+ module Chronos.Types where  import Data.Int@@ -21,32 +50,36 @@ import qualified Data.Vector.Unboxed.Mutable    as MUVector import qualified Data.Vector.Primitive.Mutable  as MPVector -newtype Day = Day { getDay :: Int32 }-  deriving (Show,Read,Eq,Ord)+newtype Day = Day { getDay :: Int }+  deriving (Show,Read,Eq,Ord,Hashable)  -- | A duration of days-newtype Days = Days { getDays :: Int32 }-  deriving (Show,Read,Eq,Ord)+newtype Days = Days { getDays :: Int }+  deriving (Show,Read,Eq,Ord,Hashable) -newtype DayOfWeek = DayOfWeek { getDayOfWeek :: Word8 }+newtype DayOfWeek = DayOfWeek { getDayOfWeek :: Int }+  deriving (Show,Read,Eq,Ord,Hashable) -newtype DayOfMonth = DayOfMonth { getDayOfMonth :: Word8 }+newtype DayOfMonth = DayOfMonth { getDayOfMonth :: Int }   deriving (Show,Read,Eq,Ord,Prim,Enum) -newtype DayOfYear = DayOfYear { getDayOfYear :: Word16 }+newtype DayOfYear = DayOfYear { getDayOfYear :: Int }   deriving (Show,Read,Eq,Ord,Prim) -newtype Month = Month { getMonth :: Word8 }+newtype Month = Month { getMonth :: Int }   deriving (Show,Read,Eq,Ord,Prim) +newtype Months = Months { getMonths :: Int }+  deriving (Show,Read,Eq,Ord)+ instance Bounded Month where   minBound = Month 0   maxBound = Month 11 -newtype Year = Year { getYear :: Int32 }+newtype Year = Year { getYear :: Int }   deriving (Show,Read,Eq,Ord) -newtype Offset = Offset { getOffset :: Int16 }+newtype Offset = Offset { getOffset :: Int }   deriving (Show,Read,Eq,Ord)  -- This is a Modified Julian Day.@@ -72,51 +105,55 @@ newtype Nanoseconds = Nanoseconds { getNanoseconds :: Int64 }   deriving (Show,Read,Eq,Ord) +data SubsecondPrecision+  = SubsecondPrecisionAuto -- ^ Rounds to second, millisecond, microsecond, or nanosecond+  | SubsecondPrecisionFixed {-# UNPACK #-} !Int -- ^ Specify number of places after decimal+ -- | A date as represented by the Gregorian calendar. data Date = Date-  { dateYear  :: !Year-  , dateMonth :: !Month-  , dateDay   :: !DayOfMonth+  { dateYear  :: {-# UNPACK #-} !Year+  , dateMonth :: {-# UNPACK #-} !Month+  , dateDay   :: {-# UNPACK #-} !DayOfMonth   } deriving (Show,Read,Eq,Ord)  data OrdinalDate = OrdinalDate-  { ordinalDateYear  :: !Year-  , ordinalDateMonth :: !DayOfYear+  { ordinalDateYear  :: {-# UNPACK #-} !Year+  , ordinalDateMonth :: {-# UNPACK #-} !DayOfYear   } deriving (Show,Read,Eq,Ord)  data MonthDate = MonthDate-  { monthDateMonth :: !Month-  , monthDateDay   :: !DayOfMonth+  { monthDateMonth :: {-# UNPACK #-} !Month+  , monthDateDay   :: {-# UNPACK #-} !DayOfMonth   } deriving (Show,Read,Eq,Ord)  -- | A date as represented by the Gregorian calendar --   and a time of day. data Datetime = Datetime-  { datetimeDate :: !Date-  , datetimeTime :: !TimeOfDay+  { datetimeDate :: {-# UNPACK #-} !Date+  , datetimeTime :: {-# UNPACK #-} !TimeOfDay   } deriving (Show,Read,Eq,Ord)  data OffsetDatetime = OffsetDatetime-  { offsetDatetimeDatetime :: !Datetime-  , offsetDatetimeOffset :: !Offset+  { offsetDatetimeDatetime :: {-# UNPACK #-} !Datetime+  , offsetDatetimeOffset :: {-# UNPACK #-} !Offset   } deriving (Show,Read,Eq,Ord)  -- | A time of day, including the possibility of leap seconds. data TimeOfDay = TimeOfDay-  { timeOfDayHour :: !Word8-  , timeOfDayMinute :: !Word8-  , timeOfDayNanoseconds :: !Word64+  { timeOfDayHour :: {-# UNPACK #-} !Int+  , timeOfDayMinute :: {-# UNPACK #-} !Int+  , timeOfDayNanoseconds :: {-# UNPACK #-} !Int64   } deriving (Show,Read,Eq,Ord)  data UtcTime = UtcTime-  { utcTimeDate :: !Day-  , utcTimeNanoseconds :: !Word64+  { utcTimeDate :: {-# UNPACK #-} !Day+  , utcTimeNanoseconds :: {-# UNPACK #-} !Int64   } deriving (Show,Read,Eq,Ord)  data DatetimeFormat a = DatetimeFormat   { datetimeFormatDateSeparator :: !(Maybe a)     -- ^ Separator in the date-  , datetimeFormatSeparator:: !(Maybe a)+  , datetimeFormatSeparator :: !(Maybe a)     -- ^ Separator between date and time   , datetimeFormatTimeSeparator :: !(Maybe a)     -- ^ Separator in the time

@@ -1,6 +0,0 @@-module Lib-    ( someFunc-    ) where--someFunc :: IO ()-someFunc = putStrLn "someFunc"

@@ -1,12 +1,13 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TypeFamilies #-}  module Main (main) where  import Chronos.Types import Data.List                            (intercalate)-import Test.QuickCheck                      (Gen, Arbitrary(..), choose, arbitraryBoundedEnum, genericShrink)+import Test.QuickCheck                      (Gen, Arbitrary(..), choose, arbitraryBoundedEnum, genericShrink, elements) import Test.QuickCheck.Property             (failed,succeeded,Result(..)) import Test.Framework                       (defaultMain, defaultMainWithOpts, testGroup, Test) import qualified Test.Framework             as TF@@ -60,17 +61,25 @@           (timeOfDayParse (Just ':') "05:00:58.111222999" (TimeOfDay 05 00 58111222999))       , testCase "Separator + 10e-18 seconds (truncate)"           (timeOfDayParse (Just ':') "05:00:58.111222333444555666" (TimeOfDay 05 00 58111222333))+      , testCase "Separator + opt seconds (absent)"+          (parseMatch (TimeOfDayText.parser_HMS_opt_S (Just ':')) "00:01" (TimeOfDay 0 1 0))+      , testCase "Separator + opt seconds (present)"+          (parseMatch (TimeOfDayText.parser_HMS_opt_S (Just ':')) "00:01:05" (TimeOfDay 0 1 5000000000))+      , testCase "No Separator + opt seconds (absent)"+          (parseMatch (TimeOfDayText.parser_HMS_opt_S Nothing) "0001" (TimeOfDay 0 1 0))+      , testCase "No Separator + opt seconds (present)"+          (parseMatch (TimeOfDayText.parser_HMS_opt_S Nothing) "000105" (TimeOfDay 0 1 5000000000))       ]     , testGroup "Builder Spec Tests"       [ testCase "No Separator + microseconds"-          (timeOfDayBuilder Nothing "165956.246052000" (TimeOfDay 16 59 56246052000))+          (timeOfDayBuilder (SubsecondPrecisionFixed 6) Nothing "165956.246052" (TimeOfDay 16 59 56246052000))       , testCase "Separator + microseconds"-          (timeOfDayBuilder (Just ':') "16:59:56.246052000" (TimeOfDay 16 59 56246052000))+          (timeOfDayBuilder (SubsecondPrecisionFixed 6) (Just ':') "16:59:56.246052" (TimeOfDay 16 59 56246052000))       , testCase "Separator + no subseconds"-          (timeOfDayBuilder (Just ':') "23:08:01" (TimeOfDay 23 8 1000000000))+          (timeOfDayBuilder (SubsecondPrecisionFixed 0) (Just ':') "23:08:01" (TimeOfDay 23 8 1000000000))       ]     , testProperty "Builder Parser Isomorphism (H:M:S)" $ propEncodeDecodeIso-        (LText.toStrict . Builder.toLazyText . TimeOfDayText.builder_HMS (Just ':'))+        (LText.toStrict . Builder.toLazyText . TimeOfDayText.builder_HMS (SubsecondPrecisionFixed 9) (Just ':'))         (either (const Nothing) Just . Atto.parseOnly (TimeOfDayText.parser_HMS (Just ':')))     ]   , testGroup "Date"@@ -95,16 +104,16 @@         (either (const Nothing) Just . Atto.parseOnly (DateText.parser_Ymd (Just '-')))     ]   , testGroup "Datetime"-    [ testProperty "Builder Parser Isomorphism (Y-m-dTH:M:S)" $ propEncodeDecodeIso-        (LText.toStrict . Builder.toLazyText . DatetimeText.builder_YmdHMS (DatetimeFormat (Just '-') (Just 'T') (Just ':')))-        (either (const Nothing) Just . Atto.parseOnly (DatetimeText.parser_YmdHMS (DatetimeFormat (Just '-') (Just 'T') (Just ':'))))+    [ testProperty "Builder Parser Isomorphism (Y-m-dTH:M:S)" $ propEncodeDecodeIsoSettings+        (\format -> LText.toStrict . Builder.toLazyText . DatetimeText.builder_YmdHMS (SubsecondPrecisionFixed 9) format)+        (\format -> either (const Nothing) Just . Atto.parseOnly (DatetimeText.parser_YmdHMS format))     , testProperty "Builder Parser Isomorphism (YmdHMS)" $ propEncodeDecodeIso-        (LText.toStrict . Builder.toLazyText . DatetimeText.builder_YmdHMS (DatetimeFormat Nothing Nothing Nothing))+        (LText.toStrict . Builder.toLazyText . DatetimeText.builder_YmdHMS (SubsecondPrecisionFixed 9) (DatetimeFormat Nothing Nothing Nothing))         (either (const Nothing) Just . Atto.parseOnly (DatetimeText.parser_YmdHMS (DatetimeFormat Nothing Nothing Nothing)))     ]   , testGroup "Offset Datetime"     [ testGroup "Builder Spec Tests" $-      [ testCase "W3C" $ matchBuilder "1997-07-16T19:20:30.450000000+01:00" $+      [ testCase "W3C" $ matchBuilder "1997-07-16T19:20:30.450+01:00" $           OffsetDatetimeText.builderW3 $ OffsetDatetime             ( Datetime               ( Date (Year 1997) Month.july (DayOfMonth 16) )@@ -114,7 +123,7 @@     , testProperty "Builder Parser Isomorphism (YmdHMSz)" $ propEncodeDecodeIsoSettings         (\(offsetFormat,datetimeFormat) offsetDatetime ->             LText.toStrict $ Builder.toLazyText $-              OffsetDatetimeText.builder_YmdHMSz offsetFormat datetimeFormat offsetDatetime+              OffsetDatetimeText.builder_YmdHMSz offsetFormat (SubsecondPrecisionFixed 9) datetimeFormat offsetDatetime         )         (\(offsetFormat,datetimeFormat) input ->             either (const Nothing) Just $ flip Atto.parseOnly input $@@ -170,7 +179,8 @@ propEncodeDecodeIso :: Eq a => (a -> b) -> (b -> Maybe a) -> a -> Bool propEncodeDecodeIso f g a = g (f a) == Just a -propEncodeDecodeIsoSettings :: (Eq a,Show a,Show b,Show e) => (e -> a -> b) -> (e -> b -> Maybe a) -> e -> a -> Result+propEncodeDecodeIsoSettings :: (Eq a,Show a,Show b,Show e)+  => (e -> a -> b) -> (e -> b -> Maybe a) -> e -> a -> Result propEncodeDecodeIsoSettings f g e a =   let fa = f e a       gfa = g e fa@@ -183,14 +193,19 @@           , "g(f(x)): ", show gfa, "\n"           ] +parseMatch :: (Eq a, Show a) => Atto.Parser a -> Text -> a -> Assertion+parseMatch p t expected = do+  Atto.parseOnly (p <* Atto.endOfInput) t+  @?= Right expected+ timeOfDayParse :: Maybe Char -> Text -> TimeOfDay -> Assertion timeOfDayParse m t expected =   Atto.parseOnly (TimeOfDayText.parser_HMS m <* Atto.endOfInput) t   @?= Right expected -timeOfDayBuilder :: Maybe Char -> Text -> TimeOfDay -> Assertion-timeOfDayBuilder m expected tod =-  LText.toStrict (Builder.toLazyText (TimeOfDayText.builder_HMS m tod))+timeOfDayBuilder :: SubsecondPrecision -> Maybe Char -> Text -> TimeOfDay -> Assertion+timeOfDayBuilder sp m expected tod =+  LText.toStrict (Builder.toLazyText (TimeOfDayText.builder_HMS sp m tod))   @?= expected  dateParse :: Maybe Char -> Text -> Date -> Assertion@@ -232,10 +247,10 @@     <$> arbitrary     <*> arbitrary -instance Arbitrary a => Arbitrary (DatetimeFormat a) where+instance (Arbitrary a, a ~ Char) => Arbitrary (DatetimeFormat a) where   arbitrary = DatetimeFormat     <$> arbitrary-    <*> arbitrary+    <*> elements [Nothing, Just '/', Just ':', Just '-']     <*> arbitrary  instance Arbitrary OffsetFormat where