packages feed

chronos (empty) → 0.1.0

raw patch · 22 files changed

+1622/−0 lines, 22 filesdep +HUnitdep +QuickCheckdep +aesonsetup-changed

Dependencies added: HUnit, QuickCheck, aeson, attoparsec, base, bytestring, chronos, hashable, primitive, test-framework, test-framework-hunit, test-framework-quickcheck2, text, vector

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Andrew Martin (c) 2016++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Andrew Martin nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ chronos.cabal view
@@ -0,0 +1,69 @@+name:                chronos+version:             0.1.0+synopsis:            Initial project template from stack+description:         Please see README.md+homepage:            https://github.com/andrewthad/chronos#readme+license:             BSD3+license-file:        LICENSE+author:              Andrew Martin+maintainer:          andrew.thaddeus@gmail.com+copyright:           2016 Andrew Martin+category:            web+build-type:          Simple+-- extra-source-files:+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:+      Lib+    , Chronos.Types+    , Chronos.Calendar+    , Chronos.Match+    , Chronos.Nanoseconds+    , Chronos.Day+    , Chronos.Date.Text+    , Chronos.Datetime.Text+    , Chronos.OffsetDatetime.Text+    , Chronos.TimeOfDay.Text+    , Chronos.Internal+    , Chronos.Internal.Format+    , Chronos.Internal.Conversion+    , Chronos.Internal.CTimespec+    , Chronos.Tai+    , Chronos.Posix+    , Chronos.Month+    , Chronos.Locale.English.Text+    -- , Chronos.Calendar.Text+  build-depends:+      base >= 4.7 && < 5+    , vector+    , text+    , bytestring+    , attoparsec+    , aeson+    , hashable+    , primitive+  default-language:    Haskell2010++test-suite chronos-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:+      base+    , chronos+    , text+    , bytestring+    , attoparsec+    , test-framework+    , test-framework-quickcheck2+    , QuickCheck+    , HUnit+    , test-framework-hunit+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/andrewthad/chronos
+ src/Chronos/Calendar.hs view
@@ -0,0 +1,106 @@+module Chronos.Calendar+  ( -- * Enumerations+    months+  , weekdays+    -- * Pattern Matching+  , month+  , dayOfWeek+    -- * Days of Week+  , sunday+  , monday+  , tuesday+  , wednesday+  , thursday+  , friday+  , saturday+    -- * Months+  , january+  , february+  , march+  , april+  , may+  , june+  , july+  , august+  , september+  , october+  , november+  , december+  ) where++import Chronos.Types+import qualified Data.Vector as Vector++month :: a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> Month -> a+month a b c d e f g h i j k l =+  let v = Vector.fromList [a,b,c,d,e,f,g,h,i,j,k,l]+   in \(Month ix) -> Vector.unsafeIndex v (fromIntegral ix)++dayOfWeek :: a -> a -> a -> a -> a -> a -> a -> DayOfWeek -> a+dayOfWeek a b c d e f g =+  let v = Vector.fromList [a,b,c,d,e,f,g]+   in \(DayOfWeek ix) -> Vector.unsafeIndex v (fromIntegral ix)++months :: [Month]+months = map Month [0..11]++weekdays :: [DayOfWeek]+weekdays = map DayOfWeek [0..6]++january :: Month+january = Month 0++february :: Month+february = Month 1++march :: Month+march = Month 2++april :: Month+april = Month 3++may :: Month+may = Month 4++june :: Month+june = Month 5++july :: Month+july = Month 6++august :: Month+august = Month 7++september :: Month+september = Month 8++october :: Month+october = Month 9++november :: Month+november = Month 10++december :: Month+december = Month 11++sunday :: DayOfWeek+sunday = DayOfWeek 0++monday :: DayOfWeek+monday = DayOfWeek 1++tuesday :: DayOfWeek+tuesday = DayOfWeek 2++wednesday :: DayOfWeek+wednesday = DayOfWeek 3++thursday :: DayOfWeek+thursday = DayOfWeek 4++friday :: DayOfWeek+friday = DayOfWeek 5++saturday :: DayOfWeek+saturday = DayOfWeek 6+
+ src/Chronos/Date/Text.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE OverloadedStrings #-}++module Chronos.Date.Text where++import Chronos.Types+import Data.Text (Text)+import Data.Text.Lazy.Builder (Builder)+import Data.Vector (Vector)+import Data.Monoid+import Data.Attoparsec.Text (Parser)+import Control.Monad+import Data.Foldable+import qualified Chronos.Internal.Format as Format+import qualified Chronos.Internal as I+import qualified Data.Text as Text+import qualified Data.Text.Read as Text+import qualified Data.Attoparsec.Text as Atto+import qualified Data.Vector as Vector+import qualified Data.Text.Lazy.Builder as Builder+import qualified Data.Text.Lazy.Builder.Int as Builder++-- | This could be written much more efficiently since we know the+--   exact size the resulting 'Text' will be.+builder_Ymd :: Maybe Char -> Date -> Builder+builder_Ymd msep (Date (Year y) m d) = case msep of+  Nothing ->+       Builder.decimal y+    <> Format.monthToZeroPaddedDigit m+    <> Format.zeroPadDayOfMonth d+  Just sep -> let sepBuilder = Builder.singleton sep in+       Builder.decimal y+    <> sepBuilder+    <> Format.monthToZeroPaddedDigit m+    <> sepBuilder+    <> Format.zeroPadDayOfMonth d++parser_Ymd :: Maybe Char -> Parser Date+parser_Ymd msep = do+  y <- I.parseFixedDigits 4+  traverse_ Atto.char msep+  m <- I.parseFixedDigits 2+  when (m < 1 || m > 12) (fail "month must be between 1 and 12")+  traverse_ Atto.char msep+  d <- I.parseFixedDigits 2+  when (d < 1 || d > 31) (fail "day must be between 1 and 31")+  return (Date (Year y) (Month $ m - 1) (DayOfMonth d))++
+ src/Chronos/Datetime/Text.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE OverloadedStrings #-}++module Chronos.Datetime.Text where++import Chronos.Types+import Data.Text (Text)+import Data.Text.Lazy.Builder (Builder)+import Data.Vector (Vector)+import Data.Monoid+import Data.Attoparsec.Text (Parser)+import Control.Monad+import Data.Foldable+import qualified Chronos.Date.Text as Date+import qualified Chronos.TimeOfDay.Text as TimeOfDay+import qualified Data.Text as Text+import qualified Data.Text.Read as Text+import qualified Data.Attoparsec.Text as Atto+import qualified Data.Vector as Vector+import qualified Data.Text.Lazy as LText+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++-- | 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) =+  case msep of+    Nothing -> Date.builder_Ymd mdateSep date+            <> TimeOfDay.builder_HMS mtimeSep time+    Just sep -> Date.builder_Ymd mdateSep date+             <> Builder.singleton sep+             <> TimeOfDay.builder_HMS mtimeSep time++builder_YmdIMS_p :: MeridiemLocale Text -> DatetimeFormat Char -> Datetime -> Builder+builder_YmdIMS_p locale (DatetimeFormat mdateSep msep mtimeSep) (Datetime date time) =+     Date.builder_Ymd mdateSep date+  <> maybe mempty Builder.singleton msep+  <> TimeOfDay.builder_IMS_p locale mtimeSep time++builderW3 :: Datetime -> Builder+builderW3 = builder_YmdHMS (DatetimeFormat (Just '-') (Just 'T') (Just ':'))++decode_YmdHMS :: DatetimeFormat Char -> Text -> Maybe Datetime+decode_YmdHMS format =+  either (const Nothing) Just . Atto.parseOnly (parser_YmdHMS format)++parser_YmdHMS :: DatetimeFormat Char -> Parser Datetime+parser_YmdHMS (DatetimeFormat mdateSep msep mtimeSep) = do+  date <- Date.parser_Ymd mdateSep+  traverse_ Atto.char msep+  time <- TimeOfDay.parser_HMS mtimeSep+  return (Datetime date time)+
+ src/Chronos/Day.hs view
@@ -0,0 +1,11 @@+module Chronos.Day where++import Chronos.Types+import Data.Int++add :: Int32 -> Day -> Day+add a (Day b) = Day (a + b)++diff :: Day -> Day -> Int32+diff (Day a) (Day b) = a - b+
+ src/Chronos/Internal.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Chronos.Internal where++import Data.Attoparsec.Text (Parser)+import Data.Vector (Vector)+import Data.Text.Lazy.Builder (Builder)+import Data.Word+import Data.Int+import qualified Data.Vector.Unboxed as UVector+import qualified Data.Attoparsec.Text as Atto+import qualified Data.Text.Lazy.Builder as Builder+import qualified Data.Text.Lazy.Builder.Int as Builder+import qualified Data.Text.Read as Text+import qualified Data.Text as Text+import qualified Data.Vector as Vector++parseFixedDigits :: Integral i => Int -> Parser i+parseFixedDigits n = do+  t <- Atto.take n+  case Text.decimal t of+    Left err -> fail err+    Right (i,r) -> if Text.null r+      then return i+      else fail "datetime decoding could not parse integral"++raiseTenTo :: Int -> Int64+raiseTenTo i = if i > 15+  then 10 ^ i+  else UVector.unsafeIndex tenRaisedToSmallPowers i++tenRaisedToSmallPowers :: UVector.Vector Int64+tenRaisedToSmallPowers = UVector.fromList $ map (10 ^) [0 :: Int ..15]++-- | Only provide positive numbers to this function.+indexTwoDigitTextBuilder :: Integral i => i -> Builder+indexTwoDigitTextBuilder i = if i < 100+  then Vector.unsafeIndex twoDigitTextBuilder (fromIntegral i)+  else Builder.decimal i+{-# INLINE indexTwoDigitTextBuilder #-}++twoDigitTextBuilder :: Vector Builder+twoDigitTextBuilder = Vector.fromList $ map Builder.fromText+  [ "00","01","02","03","04","05","06","07","08","09"+  , "10","11","12","13","14","15","16","17","18","19"+  , "20","21","22","23","24","25","26","27","28","29"+  , "30","31","32","33","34","35","36","37","38","39"+  , "40","41","42","43","44","45","46","47","48","49"+  , "50","51","52","53","54","55","56","57","58","59"+  , "60","61","62","63","64","65","66","67","68","69"+  , "70","71","72","73","74","75","76","77","78","79"+  , "80","81","82","83","84","85","86","87","88","89"+  , "90","91","92","93","94","95","96","97","98","99"+  ]+{-# NOINLINE twoDigitTextBuilder #-}++countDigits :: (Integral a) => a -> Int+{-# INLINE countDigits #-}+countDigits v0+  | fromIntegral v64 == v0 = go 1 v64+  | otherwise              = goBig 1 (fromIntegral v0)+  where v64 = fromIntegral v0+        goBig !k (v :: Integer)+           | v > big   = goBig (k + 19) (v `quot` big)+           | otherwise = go k (fromIntegral v)+        big = 10000000000000000000+        go !k (v :: Word64)+           | v < 10    = k+           | v < 100   = k + 1+           | v < 1000  = k + 2+           | v < 1000000000000 =+               k + if v < 100000000+                   then if v < 1000000+                        then if v < 10000+                             then 3+                             else 4 + fin v 100000+                        else 6 + fin v 10000000+                   else if v < 10000000000+                        then 8 + fin v 1000000000+                        else 10 + fin v 100000000000+           | otherwise = go (k + 12) (v `quot` 1000000000000)+        fin v n = if v >= n then 1 else 0++clip :: (Ord t) => t -> t -> t -> t+clip a _ x | x < a = a+clip _ b x | x > b = b+clip _ _ x = x+
+ src/Chronos/Internal/CTimespec.hs view
@@ -0,0 +1,30 @@+module Chronos.Internal.CTimespec where++import Foreign+import Foreign.C++data CTimespec = MkCTimespec CTime 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+        (\hsc_ptr -> pokeByteOff hsc_ptr 0) p s+        (\hsc_ptr -> pokeByteOff hsc_ptr 8) p ns++foreign import ccall unsafe "time.h clock_gettime"+    clock_gettime :: Int32 -> Ptr CTimespec -> IO CInt++-- | Get the current POSIX time from the system clock.+getCTimespec :: IO CTimespec+getCTimespec = alloca (\ptspec -> do+    throwErrnoIfMinus1_ "clock_gettime" $+        clock_gettime 0 ptspec+    peek ptspec+    )++
+ src/Chronos/Internal/Conversion.hs view
@@ -0,0 +1,211 @@+{-# LANGUAGE BangPatterns #-}++module Chronos.Internal.Conversion where++import Chronos.Types+import Data.Word+import Data.Int+import qualified Chronos.Internal as I+import qualified Data.Vector as Vector+import qualified Data.Vector.Unboxed as UVector++dayLengthWord64 :: Word64+dayLengthWord64 = 86400000000000++nanosecondsInMinute :: Word64+nanosecondsInMinute = 60000000000++-- | The first argument in the resulting tuple in a day+--   adjustment. It should be either -1, 0, or 1, as no+--   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)+  where+  (!dayAdjustment, !h'') = divMod h' 24+  (!hourAdjustment, !m'') = divMod m' 60+  m' = (fromIntegral m :: Int16) + offset+  h' = fromIntegral h + hourAdjustment++nanosecondsSinceMidnightToTimeOfDay :: Word64 -> TimeOfDay+nanosecondsSinceMidnightToTimeOfDay ns =+  if ns >= dayLengthWord64+    then TimeOfDay 23 59 (nanosecondsInMinute + (ns - dayLengthWord64))+    else TimeOfDay (fromIntegral h') (fromIntegral m') ns'+  where+  (!m,!ns') = quotRem ns nanosecondsInMinute+  (!h',!m')  = quotRem m 60++timeOfDayToNanosecondsSinceMidnight :: TimeOfDay -> Word64+timeOfDayToNanosecondsSinceMidnight (TimeOfDay h m ns) =+  fromIntegral h * 3600000000000 + fromIntegral m * 60000000000 + ns++dayToDate :: Day -> Date+dayToDate day = Date year month dayOfMonth+  where+  OrdinalDate year yd = dayToOrdinalDate day+  MonthDate month dayOfMonth = dayOfYearToMonthAndDay (isLeapYear year) yd++utcTimeToOffsetDatetime :: Offset -> UtcTime -> OffsetDatetime+utcTimeToOffsetDatetime offset (UtcTime (Day d) nanoseconds) =+  let (!(Days dayAdjustment),!tod) = offsetTimeOfDay offset (nanosecondsSinceMidnightToTimeOfDay nanoseconds)+      !date = dayToDate (Day (d + dayAdjustment))+   in OffsetDatetime (Datetime date tod) offset++utcTimeToDatetime :: UtcTime -> Datetime+utcTimeToDatetime (UtcTime d nanoseconds) =+  let !tod = nanosecondsSinceMidnightToTimeOfDay nanoseconds+      !date = dayToDate d+   in Datetime date tod++datetimeToUtcTime :: Datetime -> UtcTime+datetimeToUtcTime (Datetime date timeOfDay) =+  UtcTime (dateToDay date) (timeOfDayToNanosecondsSinceMidnight timeOfDay)++offsetDatetimeToUtcTime :: OffsetDatetime -> UtcTime+offsetDatetimeToUtcTime (OffsetDatetime (Datetime date timeOfDay) (Offset off)) =+  let (!(Days !dayAdjustment),!tod) =+        offsetTimeOfDay (Offset $ negate off) timeOfDay+      !(Day !day) = dateToDay date+   in UtcTime+        (Day (day + dayAdjustment))+        (timeOfDayToNanosecondsSinceMidnight tod)++dateToDay :: Date -> Day+dateToDay (Date y m d) = ordinalDateToDay $ OrdinalDate y+  (monthDateToDayOfYear (isLeapYear y) (MonthDate m d))++monthDateToDayOfYear :: Bool -> MonthDate -> DayOfYear+monthDateToDayOfYear isLeap (MonthDate month@(Month m) (DayOfMonth dayOfMonth)) =+  DayOfYear ((div (367 * (fromIntegral m + 1) - 362) 12) + k + day')+  where+  day' = fromIntegral $ I.clip 1 (monthLength isLeap month) dayOfMonth+  k = if month < Month 2 then 0 else if isLeap then -1 else -2++ordinalDateToDay :: OrdinalDate -> Day+ordinalDateToDay (OrdinalDate year@(Year y') day) = Day mjd where+  y = y' - 1+  mjd = (fromIntegral . getDayOfYear $+           (I.clip (DayOfYear 1) (if isLeapYear year then DayOfYear 366 else DayOfYear 365) day)+        )+      + (365 * y)+      + (div y 4) - (div y 100)+      + (div y 400) - 678576++isLeapYear :: Year -> Bool+isLeapYear (Year year) = (mod year 4 == 0) && ((mod year 400 == 0) || not (mod year 100 == 0))++dayOfYearToMonthAndDay :: Bool -> DayOfYear -> MonthDate+dayOfYearToMonthAndDay isLeap dayOfYear =+  let (!upperBound,!monthTable,!dayTable) =+        if isLeap+          then (DayOfYear 366, leapYearDayOfYearMonthTable, leapYearDayOfYearDayOfMonthTable)+          else (DayOfYear 365, normalYearDayOfYearMonthTable, normalYearDayOfYearDayOfMonthTable)+      DayOfYear clippedDay = I.clip (DayOfYear 1) upperBound dayOfYear+      clippedDayInt = fromIntegral clippedDay :: Int+      month = UVector.unsafeIndex monthTable clippedDayInt+      day = UVector.unsafeIndex dayTable clippedDayInt+   in MonthDate month day++dayToOrdinalDate :: Day -> OrdinalDate+dayToOrdinalDate (Day mjd) = OrdinalDate (Year $ fromIntegral year) (DayOfYear $ fromIntegral yd) where+  a = (fromIntegral mjd :: Int64) + 678575+  quadcent = div a 146097+  b = mod a 146097+  cent = min (div b 36524) 3+  c = b - (cent * 36524)+  quad = div c 1461+  d = mod c 1461+  y = min (div d 365) 3+  yd = (d - (y * 365) + 1)+  year = quadcent * 400 + cent * 100 + quad * 4 + y + 1++internalBuildDayOfWeekMatch :: a -> a -> a -> a -> a -> a -> a -> DayOfWeekMatch a+internalBuildDayOfWeekMatch a b c d e f g =+  DayOfWeekMatch (Vector.fromList [a,b,c,d,e,f,g])++internalBuildMonthMatch :: a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> MonthMatch a+internalBuildMonthMatch a b c d e f g h i j k l =+  MonthMatch (Vector.fromList [a,b,c,d,e,f,g,h,i,j,k,l])++internalMatchMonth :: MonthMatch a -> Month -> a+internalMatchMonth (MonthMatch v) (Month ix) = Vector.unsafeIndex v (fromIntegral ix)++monthLength :: Bool -> Month -> Word8+monthLength isLeap m = if isLeap+  then internalMatchMonth leapYearMonthLength m+  else internalMatchMonth leapYearMonthLength m++leapYearMonthLength :: MonthMatch Word8+leapYearMonthLength = internalBuildMonthMatch 31 29 31 30 31 30 31 31 30 31 30 31++normalYearMonthLength :: MonthMatch Word8+normalYearMonthLength = internalBuildMonthMatch 31 30 31 30 31 30 31 31 30 31 30 31++leapYearDayOfYearDayOfMonthTable :: UVector.Vector DayOfMonth+leapYearDayOfYearDayOfMonthTable = UVector.fromList $ (DayOfMonth 1:) $ concat+  [ enumFromTo (DayOfMonth 1) (DayOfMonth 31)+  , enumFromTo (DayOfMonth 1) (DayOfMonth 29)+  , enumFromTo (DayOfMonth 1) (DayOfMonth 31)+  , enumFromTo (DayOfMonth 1) (DayOfMonth 30)+  , enumFromTo (DayOfMonth 1) (DayOfMonth 31)+  , enumFromTo (DayOfMonth 1) (DayOfMonth 30)+  , enumFromTo (DayOfMonth 1) (DayOfMonth 31)+  , enumFromTo (DayOfMonth 1) (DayOfMonth 31)+  , enumFromTo (DayOfMonth 1) (DayOfMonth 30)+  , enumFromTo (DayOfMonth 1) (DayOfMonth 31)+  , enumFromTo (DayOfMonth 1) (DayOfMonth 30)+  , enumFromTo (DayOfMonth 1) (DayOfMonth 31)+  ]+{-# NOINLINE leapYearDayOfYearDayOfMonthTable #-}++normalYearDayOfYearDayOfMonthTable :: UVector.Vector DayOfMonth+normalYearDayOfYearDayOfMonthTable = UVector.fromList $ (DayOfMonth 1:) $concat+  [ enumFromTo (DayOfMonth 1) (DayOfMonth 31)+  , enumFromTo (DayOfMonth 1) (DayOfMonth 28)+  , enumFromTo (DayOfMonth 1) (DayOfMonth 31)+  , enumFromTo (DayOfMonth 1) (DayOfMonth 30)+  , enumFromTo (DayOfMonth 1) (DayOfMonth 31)+  , enumFromTo (DayOfMonth 1) (DayOfMonth 30)+  , enumFromTo (DayOfMonth 1) (DayOfMonth 31)+  , enumFromTo (DayOfMonth 1) (DayOfMonth 31)+  , enumFromTo (DayOfMonth 1) (DayOfMonth 30)+  , enumFromTo (DayOfMonth 1) (DayOfMonth 31)+  , enumFromTo (DayOfMonth 1) (DayOfMonth 30)+  , enumFromTo (DayOfMonth 1) (DayOfMonth 31)+  ]+{-# NOINLINE normalYearDayOfYearDayOfMonthTable #-}++leapYearDayOfYearMonthTable :: UVector.Vector Month+leapYearDayOfYearMonthTable = UVector.fromList $ (Month 0:) $ concat+  [ replicate 31 (Month 0)+  , replicate 29 (Month 1)+  , replicate 31 (Month 2)+  , replicate 30 (Month 3)+  , replicate 31 (Month 4)+  , replicate 30 (Month 5)+  , replicate 31 (Month 6)+  , replicate 31 (Month 7)+  , replicate 30 (Month 8)+  , replicate 31 (Month 9)+  , replicate 30 (Month 10)+  , replicate 31 (Month 11)+  ]+{-# NOINLINE leapYearDayOfYearMonthTable #-}++normalYearDayOfYearMonthTable :: UVector.Vector Month+normalYearDayOfYearMonthTable = UVector.fromList $ (Month 0:) $ concat+  [ replicate 31 (Month 0)+  , replicate 28 (Month 1)+  , replicate 31 (Month 2)+  , replicate 30 (Month 3)+  , replicate 31 (Month 4)+  , replicate 30 (Month 5)+  , replicate 31 (Month 6)+  , replicate 31 (Month 7)+  , replicate 30 (Month 8)+  , replicate 31 (Month 9)+  , replicate 30 (Month 10)+  , replicate 31 (Month 11)+  ]+{-# NOINLINE normalYearDayOfYearMonthTable #-}
+ src/Chronos/Internal/Format.hs view
@@ -0,0 +1,25 @@+module Chronos.Internal.Format where++import Chronos.Types+import Data.Text (Text)+import Data.Text.Lazy.Builder (Builder)+import Data.Vector (Vector)+import Data.Monoid+import Data.Attoparsec.Text (Parser)+import Control.Monad+import Data.Foldable+import qualified Chronos.Internal as I+import qualified Data.Text as Text+import qualified Data.Text.Read as Text+import qualified Data.Attoparsec.Text as Atto+import qualified Data.Vector as Vector+import qualified Data.Text.Lazy.Builder as Builder+import qualified Data.Text.Lazy.Builder.Int as Builder++monthToZeroPaddedDigit :: Month -> Builder+monthToZeroPaddedDigit (Month x) =+  I.indexTwoDigitTextBuilder (x + 1)++zeroPadDayOfMonth :: DayOfMonth -> Builder+zeroPadDayOfMonth (DayOfMonth d) = I.indexTwoDigitTextBuilder d+
+ src/Chronos/Locale/English/Text.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE OverloadedStrings #-}++module Chronos.Locale.English.Text where++import Chronos.Types+import qualified Chronos.Month as Month+import Data.Text (Text)++meridiemLower :: MeridiemLocale Text+meridiemLower = MeridiemLocale "am" "pm"++meridiemUpper :: MeridiemLocale Text+meridiemUpper = MeridiemLocale "AM" "PM"++meridiemLowerDotted :: MeridiemLocale Text+meridiemLowerDotted = MeridiemLocale "a.m." "p.m."++meridiemUpperDotted :: MeridiemLocale Text+meridiemUpperDotted = MeridiemLocale "A.M." "P.M."++monthFull :: MonthMatch Text+monthFull = Month.match+  "January" "February" "March" "April"+  "May" "June" "July" "August"+  "September" "October" "November" "December"++monthAbbreviated :: MonthMatch Text+monthAbbreviated = Month.match+  "Jan" "Feb" "Mar" "Apr" "May" "Jun"+  "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"+
+ src/Chronos/Match.hs view
@@ -0,0 +1,15 @@+module Chronos.Match where++import Chronos.Types+import qualified Data.Vector as Vector++buildDayOfWeekMatch :: a -> a -> a -> a -> a -> a -> a -> DayOfWeekMatch a+buildDayOfWeekMatch a b c d e f g =+  DayOfWeekMatch (Vector.fromList [a,b,c,d,e,f,g])++buildMonthMatch :: a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> MonthMatch a+buildMonthMatch a b c d e f g h i j k l =+  MonthMatch (Vector.fromList [a,b,c,d,e,f,g,h,i,j,k,l])+++
+ src/Chronos/Month.hs view
@@ -0,0 +1,16 @@+module Chronos.Month where++import Chronos.Types+import qualified Chronos.Internal.Conversion as Conv++month :: a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> Month -> a+month a b c d e f g h i j k l =+  let theMatch = match a b c d e f g h i j k l+   in \m -> deconstruct theMatch m++match :: a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> MonthMatch a+match = Conv.internalBuildMonthMatch++deconstruct :: MonthMatch a -> Month -> a+deconstruct = Conv.internalMatchMonth+
+ src/Chronos/Nanoseconds.hs view
@@ -0,0 +1,11 @@+module Chronos.Nanoseconds where++import Data.Int+import Chronos.Types++add :: Nanoseconds -> Nanoseconds -> Nanoseconds+add (Nanoseconds a) (Nanoseconds b) = Nanoseconds (a + b)++scale :: Int64 -> Nanoseconds -> Nanoseconds+scale i (Nanoseconds x) = Nanoseconds (i * x)+
+ src/Chronos/OffsetDatetime/Text.hs view
@@ -0,0 +1,163 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE BangPatterns #-}++-- | The naming conventions for offsets that are used in+--   function names are as follows:+--+--   * @%z@ - @z@ +hhmm numeric time zone (e.g., -0400)+--   * @%:z@ - @z1@ +hh:mm numeric time zone (e.g., -04:00)+--   * @%::z@ - @z2@ +hh:mm:ss numeric time zone (e.g., -04:00:00)+--   * @%:::z@ - @z3@ numeric time zone with : to necessary precision (e.g., -04, +05:30)++module Chronos.OffsetDatetime.Text where++import Chronos.Types+import Data.Text (Text)+import Data.Text.Lazy.Builder (Builder)+import Data.Vector (Vector)+import Data.Monoid+import Data.Attoparsec.Text (Parser)+import Control.Monad+import Data.Foldable+import Data.Int+import qualified Chronos.Internal as I+import qualified Chronos.Datetime.Text as Datetime+import qualified Chronos.TimeOfDay.Text as TimeOfDay+import qualified Data.Text as Text+import qualified Data.Text.Read as Text+import qualified Data.Attoparsec.Text as Atto+import qualified Data.Vector as Vector+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+  <> offsetBuilder offsetFormat offset++parser_YmdHMSz :: OffsetFormat -> DatetimeFormat Char -> Parser OffsetDatetime+parser_YmdHMSz offsetFormat datetimeFormat = OffsetDatetime+  <$> Datetime.parser_YmdHMS datetimeFormat+  <*> offsetParser offsetFormat++builderW3 :: OffsetDatetime -> Builder+builderW3 = builder_YmdHMSz+  OffsetFormatColonOn+  (DatetimeFormat (Just '-') (Just 'T') (Just ':'))++offsetBuilder :: OffsetFormat -> Offset -> Builder+offsetBuilder x = case x of+  OffsetFormatColonOff -> buildOffset_z+  OffsetFormatColonOn -> buildOffset_z1+  OffsetFormatSecondsPrecision -> buildOffset_z2+  OffsetFormatColonAuto -> buildOffset_z3++offsetParser :: OffsetFormat -> Parser Offset+offsetParser x = case x of+  OffsetFormatColonOff -> parseOffset_z+  OffsetFormatColonOn -> parseOffset_z1+  OffsetFormatSecondsPrecision -> parseOffset_z2+  OffsetFormatColonAuto -> parseOffset_z3++-- | True means positive, false means negative+parseSignedness :: Parser Bool+parseSignedness = do+  c <- Atto.anyChar+  if c == '-'+    then return False+    else if c == '+'+      then return True+      else fail "while parsing offset, expected [+] or [-]"+{-# INLINE parseSignedness #-}++parseOffset_z :: Parser Offset+parseOffset_z = do+  pos <- parseSignedness+  h <- I.parseFixedDigits 2+  m <- I.parseFixedDigits 2+  let !res = h * 60 + m+  return . Offset $ if pos+    then res+    else negate res++parseOffset_z1 :: Parser Offset+parseOffset_z1 = do+  pos <- parseSignedness+  h <- I.parseFixedDigits 2+  _ <- Atto.char ':'+  m <- I.parseFixedDigits 2+  let !res = h * 60 + m+  return . Offset $ if pos+    then res+    else negate res++parseOffset_z2 :: Parser Offset+parseOffset_z2 = do+  pos <- parseSignedness+  h <- I.parseFixedDigits 2+  _ <- Atto.char ':'+  m <- I.parseFixedDigits 2+  _ <- Atto.string ":00"+  let !res = h * 60 + m+  return . Offset $ if pos+    then res+    else negate res++-- | This is generous in what it accepts. If you give+--   something like +04:00 as the offset, it will be+--   allowed, even though it could be shorter.+parseOffset_z3 :: Parser Offset+parseOffset_z3 = do+  pos <- parseSignedness+  h <- I.parseFixedDigits 2+  mc <- Atto.peekChar+  case mc of+    Just ':' -> do+      _ <- Atto.anyChar -- should be a colon+      m <- I.parseFixedDigits 2+      let !res = h * 60 + m+      return . Offset $ if pos+        then res+        else negate res+    _ -> return . Offset $ if pos+      then h * 60+      else h * (-60)++buildOffset_z :: Offset -> Builder+buildOffset_z (Offset i) =+  let (!a,!b) = divMod (abs i) 60+      !prefix = if signum i == (-1) then "-" else "+"+   in prefix+      <> I.indexTwoDigitTextBuilder a+      <> I.indexTwoDigitTextBuilder b++buildOffset_z1 :: Offset -> Builder+buildOffset_z1 (Offset i) =+  let (!a,!b) = divMod (abs i) 60+      !prefix = if signum i == (-1) then "-" else "+"+   in prefix+      <> I.indexTwoDigitTextBuilder a+      <> ":"+      <> I.indexTwoDigitTextBuilder b++buildOffset_z2 :: Offset -> Builder+buildOffset_z2 (Offset i) =+  let (!a,!b) = divMod (abs i) 60+      !prefix = if signum i == (-1) then "-" else "+"+   in prefix+      <> I.indexTwoDigitTextBuilder a+      <> ":"+      <> I.indexTwoDigitTextBuilder b+      <> ":00"++buildOffset_z3 :: Offset -> Builder+buildOffset_z3 (Offset i) =+  let (!a,!b) = divMod (abs i) 60+      !prefix = if signum i == (-1) then "-" else "+"+   in if b == 0+        then prefix+          <> I.indexTwoDigitTextBuilder a+        else prefix+          <> I.indexTwoDigitTextBuilder a+          <> ":"+          <> I.indexTwoDigitTextBuilder b
+ src/Chronos/Posix.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE BangPatterns #-}++module Chronos.Posix+  ( epoch+  , epochDay+  , dayLength+  , add+  , diff+  , now+  , toUtc+  , fromUtc+  , toDatetime+  , toOffsetDatetime+  , fromDatetime+  , fromOffsetDatetime+  , truncateToDay+  ) where++import Chronos.Types+import Chronos.Internal.CTimespec+import Chronos.Internal.Conversion as Conv+import Foreign.C.Types (CLong(..),CTime(..))+import Data.Word+import Data.Int+import qualified Chronos.Day as Day+import qualified Chronos.Nanoseconds as Nanoseconds++epoch :: PosixTime+epoch = PosixTime 0++epochDay :: Day+epochDay = Day 40587++dayLength :: Nanoseconds+dayLength = Nanoseconds 86400000000000++add :: Nanoseconds -> PosixTime -> PosixTime+add (Nanoseconds a) (PosixTime b) = PosixTime (a + b)++diff :: PosixTime -> PosixTime -> Nanoseconds+diff (PosixTime a) (PosixTime b) = Nanoseconds (a - b)++-- | This probably needs to be wrapped in a bunch of CPP like+--   the one in @time@ is.+now :: IO PosixTime+now = fmap ctimespecToPosixSeconds getCTimespec++-- | This may be wrong for dates before what we count as the+--   first modified julian day.+toUtc :: PosixTime -> UtcTime+toUtc (PosixTime i) = let (d,t) = divMod i (getNanoseconds dayLength)+ in UtcTime (Day.add (fromIntegral d) epochDay) (fromIntegral t)++fromUtc :: UtcTime -> PosixTime+fromUtc (UtcTime d ns') = PosixTime $ getNanoseconds $ Nanoseconds.add+  (Nanoseconds.scale (fromIntegral (Day.diff d epochDay)) dayLength)+  (if ns > dayLength then dayLength else ns)+  where ns = Nanoseconds (fromIntegral ns')++toDatetime :: PosixTime -> Datetime+toDatetime = Conv.utcTimeToDatetime . toUtc++toOffsetDatetime :: Offset -> PosixTime -> OffsetDatetime+toOffsetDatetime offset = Conv.utcTimeToOffsetDatetime offset . toUtc++fromDatetime :: Datetime -> PosixTime+fromDatetime = fromUtc . Conv.datetimeToUtcTime++fromOffsetDatetime :: OffsetDatetime -> PosixTime+fromOffsetDatetime = fromUtc . Conv.offsetDatetimeToUtcTime++truncateToDay :: PosixTime -> Day+truncateToDay (PosixTime i) = Day (fromIntegral (div i 86400000000000))++-- | Convert a 'PosixTime' to a UTC 'Datetime'.+-- toDatetime :: PosixTime -> Datetime+-- 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)+
+ src/Chronos/Tai.hs view
@@ -0,0 +1,13 @@+module Chronos.Tai where++import Chronos.Types++epoch :: TaiTime+epoch = TaiTime 0++add :: Nanoseconds -> TaiTime -> TaiTime+add (Nanoseconds a) (TaiTime b) = TaiTime (a + b)++diff :: TaiTime -> TaiTime -> Nanoseconds+diff (TaiTime a) (TaiTime b) = Nanoseconds (a - b)+
+ src/Chronos/TimeOfDay/Text.hs view
@@ -0,0 +1,112 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE BangPatterns #-}++module Chronos.TimeOfDay.Text where++import Chronos.Types+import Data.Text (Text)+import Data.Text.Lazy.Builder (Builder)+import Data.Vector (Vector)+import Data.Monoid+import Data.Attoparsec.Text (Parser)+import Control.Monad+import Control.Applicative+import Data.Foldable+import Data.Word+import Data.Char (isDigit)+import qualified Chronos.Internal as I+import qualified Data.Text as Text+import qualified Data.Text.Read as Text+import qualified Data.Attoparsec.Text as Atto+import qualified Data.Vector as Vector+import qualified Data.Text.Lazy.Builder as Builder+import qualified Data.Text.Lazy.Builder.Int as Builder++-- | 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_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++parser_HMS :: Maybe Char -> Parser TimeOfDay+parser_HMS 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")+  traverse_ Atto.char msep+  s <- I.parseFixedDigits 2+  when (s > 60) (fail "seconds must be between 0 and 60")+  nanoseconds <-+    ( do _ <- Atto.char '.'+         numberOfZeroes <- countZeroes+         x <- Atto.decimal+         let totalDigits = I.countDigits x + numberOfZeroes+             result = if totalDigits == 9+               then x+               else if totalDigits < 9+                 then x * I.raiseTenTo (9 - totalDigits)+                 else quot x (I.raiseTenTo (totalDigits - 9))+         return (fromIntegral result)+    ) <|> return 0+  return (TimeOfDay h m (s * 1000000000 + nanoseconds))++countZeroes :: Parser Int+countZeroes = go 0 where+  go !i = do+    m <- Atto.peekChar+    case m of+      Nothing -> return i+      Just c -> if c == '0'+        then Atto.anyChar *> go (i + 1)+        else return i++microsecondsBuilder :: Word64 -> Builder+microsecondsBuilder w+  | w == 0 = mempty+  | w > 99999999 = "." <> Builder.decimal w+  | w > 9999999 = ".0" <> Builder.decimal w+  | w > 999999 = ".00" <> Builder.decimal w+  | w > 99999 = ".000" <> Builder.decimal w+  | w > 9999 = ".0000" <> Builder.decimal w+  | w > 999 = ".00000" <> Builder.decimal w+  | w > 99 = ".000000" <> Builder.decimal w+  | w > 9 = ".0000000" <> Builder.decimal w+  | otherwise = ".00000000" <> Builder.decimal w+
+ src/Chronos/Types.hs view
@@ -0,0 +1,244 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE DeriveGeneric #-}++module Chronos.Types where++import Data.Int+import Data.Word+import Data.Vector (Vector)+import Data.Aeson (FromJSON,ToJSON)+import Data.Hashable (Hashable)+import Data.Primitive+import Control.Monad+import GHC.Generics (Generic)+import qualified Data.Vector.Generic            as GVector+import qualified Data.Vector.Unboxed            as UVector+import qualified Data.Vector.Primitive          as PVector+import qualified Data.Vector.Generic.Mutable    as MGVector+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)++-- | A duration of days+newtype Days = Days { getDays :: Int32 }+  deriving (Show,Read,Eq,Ord)++newtype DayOfWeek = DayOfWeek { getDayOfWeek :: Word8 }++newtype DayOfMonth = DayOfMonth { getDayOfMonth :: Word8 }+  deriving (Show,Read,Eq,Ord,Prim,Enum)++newtype DayOfYear = DayOfYear { getDayOfYear :: Word16 }+  deriving (Show,Read,Eq,Ord,Prim)++newtype Month = Month { getMonth :: Word8 }+  deriving (Show,Read,Eq,Ord,Prim)++instance Bounded Month where+  minBound = Month 0+  maxBound = Month 11++newtype Year = Year { getYear :: Int32 }+  deriving (Show,Read,Eq,Ord)++newtype Offset = Offset { getOffset :: Int16 }+  deriving (Show,Read,Eq,Ord)++-- This is a Modified Julian Day.+-- newtype Date = Date { getDate :: Int32 }++-- | TAI time with nanosecond resolution.+newtype TaiTime = TaiTime { getTaiTime :: Int64 }+  deriving (FromJSON,ToJSON,Hashable,Eq,Ord,Show,Read)++-- | POSIX time with nanosecond resolution.+newtype PosixTime = PosixTime { getPosixTime :: Int64 }+  deriving (FromJSON,ToJSON,Hashable,Eq,Ord,Show,Read)++-- newtype Day = Day { getDay :: Word8 }+-- newtype Week = Week { getWeek :: Word8 }++newtype DayOfWeekMatch a = DayOfWeekMatch { getDayOfWeekMatch :: Vector a }++newtype MonthMatch a = MonthMatch { getMonthMatch :: Vector a }++newtype UnboxedMonthMatch a = UnboxedMonthMatch { getUnboxedMonthMatch :: UVector.Vector a }++newtype Nanoseconds = Nanoseconds { getNanoseconds :: Int64 }+  deriving (Show,Read,Eq,Ord)++-- | A date as represented by the Gregorian calendar.+data Date = Date+  { dateYear  :: !Year+  , dateMonth :: !Month+  , dateDay   :: !DayOfMonth+  } deriving (Show,Read,Eq,Ord)++data OrdinalDate = OrdinalDate+  { ordinalDateYear  :: !Year+  , ordinalDateMonth :: !DayOfYear+  } deriving (Show,Read,Eq,Ord)++data MonthDate = MonthDate+  { monthDateMonth :: !Month+  , monthDateDay   :: !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+  } deriving (Show,Read,Eq,Ord)++data OffsetDatetime = OffsetDatetime+  { offsetDatetimeDatetime :: !Datetime+  , offsetDatetimeOffset :: !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+  } deriving (Show,Read,Eq,Ord)++data UtcTime = UtcTime+  { utcTimeDate :: !Day+  , utcTimeNanoseconds :: !Word64+  } deriving (Show,Read,Eq,Ord)++data DatetimeFormat a = DatetimeFormat+  { datetimeFormatDateSeparator :: !(Maybe a)+    -- ^ Separator in the date+  , datetimeFormatSeparator:: !(Maybe a)+    -- ^ Separator between date and time+  , datetimeFormatTimeSeparator :: !(Maybe a)+    -- ^ Separator in the time+  } deriving (Show,Read,Eq,Ord)++data OffsetFormat+  = OffsetFormatColonOff -- ^ @%z@ (e.g., -0400)+  | OffsetFormatColonOn -- ^ @%:z@ (e.g., -04:00)+  | OffsetFormatSecondsPrecision -- ^ @%::z@ (e.g., -04:00:00)+  | OffsetFormatColonAuto -- ^ @%:::z@ (e.g., -04, +05:30)+  deriving (Show,Read,Eq,Ord,Enum,Bounded,Generic)++data DatetimeLocale a = DatetimeLocale+  { datetimeLocaleDaysOfWeekFull :: !(DayOfWeekMatch a)+    -- ^ full weekdays starting with Sunday, 7 elements+  , datetimeLocaleDaysOfWeekAbbreviated :: !(DayOfWeekMatch a)+    -- ^ abbreviated weekdays starting with Sunday, 7 elements+  , datetimeLocaleMonthsFull :: !(MonthMatch a)+    -- ^ full months starting with January, 12 elements+  , datetimeLocaleMonthsAbbreviated :: !(MonthMatch a)+    -- ^ abbreviated months starting with January, 12 elements+  , datetimeLocaleAm :: !a+    -- ^ Symbol for AM+  , datetimeLocalePm :: !a+    -- ^ Symbol for PM+  }++data MeridiemLocale a = MeridiemLocale+  { meridiemLocaleAm :: !a+  , meridiemLocalePm :: !a+  } deriving (Read,Show,Eq,Ord)++newtype instance UVector.MVector s Month = MV_Month (PVector.MVector s Month)+newtype instance UVector.Vector Month = V_Month (PVector.Vector Month)++instance UVector.Unbox Month++instance MGVector.MVector UVector.MVector Month where+  {-# INLINE basicLength #-}+  {-# INLINE basicUnsafeSlice #-}+  {-# INLINE basicOverlaps #-}+  {-# INLINE basicUnsafeNew #-}+  {-# INLINE basicInitialize #-}+  {-# INLINE basicUnsafeReplicate #-}+  {-# INLINE basicUnsafeRead #-}+  {-# INLINE basicUnsafeWrite #-}+  {-# INLINE basicClear #-}+  {-# INLINE basicSet #-}+  {-# INLINE basicUnsafeCopy #-}+  {-# INLINE basicUnsafeGrow #-}+  basicLength (MV_Month v) = MGVector.basicLength v+  basicUnsafeSlice i n (MV_Month v) = MV_Month $ MGVector.basicUnsafeSlice i n v+  basicOverlaps (MV_Month v1) (MV_Month v2) = MGVector.basicOverlaps v1 v2+  basicUnsafeNew n = MV_Month `liftM` MGVector.basicUnsafeNew n+  basicInitialize (MV_Month v) = MGVector.basicInitialize v+  basicUnsafeReplicate n x = MV_Month `liftM` MGVector.basicUnsafeReplicate n x+  basicUnsafeRead (MV_Month v) i = MGVector.basicUnsafeRead v i+  basicUnsafeWrite (MV_Month v) i x = MGVector.basicUnsafeWrite v i x+  basicClear (MV_Month v) = MGVector.basicClear v+  basicSet (MV_Month v) x = MGVector.basicSet v x+  basicUnsafeCopy (MV_Month v1) (MV_Month v2) = MGVector.basicUnsafeCopy v1 v2+  basicUnsafeMove (MV_Month v1) (MV_Month v2) = MGVector.basicUnsafeMove v1 v2+  basicUnsafeGrow (MV_Month v) n = MV_Month `liftM` MGVector.basicUnsafeGrow v n++instance GVector.Vector UVector.Vector Month where+  {-# INLINE basicUnsafeFreeze #-}+  {-# INLINE basicUnsafeThaw #-}+  {-# INLINE basicLength #-}+  {-# INLINE basicUnsafeSlice #-}+  {-# INLINE basicUnsafeIndexM #-}+  {-# INLINE elemseq #-}+  basicUnsafeFreeze (MV_Month v) = V_Month `liftM` GVector.basicUnsafeFreeze v+  basicUnsafeThaw (V_Month v) = MV_Month `liftM` GVector.basicUnsafeThaw v+  basicLength (V_Month v) = GVector.basicLength v+  basicUnsafeSlice i n (V_Month v) = V_Month $ GVector.basicUnsafeSlice i n v+  basicUnsafeIndexM (V_Month v) i = GVector.basicUnsafeIndexM v i+  basicUnsafeCopy (MV_Month mv) (V_Month v) = GVector.basicUnsafeCopy mv v+  elemseq _ = seq++newtype instance UVector.MVector s DayOfMonth = MV_DayOfMonth (PVector.MVector s DayOfMonth)+newtype instance UVector.Vector DayOfMonth = V_DayOfMonth (PVector.Vector DayOfMonth)++instance UVector.Unbox DayOfMonth++instance MGVector.MVector UVector.MVector DayOfMonth where+  {-# INLINE basicLength #-}+  {-# INLINE basicUnsafeSlice #-}+  {-# INLINE basicOverlaps #-}+  {-# INLINE basicUnsafeNew #-}+  {-# INLINE basicInitialize #-}+  {-# INLINE basicUnsafeReplicate #-}+  {-# INLINE basicUnsafeRead #-}+  {-# INLINE basicUnsafeWrite #-}+  {-# INLINE basicClear #-}+  {-# INLINE basicSet #-}+  {-# INLINE basicUnsafeCopy #-}+  {-# INLINE basicUnsafeGrow #-}+  basicLength (MV_DayOfMonth v) = MGVector.basicLength v+  basicUnsafeSlice i n (MV_DayOfMonth v) = MV_DayOfMonth $ MGVector.basicUnsafeSlice i n v+  basicOverlaps (MV_DayOfMonth v1) (MV_DayOfMonth v2) = MGVector.basicOverlaps v1 v2+  basicUnsafeNew n = MV_DayOfMonth `liftM` MGVector.basicUnsafeNew n+  basicInitialize (MV_DayOfMonth v) = MGVector.basicInitialize v+  basicUnsafeReplicate n x = MV_DayOfMonth `liftM` MGVector.basicUnsafeReplicate n x+  basicUnsafeRead (MV_DayOfMonth v) i = MGVector.basicUnsafeRead v i+  basicUnsafeWrite (MV_DayOfMonth v) i x = MGVector.basicUnsafeWrite v i x+  basicClear (MV_DayOfMonth v) = MGVector.basicClear v+  basicSet (MV_DayOfMonth v) x = MGVector.basicSet v x+  basicUnsafeCopy (MV_DayOfMonth v1) (MV_DayOfMonth v2) = MGVector.basicUnsafeCopy v1 v2+  basicUnsafeMove (MV_DayOfMonth v1) (MV_DayOfMonth v2) = MGVector.basicUnsafeMove v1 v2+  basicUnsafeGrow (MV_DayOfMonth v) n = MV_DayOfMonth `liftM` MGVector.basicUnsafeGrow v n++instance GVector.Vector UVector.Vector DayOfMonth where+  {-# INLINE basicUnsafeFreeze #-}+  {-# INLINE basicUnsafeThaw #-}+  {-# INLINE basicLength #-}+  {-# INLINE basicUnsafeSlice #-}+  {-# INLINE basicUnsafeIndexM #-}+  {-# INLINE elemseq #-}+  basicUnsafeFreeze (MV_DayOfMonth v) = V_DayOfMonth `liftM` GVector.basicUnsafeFreeze v+  basicUnsafeThaw (V_DayOfMonth v) = MV_DayOfMonth `liftM` GVector.basicUnsafeThaw v+  basicLength (V_DayOfMonth v) = GVector.basicLength v+  basicUnsafeSlice i n (V_DayOfMonth v) = V_DayOfMonth $ GVector.basicUnsafeSlice i n v+  basicUnsafeIndexM (V_DayOfMonth v) i = GVector.basicUnsafeIndexM v i+  basicUnsafeCopy (MV_DayOfMonth mv) (V_DayOfMonth v) = GVector.basicUnsafeCopy mv v+  elemseq _ = seq
+ src/Lib.hs view
@@ -0,0 +1,6 @@+module Lib+    ( someFunc+    ) where++someFunc :: IO ()+someFunc = putStrLn "someFunc"
+ test/Spec.hs view
@@ -0,0 +1,249 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Main (main) where++import Chronos.Types+import Data.List                            (intercalate)+import Test.QuickCheck                      (Gen, Arbitrary(..), choose, arbitraryBoundedEnum, genericShrink)+import Test.QuickCheck.Property             (failed,succeeded,Result(..))+import Test.Framework                       (defaultMain, defaultMainWithOpts, testGroup, Test)+import qualified Test.Framework             as TF+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.Framework.Providers.HUnit       (testCase)+import Test.HUnit                           (Assertion,(@?=),assertBool)++import Data.Text (Text)+import Data.Text.Lazy.Builder (Builder)+import qualified Chronos.Internal.Conversion as Conv+import qualified Chronos.Calendar as Month+import qualified Chronos.Posix as Posix+import qualified Data.Text as Text+import qualified Data.Text.Lazy as LText+import qualified Data.Text.Lazy.Builder as Builder+import qualified Data.Attoparsec.Text as Atto+import qualified Chronos.TimeOfDay.Text as TimeOfDayText+import qualified Chronos.Datetime.Text as DatetimeText+import qualified Chronos.OffsetDatetime.Text as OffsetDatetimeText+import qualified Chronos.Date.Text as DateText++-- We increase the default number of property-based tests (provided+-- by quickcheck) to 1000. Some of the encoding and decoding functions+-- we test have special behavior when the minute is zero, which only+-- happens in 1/60 of the generated scenarios. If we only generate 100+-- scenarios, there is a 18.62% chance that none of these will have zero+-- as the minute. If we increase this to 1000, that probability drops to+-- almost nothing.+main :: IO ()+main = defaultMainWithOpts tests mempty+  { TF.ropt_test_options = Just mempty+    { TF.topt_maximum_generated_tests = Just 1000+    }+  }++tests :: [Test]+tests =+  [ testGroup "Time of Day"+    [ testGroup "Parser Spec Tests" $+      [ testCase "No Separator + microseconds"+          (timeOfDayParse Nothing "165956.246052" (TimeOfDay 16 59 56246052000))+      , testCase "Separator + microseconds"+          (timeOfDayParse (Just ':') "16:59:56.246052" (TimeOfDay 16 59 56246052000))+      , testCase "Separator + milliseconds"+          (timeOfDayParse (Just ':') "05:00:58.675" (TimeOfDay 05 00 58675000000))+      , testCase "Separator + deciseconds"+          (timeOfDayParse (Just ':') "05:00:58.9" (TimeOfDay 05 00 58900000000))+      , testCase "Separator + no subseconds"+          (timeOfDayParse (Just ':') "23:08:01" (TimeOfDay 23 8 1000000000))+      , testCase "Separator + nanoseconds"+          (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))+      ]+    , testGroup "Builder Spec Tests"+      [ testCase "No Separator + microseconds"+          (timeOfDayBuilder Nothing "165956.246052000" (TimeOfDay 16 59 56246052000))+      , testCase "Separator + microseconds"+          (timeOfDayBuilder (Just ':') "16:59:56.246052000" (TimeOfDay 16 59 56246052000))+      , testCase "Separator + no subseconds"+          (timeOfDayBuilder (Just ':') "23:08:01" (TimeOfDay 23 8 1000000000))+      ]+    , testProperty "Builder Parser Isomorphism (H:M:S)" $ propEncodeDecodeIso+        (LText.toStrict . Builder.toLazyText . TimeOfDayText.builder_HMS (Just ':'))+        (either (const Nothing) Just . Atto.parseOnly (TimeOfDayText.parser_HMS (Just ':')))+    ]+  , testGroup "Date"+    [ testGroup "Parser Spec Tests" $+      [ testCase "No Separator"+          (dateParse Nothing "20160101" (Date (Year 2016) (Month 0) (DayOfMonth 1)))+      , testCase "Separator 1"+          (dateParse (Just '-') "2016-01-01" (Date (Year 2016) (Month 0) (DayOfMonth 1)))+      , testCase "Separator 2"+          (dateParse (Just '-') "1876-09-27" (Date (Year 1876) (Month 8) (DayOfMonth 27)))+      ]+    , testGroup "Builder Spec Tests" $+      [ testCase "No Separator"+          (dateBuilder Nothing "20160101" (Date (Year 2016) (Month 0) (DayOfMonth 1)))+      , testCase "Separator 1"+          (dateBuilder (Just '-') "2016-01-01" (Date (Year 2016) (Month 0) (DayOfMonth 1)))+      , testCase "Separator 2"+          (dateBuilder (Just '-') "1876-09-27" (Date (Year 1876) (Month 8) (DayOfMonth 27)))+      ]+    , testProperty "Builder Parser Isomorphism (Y-m-d)" $ propEncodeDecodeIso+        (LText.toStrict . Builder.toLazyText . DateText.builder_Ymd (Just '-'))+        (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 (YmdHMS)" $ propEncodeDecodeIso+        (LText.toStrict . Builder.toLazyText . DatetimeText.builder_YmdHMS (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" $+          OffsetDatetimeText.builderW3 $ OffsetDatetime+            ( Datetime+              ( Date (Year 1997) Month.july (DayOfMonth 16) )+              ( TimeOfDay 19 20 30450000000 )+            ) (Offset 60)+      ]+    , testProperty "Builder Parser Isomorphism (YmdHMSz)" $ propEncodeDecodeIsoSettings+        (\(offsetFormat,datetimeFormat) offsetDatetime ->+            LText.toStrict $ Builder.toLazyText $+              OffsetDatetimeText.builder_YmdHMSz offsetFormat datetimeFormat offsetDatetime+        )+        (\(offsetFormat,datetimeFormat) input ->+            either (const Nothing) Just $ flip Atto.parseOnly input $+              OffsetDatetimeText.parser_YmdHMSz offsetFormat datetimeFormat+        )+    ]+  , testGroup "Posix Time"+    [ testCase "Get now" $ do+        now <- Posix.now+        assertBool "Current time is the beginning of the epoch." (now /= Posix.epoch)+    ]+  , testGroup "Conversion"+    [ testGroup "POSIX to UTC"+      [ -- Technically, this should fail, but it is very unlikely that quickcheck+        -- will pick a leapsecond. Actually, since we are going from posix to utc+        -- first, I think that this cannot fail.+        testProperty "Isomorphism" $ propEncodeDecodeFullIso Posix.toUtc Posix.fromUtc+      ]+    , testGroup "UTC to Datetime"+      [ testProperty "Isomorphism"+          $ propEncodeDecodeFullIso Conv.utcTimeToDatetime Conv.datetimeToUtcTime+      ]+    , testGroup "POSIX to Datetime"+      [ testCase "Epoch" $ Posix.toDatetime (PosixTime 0)+          @?= Datetime (Date (Year 1970) Month.january (DayOfMonth 1))+                       (TimeOfDay 0 0 0)+      , testCase "Billion Seconds" $ Posix.toDatetime (PosixTime $ 10 ^ 18)+          @?= Datetime (Date (Year 2001) Month.september (DayOfMonth 9))+                       (TimeOfDay 1 46 (40 * 10 ^ 9))+      , testProperty "Isomorphism" $ propEncodeDecodeFullIso Posix.toDatetime Posix.fromDatetime+      ]+    ]+  ]++failure :: String -> Result+failure msg = failed+  { reason = msg+  , theException = Nothing+  }++propEncodeDecodeFullIso :: (Eq a,Show a,Show b) => (a -> b) -> (b -> a) -> a -> Result+propEncodeDecodeFullIso f g a =+  let fa = f a+      gfa = g fa+   in if gfa == a+        then succeeded+        else failure $ concat+          [ "x:       ", show a, "\n"+          , "f(x):    ", show fa, "\n"+          , "g(f(x)): ", show gfa, "\n"+          ]++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 f g e a =+  let fa = f e a+      gfa = g e fa+   in if gfa == Just a+        then succeeded+        else failure $ concat+          [ "env:     ", show e, "\n"+          , "x:       ", show a, "\n"+          , "f(x):    ", show fa, "\n"+          , "g(f(x)): ", show gfa, "\n"+          ]++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))+  @?= expected++dateParse :: Maybe Char -> Text -> Date -> Assertion+dateParse m t expected =+  Atto.parseOnly (DateText.parser_Ymd m <* Atto.endOfInput) t+  @?= Right expected++dateBuilder :: Maybe Char -> Text -> Date -> Assertion+dateBuilder m expected tod =+  LText.toStrict (Builder.toLazyText (DateText.builder_Ymd m tod))+  @?= expected++matchBuilder :: Text -> Builder -> Assertion+matchBuilder a b = LText.toStrict (Builder.toLazyText b) @?= a++instance Arbitrary TimeOfDay where+  arbitrary = TimeOfDay+    <$> choose (0,23)+    <*> choose (0,59)+    -- never use leap seconds for property-based tests+    <*> choose (0,60000000000 - 1)++instance Arbitrary Date where+  arbitrary = Date+    <$> fmap Year (choose (1800,2100))+    <*> fmap Month (choose (0,11))+    <*> fmap DayOfMonth (choose (1,28))++instance Arbitrary Datetime where+  arbitrary = Datetime <$> arbitrary <*> arbitrary++instance Arbitrary UtcTime where+  arbitrary = UtcTime+    <$> fmap Day (choose (-100000,100000))+    <*> choose (0,24 * 60 * 60 * 1000000000 - 1)++instance Arbitrary OffsetDatetime where+  arbitrary = OffsetDatetime+    <$> arbitrary+    <*> arbitrary++instance Arbitrary a => Arbitrary (DatetimeFormat a) where+  arbitrary = DatetimeFormat+    <$> arbitrary+    <*> arbitrary+    <*> arbitrary++instance Arbitrary OffsetFormat where+  arbitrary = arbitraryBoundedEnum+  shrink = genericShrink++deriving instance Arbitrary PosixTime++instance Arbitrary Offset where+  arbitrary = fmap Offset (choose ((-24) * 60, 24 * 60))+